Fix syntax scanning bug causing fontification crashes.
[emacs.git] / src / fontset.c
blobc335a5642f958c63bf877e3f912d52e35ca7080e
1 /* Fontset handler.
2 Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
3 Free Software Foundation, Inc.
4 Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
5 2005, 2006, 2007, 2008, 2009, 2010, 2011
6 National Institute of Advanced Industrial Science and Technology (AIST)
7 Registration Number H14PRO021
8 Copyright (C) 2003, 2006
9 National Institute of Advanced Industrial Science and Technology (AIST)
10 Registration Number H13PRO009
12 This file is part of GNU Emacs.
14 GNU Emacs is free software: you can redistribute it and/or modify
15 it under the terms of the GNU General Public License as published by
16 the Free Software Foundation, either version 3 of the License, or
17 (at your option) any later version.
19 GNU Emacs is distributed in the hope that it will be useful,
20 but WITHOUT ANY WARRANTY; without even the implied warranty of
21 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 GNU General Public License for more details.
24 You should have received a copy of the GNU General Public License
25 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
27 /* #define FONTSET_DEBUG */
29 #include <config.h>
30 #include <stdio.h>
31 #include <setjmp.h>
33 #include "lisp.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "character.h"
37 #include "charset.h"
38 #include "ccl.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #include "dispextern.h"
42 #include "intervals.h"
43 #include "fontset.h"
44 #include "window.h"
45 #ifdef HAVE_X_WINDOWS
46 #include "xterm.h"
47 #endif
48 #ifdef WINDOWSNT
49 #include "w32term.h"
50 #endif
51 #ifdef HAVE_NS
52 #include "nsterm.h"
53 #endif
54 #include "termhooks.h"
56 #include "font.h"
58 #undef xassert
59 #ifdef FONTSET_DEBUG
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
61 #undef INLINE
62 #define INLINE
63 #else /* not FONTSET_DEBUG */
64 #define xassert(X) (void) 0
65 #endif /* not FONTSET_DEBUG */
67 EXFUN (Fclear_face_cache, 1);
69 /* FONTSET
71 A fontset is a collection of font related information to give
72 similar appearance (style, etc) of characters. A fontset has two
73 roles. One is to use for the frame parameter `font' as if it is an
74 ASCII font. In that case, Emacs uses the font specified for
75 `ascii' script for the frame's default font.
77 Another role, the more important one, is to provide information
78 about which font to use for each non-ASCII character.
80 There are two kinds of fontsets; base and realized. A base fontset
81 is created by `new-fontset' from Emacs Lisp explicitly. A realized
82 fontset is created implicitly when a face is realized for ASCII
83 characters. A face is also realized for non-ASCII characters based
84 on an ASCII face. All of non-ASCII faces based on the same ASCII
85 face share the same realized fontset.
87 A fontset object is implemented by a char-table whose default value
88 and parent are always nil.
90 An element of a base fontset is a vector of FONT-DEFs which itself
91 is a vector [ FONT-SPEC ENCODING REPERTORY ].
93 An element of a realized fontset is nil, t, 0, or a vector of this
94 form:
96 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
97 RFONT-DEF0 RFONT-DEF1 ... ]
99 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
101 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
103 RFONT-DEFn are automatically reordered by the current charset
104 priority list.
106 The value nil means that we have not yet generated the above vector
107 from the base of the fontset.
109 The value t means that no font is available for the corresponding
110 range of characters.
112 The value 0 means that no font is available for the corresponding
113 range of characters in this fontset, but may be available in the
114 default fontset.
117 A fontset has 9 extra slots.
119 The 1st slot: the ID number of the fontset
121 The 2nd slot:
122 base: the name of the fontset
123 realized: nil
125 The 3rd slot:
126 base: nil
127 realized: the base fontset
129 The 4th slot:
130 base: nil
131 realized: the frame that the fontset belongs to
133 The 5th slot:
134 base: the font name for ASCII characters
135 realized: nil
137 The 6th slot:
138 base: nil
139 realized: the ID number of a face to use for characters that
140 has no font in a realized fontset.
142 The 7th slot:
143 base: nil
144 realized: Alist of font index vs the corresponding repertory
145 char-table.
147 The 8th slot:
148 base: nil
149 realized: If the base is not the default fontset, a fontset
150 realized from the default fontset, else nil.
152 The 9th slot:
153 base: Same as element value (but for fallback fonts).
154 realized: Likewise.
156 All fontsets are recorded in the vector Vfontset_table.
159 DEFAULT FONTSET
161 There's a special base fontset named `default fontset' which
162 defines the default font specifications. When a base fontset
163 doesn't specify a font for a specific character, the corresponding
164 value in the default fontset is used.
166 The parent of a realized fontset created for such a face that has
167 no fontset is the default fontset.
170 These structures are hidden from the other codes than this file.
171 The other codes handle fontsets only by their ID numbers. They
172 usually use the variable name `fontset' for IDs. But, in this
173 file, we always use varialbe name `id' for IDs, and name `fontset'
174 for an actual fontset object, i.e., char-table.
178 /********** VARIABLES and FUNCTION PROTOTYPES **********/
180 extern Lisp_Object Qfont;
181 static Lisp_Object Qfontset;
182 static Lisp_Object Qfontset_info;
183 static Lisp_Object Qprepend, Qappend;
184 Lisp_Object Qlatin;
186 /* Vector containing all fontsets. */
187 static Lisp_Object Vfontset_table;
189 /* Next possibly free fontset ID. Usually this keeps the minimum
190 fontset ID not yet used. */
191 static int next_fontset_id;
193 /* The default fontset. This gives default FAMILY and REGISTRY of
194 font for each character. */
195 static Lisp_Object Vdefault_fontset;
197 Lisp_Object Vfont_encoding_charset_alist;
198 Lisp_Object Vuse_default_ascent;
199 Lisp_Object Vignore_relative_composition;
200 Lisp_Object Valternate_fontname_alist;
201 Lisp_Object Vfontset_alias_alist;
202 Lisp_Object Vvertical_centering_font_regexp;
203 Lisp_Object Votf_script_alist;
205 /* Check if any window system is used now. */
206 void (*check_window_system_func) P_ ((void));
209 /* Prototype declarations for static functions. */
210 static Lisp_Object fontset_add P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
211 Lisp_Object));
212 static Lisp_Object fontset_find_font P_ ((Lisp_Object, int, struct face *,
213 int, int));
214 static void reorder_font_vector P_ ((Lisp_Object, struct font *));
215 static Lisp_Object fontset_font P_ ((Lisp_Object, int, struct face *, int));
216 static Lisp_Object make_fontset P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
217 static Lisp_Object fontset_pattern_regexp P_ ((Lisp_Object));
218 static void accumulate_script_ranges P_ ((Lisp_Object, Lisp_Object,
219 Lisp_Object));
220 Lisp_Object find_font_encoding P_ ((Lisp_Object));
222 static void set_fontset_font P_ ((Lisp_Object, Lisp_Object));
224 #ifdef FONTSET_DEBUG
226 /* Return 1 if ID is a valid fontset id, else return 0. */
228 static int
229 fontset_id_valid_p (id)
230 int id;
232 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
235 #endif
239 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
241 /* Return the fontset with ID. No check of ID's validness. */
242 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
244 /* Macros to access special values of FONTSET. */
245 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
247 /* Macros to access special values of (base) FONTSET. */
248 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
249 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
250 #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5]
252 /* Macros to access special values of (realized) FONTSET. */
253 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
254 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
255 #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4]
256 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
257 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
258 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
260 /* For both base and realized fontset. */
261 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
263 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
266 /* Macros for FONT-DEF and RFONT-DEF of fontset. */
267 #define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
268 do { \
269 (font_def) = Fmake_vector (make_number (3), (font_spec)); \
270 ASET ((font_def), 1, encoding); \
271 ASET ((font_def), 2, repertory); \
272 } while (0)
274 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
275 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
276 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
278 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
279 #define RFONT_DEF_SET_FACE(rfont_def, face_id) \
280 ASET ((rfont_def), 0, make_number (face_id))
281 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
282 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
283 #define RFONT_DEF_REPERTORY(rfont_def) FONT_DEF_REPERTORY (AREF (rfont_def, 1))
284 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
285 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
286 ASET ((rfont_def), 2, (object))
287 #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
288 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
289 ASET ((rfont_def), 3, make_number (score))
290 #define RFONT_DEF_NEW(rfont_def, font_def) \
291 do { \
292 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
293 ASET ((rfont_def), 1, (font_def)); \
294 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
295 } while (0)
298 /* Return the element of FONTSET for the character C. If FONTSET is a
299 base fontset other then the default fontset and FONTSET doesn't
300 contain information for C, return the information in the default
301 fontset. */
303 #define FONTSET_REF(fontset, c) \
304 (EQ (fontset, Vdefault_fontset) \
305 ? CHAR_TABLE_REF (fontset, c) \
306 : fontset_ref ((fontset), (c)))
308 static Lisp_Object
309 fontset_ref (fontset, c)
310 Lisp_Object fontset;
311 int c;
313 Lisp_Object elt;
315 elt = CHAR_TABLE_REF (fontset, c);
316 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
317 /* Don't check Vdefault_fontset for a realized fontset. */
318 && NILP (FONTSET_BASE (fontset)))
319 elt = CHAR_TABLE_REF (Vdefault_fontset, c);
320 return elt;
323 /* Set elements of FONTSET for characters in RANGE to the value ELT.
324 RANGE is a cons (FROM . TO), where FROM and TO are character codes
325 specifying a range. */
327 #define FONTSET_SET(fontset, range, elt) \
328 Fset_char_table_range ((fontset), (range), (elt))
331 /* Modify the elements of FONTSET for characters in RANGE by replacing
332 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
333 and TO are character codes specifying a range. If ADD is nil,
334 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
335 append ELT. */
337 #define FONTSET_ADD(fontset, range, elt, add) \
338 (NILP (add) \
339 ? (NILP (range) \
340 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
341 : Fset_char_table_range ((fontset), (range), \
342 Fmake_vector (make_number (1), (elt)))) \
343 : fontset_add ((fontset), (range), (elt), (add)))
345 static Lisp_Object
346 fontset_add (fontset, range, elt, add)
347 Lisp_Object fontset, range, elt, add;
349 Lisp_Object args[2];
350 int idx = (EQ (add, Qappend) ? 0 : 1);
352 args[1 - idx] = Fmake_vector (make_number (1), elt);
354 if (CONSP (range))
356 int from = XINT (XCAR (range));
357 int to = XINT (XCDR (range));
358 int from1, to1;
360 do {
361 from1 = from, to1 = to;
362 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
363 char_table_set_range (fontset, from, to1,
364 NILP (args[idx]) ? args[1 - idx]
365 : Fvconcat (2, args));
366 from = to1 + 1;
367 } while (from < to);
369 else
371 args[idx] = FONTSET_FALLBACK (fontset);
372 FONTSET_FALLBACK (fontset)
373 = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
375 return Qnil;
378 static int
379 fontset_compare_rfontdef (val1, val2)
380 const void *val1, *val2;
382 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
383 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
386 /* Update FONT-GROUP which has this form:
387 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
388 RFONT-DEF0 RFONT-DEF1 ... ]
389 Reorder RFONT-DEFs according to the current language, and update
390 CHARSET-ORDERED-LIST-TICK.
392 If PREFERRED_FAMILY is not nil, that family has the higher priority
393 if the encoding charsets or languages in font-specs are the same. */
395 extern Lisp_Object Fassoc_string ();
397 static void
398 reorder_font_vector (font_group, font)
399 Lisp_Object font_group;
400 struct font *font;
402 Lisp_Object vec, font_object;
403 int size;
404 int i;
405 int score_changed = 0;
407 if (font)
408 XSETFONT (font_object, font);
409 else
410 font_object = Qnil;
412 vec = XCDR (font_group);
413 size = ASIZE (vec);
414 /* Exclude the tailing nil element from the reordering. */
415 if (NILP (AREF (vec, size - 1)))
416 size--;
418 for (i = 0; i < size; i++)
420 Lisp_Object rfont_def = AREF (vec, i);
421 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
422 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
423 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
425 if (! font_match_p (font_spec, font_object))
427 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
429 if (! NILP (encoding))
431 Lisp_Object tail;
433 for (tail = Vcharset_ordered_list;
434 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
435 score += 0x100, tail = XCDR (tail))
436 if (EQ (encoding, XCAR (tail)))
437 break;
439 else
441 Lisp_Object lang = Ffont_get (font_spec, QClang);
443 if (! NILP (lang)
444 && ! EQ (lang, Vcurrent_iso639_language)
445 && (! CONSP (Vcurrent_iso639_language)
446 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
447 score |= 0x100;
450 if (RFONT_DEF_SCORE (rfont_def) != score)
452 RFONT_DEF_SET_SCORE (rfont_def, score);
453 score_changed = 1;
457 if (score_changed)
458 qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
459 fontset_compare_rfontdef);
460 XSETCAR (font_group, make_number (charset_ordered_list_tick));
463 /* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
464 character C in FONTSET. If C is -1, return a fallback font-group.
465 If C is not -1, the value may be Qt (FONTSET doesn't have a font
466 for C even in the fallback group), or 0 (a font for C may be found
467 only in the fallback group). */
469 static Lisp_Object
470 fontset_get_font_group (Lisp_Object fontset, int c)
472 Lisp_Object font_group;
473 Lisp_Object base_fontset;
474 int from = 0, to = MAX_CHAR, i;
476 xassert (! BASE_FONTSET_P (fontset));
477 if (c >= 0)
478 font_group = CHAR_TABLE_REF (fontset, c);
479 else
480 font_group = FONTSET_FALLBACK (fontset);
481 if (! NILP (font_group))
482 return font_group;
483 base_fontset = FONTSET_BASE (fontset);
484 if (NILP (base_fontset))
485 font_group = Qnil;
486 else if (c >= 0)
487 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
488 else
489 font_group = FONTSET_FALLBACK (base_fontset);
490 if (NILP (font_group))
492 font_group = make_number (0);
493 if (c >= 0)
494 char_table_set_range (fontset, from, to, font_group);
495 return font_group;
497 if (!VECTORP (font_group))
498 return font_group;
499 font_group = Fcopy_sequence (font_group);
500 for (i = 0; i < ASIZE (font_group); i++)
501 if (! NILP (AREF (font_group, i)))
503 Lisp_Object rfont_def;
505 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
506 /* Remember the original order. */
507 RFONT_DEF_SET_SCORE (rfont_def, i);
508 ASET (font_group, i, rfont_def);
510 font_group = Fcons (make_number (-1), font_group);
511 if (c >= 0)
512 char_table_set_range (fontset, from, to, font_group);
513 else
514 FONTSET_FALLBACK (fontset) = font_group;
515 return font_group;
518 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
519 character C. If no font is found, return Qnil if there's a
520 possibility that the default fontset or the fallback font groups
521 have a proper font, and return Qt if not.
523 If a font is found but is not yet opened, open it (if FACE is not
524 NULL) or return Qnil (if FACE is NULL).
526 ID is a charset-id that must be preferred, or -1 meaning no
527 preference.
529 If FALLBACK is nonzero, search only fallback fonts. */
531 static Lisp_Object
532 fontset_find_font (fontset, c, face, id, fallback)
533 Lisp_Object fontset;
534 int c;
535 struct face *face;
536 int id, fallback;
538 Lisp_Object vec, font_group;
539 int i, charset_matched = 0, found_index;
540 FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset))
541 ? XFRAME (FONTSET_FRAME (fontset)) : XFRAME (selected_frame));
542 Lisp_Object rfont_def;
544 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
545 if (! CONSP (font_group))
546 return font_group;
547 vec = XCDR (font_group);
548 if (ASIZE (vec) == 0)
549 return Qnil;
551 if (ASIZE (vec) > 1)
553 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
554 /* We have just created the font-group,
555 or the charset priorities were changed. */
556 reorder_font_vector (font_group, face->ascii_face->font);
557 if (id >= 0)
558 /* Find a spec matching with the charset ID to try at
559 first. */
560 for (i = 0; i < ASIZE (vec); i++)
562 Lisp_Object repertory;
564 rfont_def = AREF (vec, i);
565 if (NILP (rfont_def))
566 break;
567 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
569 if (XINT (repertory) == id)
571 charset_matched = i;
572 break;
577 /* Find the first available font in the vector of RFONT-DEF. */
578 for (i = 0; i < ASIZE (vec); i++)
580 Lisp_Object font_def;
581 Lisp_Object font_entity, font_object;
583 found_index = i;
584 if (i == 0)
586 if (charset_matched > 0)
588 /* Try the element matching with the charset ID at first. */
589 found_index = charset_matched;
590 /* Make this negative so that we don't come here in the
591 next loop. */
592 charset_matched = - charset_matched;
593 /* We must try the first element in the next loop. */
594 i--;
597 else if (i == - charset_matched)
599 /* We have already tried this element and the followings
600 that have the same font specifications in the first
601 iteration. So, skip them all. */
602 rfont_def = AREF (vec, i);
603 font_def = RFONT_DEF_FONT_DEF (rfont_def);
604 for (; i + 1 < ASIZE (vec); i++)
606 rfont_def = AREF (vec, i + 1);
607 if (NILP (rfont_def))
608 break;
609 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
610 break;
612 continue;
615 rfont_def = AREF (vec, found_index);
616 if (NILP (rfont_def))
618 if (i < 0)
619 continue;
620 /* This is a sign of not to try the other fonts. */
621 return Qt;
623 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
624 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
625 /* We couldn't open this font last time. */
626 continue;
628 font_object = RFONT_DEF_OBJECT (rfont_def);
629 if (NILP (font_object))
631 font_def = RFONT_DEF_FONT_DEF (rfont_def);
633 if (! face)
634 /* We have not yet opened the font. */
635 return Qnil;
636 /* Find a font best-matching with the spec without checking
637 the support of the character C. That checking is costly,
638 and even without the checking, the found font supports C
639 in high possibility. */
640 font_entity = font_find_for_lface (f, face->lface,
641 FONT_DEF_SPEC (font_def), -1);
642 if (NILP (font_entity))
644 /* Record that no font matches the spec. */
645 RFONT_DEF_SET_FACE (rfont_def, -1);
646 continue;
648 font_object = font_open_for_lface (f, font_entity, face->lface,
649 FONT_DEF_SPEC (font_def));
650 if (NILP (font_object))
652 /* Something strange happened, perhaps because of a
653 Font-backend problem. Too avoid crashing, record
654 that this spec is unsable. It may be better to find
655 another font of the same spec, but currently we don't
656 have such an API. */
657 RFONT_DEF_SET_FACE (rfont_def, -1);
658 continue;
660 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
663 if (font_has_char (f, font_object, c))
664 goto found;
666 /* Find a font already opened, maching with the current spec,
667 and supporting C. */
668 font_def = RFONT_DEF_FONT_DEF (rfont_def);
669 for (; found_index + 1 < ASIZE (vec); found_index++)
671 rfont_def = AREF (vec, found_index + 1);
672 if (NILP (rfont_def))
673 break;
674 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
675 break;
676 font_object = RFONT_DEF_OBJECT (rfont_def);
677 if (! NILP (font_object) && font_has_char (f, font_object, c))
679 found_index++;
680 goto found;
684 /* Find a font-entity with the current spec and supporting C. */
685 font_entity = font_find_for_lface (f, face->lface,
686 FONT_DEF_SPEC (font_def), c);
687 if (! NILP (font_entity))
689 /* We found a font. Open it and insert a new element for
690 that font in VEC. */
691 Lisp_Object new_vec;
692 int j;
694 font_object = font_open_for_lface (f, font_entity, face->lface,
695 Qnil);
696 if (NILP (font_object))
697 continue;
698 RFONT_DEF_NEW (rfont_def, font_def);
699 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
700 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
701 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
702 found_index++;
703 for (j = 0; j < found_index; j++)
704 ASET (new_vec, j, AREF (vec, j));
705 ASET (new_vec, j, rfont_def);
706 for (j++; j < ASIZE (new_vec); j++)
707 ASET (new_vec, j, AREF (vec, j - 1));
708 XSETCDR (font_group, new_vec);
709 vec = new_vec;
710 goto found;
712 if (i >= 0)
713 i = found_index;
716 FONTSET_SET (fontset, make_number (c), make_number (0));
717 return Qnil;
719 found:
720 if (fallback && found_index > 0)
722 /* The order of fonts in the fallback font-group is not that
723 important, and it is better to move the found font to the
724 first of the group so that the next try will find it
725 quickly. */
726 for (i = found_index; i > 0; i--)
727 ASET (vec, i, AREF (vec, i - 1));
728 ASET (vec, 0, rfont_def);
730 return rfont_def;
734 static Lisp_Object
735 fontset_font (fontset, c, face, id)
736 Lisp_Object fontset;
737 int c;
738 struct face *face;
739 int id;
741 Lisp_Object rfont_def, default_rfont_def;
742 Lisp_Object base_fontset;
744 /* Try a font-group of FONTSET. */
745 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
746 rfont_def = fontset_find_font (fontset, c, face, id, 0);
747 if (VECTORP (rfont_def))
748 return rfont_def;
749 if (NILP (rfont_def))
750 FONTSET_SET (fontset, make_number (c), make_number (0));
752 /* Try a font-group of the default fontset. */
753 base_fontset = FONTSET_BASE (fontset);
754 if (! EQ (base_fontset, Vdefault_fontset))
756 if (NILP (FONTSET_DEFAULT (fontset)))
757 FONTSET_DEFAULT (fontset)
758 = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
759 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
760 default_rfont_def
761 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
762 if (VECTORP (default_rfont_def))
763 return default_rfont_def;
764 if (NILP (default_rfont_def))
765 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
766 make_number (0));
769 /* Try a fallback font-group of FONTSET. */
770 if (! EQ (rfont_def, Qt))
772 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
773 rfont_def = fontset_find_font (fontset, c, face, id, 1);
774 if (VECTORP (rfont_def))
775 return rfont_def;
776 /* Remember that FONTSET has no font for C. */
777 FONTSET_SET (fontset, make_number (c), Qt);
780 /* Try a fallback font-group of the default fontset. */
781 if (! EQ (base_fontset, Vdefault_fontset)
782 && ! EQ (default_rfont_def, Qt))
784 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
785 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
786 if (VECTORP (rfont_def))
787 return rfont_def;
788 /* Remember that the default fontset has no font for C. */
789 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
792 return Qnil;
795 /* Return a newly created fontset with NAME. If BASE is nil, make a
796 base fontset. Otherwise make a realized fontset whose base is
797 BASE. */
799 static Lisp_Object
800 make_fontset (frame, name, base)
801 Lisp_Object frame, name, base;
803 Lisp_Object fontset;
804 int size = ASIZE (Vfontset_table);
805 int id = next_fontset_id;
807 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
808 the next available fontset ID. So it is expected that this loop
809 terminates quickly. In addition, as the last element of
810 Vfontset_table is always nil, we don't have to check the range of
811 id. */
812 while (!NILP (AREF (Vfontset_table, id))) id++;
814 if (id + 1 == size)
815 Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
817 fontset = Fmake_char_table (Qfontset, Qnil);
819 FONTSET_ID (fontset) = make_number (id);
820 if (NILP (base))
822 FONTSET_NAME (fontset) = name;
824 else
826 FONTSET_NAME (fontset) = Qnil;
827 FONTSET_FRAME (fontset) = frame;
828 FONTSET_BASE (fontset) = base;
831 ASET (Vfontset_table, id, fontset);
832 next_fontset_id = id + 1;
833 return fontset;
837 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
839 /* Return the name of the fontset who has ID. */
841 Lisp_Object
842 fontset_name (id)
843 int id;
845 Lisp_Object fontset;
847 fontset = FONTSET_FROM_ID (id);
848 return FONTSET_NAME (fontset);
852 /* Return the ASCII font name of the fontset who has ID. */
854 Lisp_Object
855 fontset_ascii (id)
856 int id;
858 Lisp_Object fontset, elt;
860 fontset= FONTSET_FROM_ID (id);
861 elt = FONTSET_ASCII (fontset);
862 if (CONSP (elt))
863 elt = XCAR (elt);
864 return elt;
867 void
868 free_realized_fontset (f, fontset)
869 FRAME_PTR f;
870 Lisp_Object fontset;
872 Lisp_Object tail;
874 return;
875 for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
877 xassert (FONT_OBJECT_P (XCAR (tail)));
878 font_close_object (f, XCAR (tail));
882 /* Free fontset of FACE defined on frame F. Called from
883 free_realized_face. */
885 void
886 free_face_fontset (f, face)
887 FRAME_PTR f;
888 struct face *face;
890 Lisp_Object fontset;
892 fontset = FONTSET_FROM_ID (face->fontset);
893 if (NILP (fontset))
894 return;
895 xassert (! BASE_FONTSET_P (fontset));
896 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
897 free_realized_fontset (f, fontset);
898 ASET (Vfontset_table, face->fontset, Qnil);
899 if (face->fontset < next_fontset_id)
900 next_fontset_id = face->fontset;
901 if (! NILP (FONTSET_DEFAULT (fontset)))
903 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
905 fontset = AREF (Vfontset_table, id);
906 xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
907 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
908 free_realized_fontset (f, fontset);
909 ASET (Vfontset_table, id, Qnil);
910 if (id < next_fontset_id)
911 next_fontset_id = face->fontset;
913 face->fontset = -1;
917 /* Return 1 if FACE is suitable for displaying character C.
918 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
919 when C is not an ASCII character. */
922 face_suitable_for_char_p (face, c)
923 struct face *face;
924 int c;
926 Lisp_Object fontset, rfont_def;
928 fontset = FONTSET_FROM_ID (face->fontset);
929 rfont_def = fontset_font (fontset, c, NULL, -1);
930 return (VECTORP (rfont_def)
931 && INTEGERP (RFONT_DEF_FACE (rfont_def))
932 && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
936 /* Return ID of face suitable for displaying character C on frame F.
937 FACE must be reazlied for ASCII characters in advance. Called from
938 the macro FACE_FOR_CHAR. */
941 face_for_char (f, face, c, pos, object)
942 FRAME_PTR f;
943 struct face *face;
944 int c, pos;
945 Lisp_Object object;
947 Lisp_Object fontset, rfont_def, charset;
948 int face_id;
949 int id;
951 /* If face->fontset is negative (that happens when no font is found
952 for face), just return face->ascii_face because we can't do
953 anything. Perhaps, we should fix the callers to assure
954 that face->fontset is always valid. */
955 if (ASCII_CHAR_P (c) || face->fontset < 0)
956 return face->ascii_face->id;
958 xassert (fontset_id_valid_p (face->fontset));
959 fontset = FONTSET_FROM_ID (face->fontset);
960 xassert (!BASE_FONTSET_P (fontset));
962 if (pos < 0)
964 id = -1;
965 charset = Qnil;
967 else
969 charset = Fget_char_property (make_number (pos), Qcharset, object);
970 if (CHARSETP (charset))
972 Lisp_Object val;
974 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
975 if (CONSP (val) && CHARSETP (XCDR (val)))
976 charset = XCDR (val);
977 id = XINT (CHARSET_SYMBOL_ID (charset));
979 else
980 id = -1;
983 rfont_def = fontset_font (fontset, c, face, id);
984 if (VECTORP (rfont_def))
986 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
987 face_id = XINT (RFONT_DEF_FACE (rfont_def));
988 else
990 Lisp_Object font_object;
992 font_object = RFONT_DEF_OBJECT (rfont_def);
993 face_id = face_for_font (f, font_object, face);
994 RFONT_DEF_SET_FACE (rfont_def, face_id);
997 else
999 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
1000 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
1001 else
1003 face_id = face_for_font (f, Qnil, face);
1004 FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
1007 xassert (face_id >= 0);
1008 return face_id;
1012 Lisp_Object
1013 font_for_char (face, c, pos, object)
1014 struct face *face;
1015 int c, pos;
1016 Lisp_Object object;
1018 Lisp_Object fontset, rfont_def, charset;
1019 int id;
1021 if (ASCII_CHAR_P (c))
1023 Lisp_Object font_object;
1025 XSETFONT (font_object, face->ascii_face->font);
1026 return font_object;
1029 xassert (fontset_id_valid_p (face->fontset));
1030 fontset = FONTSET_FROM_ID (face->fontset);
1031 xassert (!BASE_FONTSET_P (fontset));
1032 if (pos < 0)
1034 id = -1;
1035 charset = Qnil;
1037 else
1039 charset = Fget_char_property (make_number (pos), Qcharset, object);
1040 if (CHARSETP (charset))
1042 Lisp_Object val;
1044 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1045 if (CONSP (val) && CHARSETP (XCDR (val)))
1046 charset = XCDR (val);
1047 id = XINT (CHARSET_SYMBOL_ID (charset));
1049 else
1050 id = -1;
1053 rfont_def = fontset_font (fontset, c, face, id);
1054 return (VECTORP (rfont_def)
1055 ? RFONT_DEF_OBJECT (rfont_def)
1056 : Qnil);
1060 /* Make a realized fontset for ASCII face FACE on frame F from the
1061 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1062 default fontset as the base. Value is the id of the new fontset.
1063 Called from realize_x_face. */
1066 make_fontset_for_ascii_face (f, base_fontset_id, face)
1067 FRAME_PTR f;
1068 int base_fontset_id;
1069 struct face *face;
1071 Lisp_Object base_fontset, fontset, frame;
1073 XSETFRAME (frame, f);
1074 if (base_fontset_id >= 0)
1076 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1077 if (!BASE_FONTSET_P (base_fontset))
1078 base_fontset = FONTSET_BASE (base_fontset);
1079 if (! BASE_FONTSET_P (base_fontset))
1080 abort ();
1082 else
1083 base_fontset = Vdefault_fontset;
1085 fontset = make_fontset (frame, Qnil, base_fontset);
1086 return XINT (FONTSET_ID (fontset));
1091 /* Cache data used by fontset_pattern_regexp. The car part is a
1092 pattern string containing at least one wild card, the cdr part is
1093 the corresponding regular expression. */
1094 static Lisp_Object Vcached_fontset_data;
1096 #define CACHED_FONTSET_NAME ((char *) SDATA (XCAR (Vcached_fontset_data)))
1097 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1099 /* If fontset name PATTERN contains any wild card, return regular
1100 expression corresponding to PATTERN. */
1102 static Lisp_Object
1103 fontset_pattern_regexp (pattern)
1104 Lisp_Object pattern;
1106 if (!index ((char *) SDATA (pattern), '*')
1107 && !index ((char *) SDATA (pattern), '?'))
1108 /* PATTERN does not contain any wild cards. */
1109 return Qnil;
1111 if (!CONSP (Vcached_fontset_data)
1112 || strcmp ((char *) SDATA (pattern), CACHED_FONTSET_NAME))
1114 /* We must at first update the cached data. */
1115 unsigned char *regex, *p0, *p1;
1116 int ndashes = 0, nstars = 0, nescs = 0;
1118 for (p0 = SDATA (pattern); *p0; p0++)
1120 if (*p0 == '-')
1121 ndashes++;
1122 else if (*p0 == '*')
1123 nstars++;
1124 else if (*p0 == '['
1125 || *p0 == '.' || *p0 == '\\'
1126 || *p0 == '+' || *p0 == '^'
1127 || *p0 == '$')
1128 nescs++;
1131 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
1132 we convert "*" to "[^-]*" which is much faster in regular
1133 expression matching. */
1134 if (ndashes < 14)
1135 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
1136 else
1137 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
1139 *p1++ = '^';
1140 for (p0 = SDATA (pattern); *p0; p0++)
1142 if (*p0 == '*')
1144 if (ndashes < 14)
1145 *p1++ = '.';
1146 else
1147 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1148 *p1++ = '*';
1150 else if (*p0 == '?')
1151 *p1++ = '.';
1152 else if (*p0 == '['
1153 || *p0 == '.' || *p0 == '\\'
1154 || *p0 == '+' || *p0 == '^'
1155 || *p0 == '$')
1156 *p1++ = '\\', *p1++ = *p0;
1157 else
1158 *p1++ = *p0;
1160 *p1++ = '$';
1161 *p1++ = 0;
1163 Vcached_fontset_data = Fcons (build_string ((char *) SDATA (pattern)),
1164 build_string ((char *) regex));
1167 return CACHED_FONTSET_REGEX;
1170 /* Return ID of the base fontset named NAME. If there's no such
1171 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1172 0: pattern containing '*' and '?' as wildcards
1173 1: regular expression
1174 2: literal fontset name
1178 fs_query_fontset (name, name_pattern)
1179 Lisp_Object name;
1180 int name_pattern;
1182 Lisp_Object tem;
1183 int i;
1185 name = Fdowncase (name);
1186 if (name_pattern != 1)
1188 tem = Frassoc (name, Vfontset_alias_alist);
1189 if (NILP (tem))
1190 tem = Fassoc (name, Vfontset_alias_alist);
1191 if (CONSP (tem) && STRINGP (XCAR (tem)))
1192 name = XCAR (tem);
1193 else if (name_pattern == 0)
1195 tem = fontset_pattern_regexp (name);
1196 if (STRINGP (tem))
1198 name = tem;
1199 name_pattern = 1;
1204 for (i = 0; i < ASIZE (Vfontset_table); i++)
1206 Lisp_Object fontset, this_name;
1208 fontset = FONTSET_FROM_ID (i);
1209 if (NILP (fontset)
1210 || !BASE_FONTSET_P (fontset))
1211 continue;
1213 this_name = FONTSET_NAME (fontset);
1214 if (name_pattern == 1
1215 ? fast_string_match_ignore_case (name, this_name) >= 0
1216 : !xstrcasecmp (SDATA (name), SDATA (this_name)))
1217 return i;
1219 return -1;
1223 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1224 doc: /* Return the name of a fontset that matches PATTERN.
1225 The value is nil if there is no matching fontset.
1226 PATTERN can contain `*' or `?' as a wildcard
1227 just as X font name matching algorithm allows.
1228 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1229 (pattern, regexpp)
1230 Lisp_Object pattern, regexpp;
1232 Lisp_Object fontset;
1233 int id;
1235 (*check_window_system_func) ();
1237 CHECK_STRING (pattern);
1239 if (SCHARS (pattern) == 0)
1240 return Qnil;
1242 id = fs_query_fontset (pattern, !NILP (regexpp));
1243 if (id < 0)
1244 return Qnil;
1246 fontset = FONTSET_FROM_ID (id);
1247 return FONTSET_NAME (fontset);
1250 /* Return a list of base fontset names matching PATTERN on frame F. */
1252 Lisp_Object
1253 list_fontsets (f, pattern, size)
1254 FRAME_PTR f;
1255 Lisp_Object pattern;
1256 int size;
1258 Lisp_Object frame, regexp, val;
1259 int id;
1261 XSETFRAME (frame, f);
1263 regexp = fontset_pattern_regexp (pattern);
1264 val = Qnil;
1266 for (id = 0; id < ASIZE (Vfontset_table); id++)
1268 Lisp_Object fontset, name;
1270 fontset = FONTSET_FROM_ID (id);
1271 if (NILP (fontset)
1272 || !BASE_FONTSET_P (fontset)
1273 || !EQ (frame, FONTSET_FRAME (fontset)))
1274 continue;
1275 name = FONTSET_NAME (fontset);
1277 if (STRINGP (regexp)
1278 ? (fast_string_match (regexp, name) < 0)
1279 : strcmp ((char *) SDATA (pattern), (char *) SDATA (name)))
1280 continue;
1282 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1285 return val;
1289 /* Free all realized fontsets whose base fontset is BASE. */
1291 static void
1292 free_realized_fontsets (base)
1293 Lisp_Object base;
1295 int id;
1297 #if 0
1298 /* For the moment, this doesn't work because free_realized_face
1299 doesn't remove FACE from a cache. Until we find a solution, we
1300 suppress this code, and simply use Fclear_face_cache even though
1301 that is not efficient. */
1302 BLOCK_INPUT;
1303 for (id = 0; id < ASIZE (Vfontset_table); id++)
1305 Lisp_Object this = AREF (Vfontset_table, id);
1307 if (EQ (FONTSET_BASE (this), base))
1309 Lisp_Object tail;
1311 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1312 tail = XCDR (tail))
1314 FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
1315 int face_id = XINT (XCDR (XCAR (tail)));
1316 struct face *face = FACE_FROM_ID (f, face_id);
1318 /* Face THIS itself is also freed by the following call. */
1319 free_realized_face (f, face);
1323 UNBLOCK_INPUT;
1324 #else /* not 0 */
1325 /* But, we don't have to call Fclear_face_cache if no fontset has
1326 been realized from BASE. */
1327 for (id = 0; id < ASIZE (Vfontset_table); id++)
1329 Lisp_Object this = AREF (Vfontset_table, id);
1331 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1333 Fclear_face_cache (Qt);
1334 break;
1337 #endif /* not 0 */
1341 /* Check validity of NAME as a fontset name and return the
1342 corresponding fontset. If not valid, signal an error.
1344 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1345 fontset of *FRAME.
1347 Set *FRAME to the actual frame. */
1349 static Lisp_Object
1350 check_fontset_name (name, frame)
1351 Lisp_Object name, *frame;
1353 int id;
1355 if (NILP (*frame))
1356 *frame = selected_frame;
1357 CHECK_LIVE_FRAME (*frame);
1359 if (EQ (name, Qt))
1360 return Vdefault_fontset;
1361 if (NILP (name))
1363 id = FRAME_FONTSET (XFRAME (*frame));
1365 else
1367 CHECK_STRING (name);
1368 /* First try NAME as literal. */
1369 id = fs_query_fontset (name, 2);
1370 if (id < 0)
1371 /* For backward compatibility, try again NAME as pattern. */
1372 id = fs_query_fontset (name, 0);
1373 if (id < 0)
1374 error ("Fontset `%s' does not exist", SDATA (name));
1376 return FONTSET_FROM_ID (id);
1379 static void
1380 accumulate_script_ranges (arg, range, val)
1381 Lisp_Object arg, range, val;
1383 if (EQ (XCAR (arg), val))
1385 if (CONSP (range))
1386 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1387 else
1388 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1393 /* Callback function for map_charset_chars in Fset_fontset_font.
1394 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1396 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1397 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1398 The consumed ranges are poped up from SCRIPT_RANGE_LIST, and the
1399 new SCRIPT_RANGE_LIST is stored in ARG.
1401 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1402 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1403 case. */
1405 static void
1406 set_fontset_font (arg, range)
1407 Lisp_Object arg, range;
1409 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1410 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1412 fontset = AREF (arg, 0);
1413 font_def = AREF (arg, 1);
1414 add = AREF (arg, 2);
1415 ascii = AREF (arg, 3);
1416 script_range_list = AREF (arg, 4);
1418 if (NILP (ascii) && from < 0x80)
1420 if (to < 0x80)
1421 return;
1422 from = 0x80;
1423 range = Fcons (make_number (0x80), XCDR (range));
1426 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1427 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1428 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1430 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1431 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1432 if (CONSP (script_range_list))
1434 if (SCRIPT_FROM < from)
1435 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1436 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1437 POP_SCRIPT_RANGE ();
1438 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1439 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1442 FONTSET_ADD (fontset, range, font_def, add);
1443 ASET (arg, 4, script_range_list);
1446 extern Lisp_Object QCfamily, QCregistry;
1447 static void update_auto_fontset_alist P_ ((Lisp_Object, Lisp_Object));
1450 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1451 doc: /*
1452 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1454 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1455 the default fontset.
1457 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1458 In that case, use FONT-SPEC for all characters in the range FROM and
1459 TO (inclusive).
1461 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1462 all characters that belong to the script.
1464 TARGET may be a charset. In that case, use FONT-SPEC for all
1465 characters in the charset.
1467 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1468 that no FONT-SPEC is specified.
1470 FONT-SPEC may one of these:
1471 * A font-spec object made by the function `font-spec' (which see).
1472 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1473 REGISTRY is a font registry name. FAMILY may contain foundry
1474 name, and REGISTRY may contain encoding name.
1475 * A font name string.
1476 * nil, which explicitly specifies that there's no font for TARGET.
1478 Optional 4th argument FRAME is a frame or nil for the selected frame
1479 that is concerned in the case that NAME is nil.
1481 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1482 to the font specifications for TARGET previously set. If it is
1483 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1484 appended. By default, FONT-SPEC overrides the previous settings. */)
1485 (name, target, font_spec, frame, add)
1486 Lisp_Object name, target, font_spec, frame, add;
1488 Lisp_Object fontset;
1489 Lisp_Object font_def, registry, family;
1490 Lisp_Object range_list;
1491 struct charset *charset = NULL;
1492 Lisp_Object fontname;
1493 int ascii_changed = 0;
1495 fontset = check_fontset_name (name, &frame);
1497 fontname = Qnil;
1498 if (CONSP (font_spec))
1500 Lisp_Object spec = Ffont_spec (0, NULL);
1502 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1503 font_spec = spec;
1504 fontname = Ffont_xlfd_name (font_spec, Qnil);
1506 else if (STRINGP (font_spec))
1508 Lisp_Object args[2];
1509 extern Lisp_Object QCname;
1511 fontname = font_spec;
1512 args[0] = QCname;
1513 args[1] = font_spec;
1514 font_spec = Ffont_spec (2, args);
1516 else if (FONT_SPEC_P (font_spec))
1517 fontname = Ffont_xlfd_name (font_spec, Qnil);
1518 else if (! NILP (font_spec))
1519 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1521 if (! NILP (font_spec))
1523 Lisp_Object encoding, repertory;
1525 family = AREF (font_spec, FONT_FAMILY_INDEX);
1526 if (! NILP (family) )
1527 family = SYMBOL_NAME (family);
1528 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1529 if (! NILP (registry))
1530 registry = Fdowncase (SYMBOL_NAME (registry));
1531 encoding = find_font_encoding (concat3 (family, build_string ("-"),
1532 registry));
1533 if (NILP (encoding))
1534 encoding = Qascii;
1536 if (SYMBOLP (encoding))
1538 CHECK_CHARSET (encoding);
1539 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1541 else
1543 repertory = XCDR (encoding);
1544 encoding = XCAR (encoding);
1545 CHECK_CHARSET (encoding);
1546 encoding = CHARSET_SYMBOL_ID (encoding);
1547 if (! NILP (repertory) && SYMBOLP (repertory))
1549 CHECK_CHARSET (repertory);
1550 repertory = CHARSET_SYMBOL_ID (repertory);
1553 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1555 else
1556 font_def = Qnil;
1558 if (CHARACTERP (target))
1560 if (XFASTINT (target) < 0x80)
1561 error ("Can't set a font for partial ASCII range");
1562 range_list = Fcons (Fcons (target, target), Qnil);
1564 else if (CONSP (target))
1566 Lisp_Object from, to;
1568 from = Fcar (target);
1569 to = Fcdr (target);
1570 CHECK_CHARACTER (from);
1571 CHECK_CHARACTER (to);
1572 if (XFASTINT (from) < 0x80)
1574 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1575 error ("Can't set a font for partial ASCII range");
1576 ascii_changed = 1;
1578 range_list = Fcons (target, Qnil);
1580 else if (SYMBOLP (target) && !NILP (target))
1582 Lisp_Object script_list;
1583 Lisp_Object val;
1585 range_list = Qnil;
1586 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1587 if (! NILP (Fmemq (target, script_list)))
1589 if (EQ (target, Qlatin))
1590 ascii_changed = 1;
1591 val = Fcons (target, Qnil);
1592 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1593 val);
1594 range_list = Fnreverse (XCDR (val));
1596 if (CHARSETP (target))
1598 CHECK_CHARSET_GET_CHARSET (target, charset);
1599 if (charset->ascii_compatible_p)
1600 ascii_changed = 1;
1602 else if (NILP (range_list))
1603 error ("Invalid script or charset name: %s",
1604 SDATA (SYMBOL_NAME (target)));
1606 else if (NILP (target))
1607 range_list = Fcons (Qnil, Qnil);
1608 else
1609 error ("Invalid target for setting a font");
1611 if (ascii_changed)
1613 Lisp_Object val;
1615 if (NILP (font_spec))
1616 error ("Can't set ASCII font to nil");
1617 val = CHAR_TABLE_REF (fontset, 0);
1618 if (! NILP (val) && EQ (add, Qappend))
1619 /* We are going to change just an additional font for ASCII. */
1620 ascii_changed = 0;
1623 if (charset)
1625 Lisp_Object arg;
1627 arg = Fmake_vector (make_number (5), Qnil);
1628 ASET (arg, 0, fontset);
1629 ASET (arg, 1, font_def);
1630 ASET (arg, 2, add);
1631 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1632 ASET (arg, 4, range_list);
1634 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1635 CHARSET_MIN_CODE (charset),
1636 CHARSET_MAX_CODE (charset));
1637 range_list = AREF (arg, 4);
1639 for (; CONSP (range_list); range_list = XCDR (range_list))
1640 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1642 if (ascii_changed)
1644 Lisp_Object tail, frame, alist;
1645 int fontset_id = XINT (FONTSET_ID (fontset));
1647 FONTSET_ASCII (fontset) = fontname;
1648 name = FONTSET_NAME (fontset);
1649 FOR_EACH_FRAME (tail, frame)
1651 FRAME_PTR f = XFRAME (frame);
1652 Lisp_Object font_object;
1653 struct face *face;
1655 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1656 continue;
1657 if (fontset_id != FRAME_FONTSET (f))
1658 continue;
1659 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1660 if (face)
1661 font_object = font_load_for_lface (f, face->lface, font_spec);
1662 else
1663 font_object = font_open_by_spec (f, font_spec);
1664 if (! NILP (font_object))
1666 update_auto_fontset_alist (font_object, fontset);
1667 alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
1668 Fmodify_frame_parameters (frame, alist);
1673 /* Free all realized fontsets whose base is FONTSET. This way, the
1674 specified character(s) are surely redisplayed by a correct
1675 font. */
1676 free_realized_fontsets (fontset);
1678 return Qnil;
1682 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1683 doc: /* Create a new fontset NAME from font information in FONTLIST.
1685 FONTLIST is an alist of scripts vs the corresponding font specification list.
1686 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1687 character of SCRIPT is displayed by a font that matches one of
1688 FONT-SPEC.
1690 SCRIPT is a symbol that appears in the first extra slot of the
1691 char-table `char-script-table'.
1693 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1694 `set-fontset-font' for the meaning. */)
1695 (name, fontlist)
1696 Lisp_Object name, fontlist;
1698 Lisp_Object fontset;
1699 int id;
1701 CHECK_STRING (name);
1702 CHECK_LIST (fontlist);
1704 name = Fdowncase (name);
1705 id = fs_query_fontset (name, 0);
1706 if (id < 0)
1708 Lisp_Object font_spec = Ffont_spec (0, NULL);
1709 Lisp_Object short_name;
1710 char xlfd[256];
1711 int len;
1713 if (font_parse_xlfd ((char *) SDATA (name), font_spec) < 0)
1714 error ("Fontset name must be in XLFD format");
1715 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1716 if (strncmp ((char *) SDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1717 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1718 error ("Registry field of fontset name must be \"fontset-*\"");
1719 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1720 Vfontset_alias_alist);
1721 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1722 fontset = make_fontset (Qnil, name, Qnil);
1723 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1724 if (len < 0)
1725 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1726 FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
1728 else
1730 fontset = FONTSET_FROM_ID (id);
1731 free_realized_fontsets (fontset);
1732 Fset_char_table_range (fontset, Qt, Qnil);
1735 for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1737 Lisp_Object elt, script;
1739 elt = Fcar (fontlist);
1740 script = Fcar (elt);
1741 elt = Fcdr (elt);
1742 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1743 for (; CONSP (elt); elt = XCDR (elt))
1744 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1745 else
1746 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1748 return name;
1752 /* Alist of automatically created fontsets. Each element is a cons
1753 (FONT-SPEC . FONTSET-ID). */
1754 static Lisp_Object auto_fontset_alist;
1756 /* Number of automatically created fontsets. */
1757 static int num_auto_fontsets;
1759 /* Retun a fontset synthesized from FONT-OBJECT. This is called from
1760 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1761 frame, and the returned fontset is used for the default fontset of
1762 that frame. The fontset specifies a font of the same registry as
1763 FONT-OBJECT for all characters in the repertory of the registry
1764 (see Vfont_encoding_alist). If the repertory is not known, the
1765 fontset specifies the font for all Latin characters assuming that a
1766 user intends to use FONT-OBJECT for Latin characters. */
1769 fontset_from_font (font_object)
1770 Lisp_Object font_object;
1772 Lisp_Object font_name = font_get_name (font_object);
1773 Lisp_Object font_spec = Fcopy_font_spec (font_object);
1774 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1775 Lisp_Object fontset_spec, alias, name, fontset;
1776 Lisp_Object val;
1778 val = assoc_no_quit (font_spec, auto_fontset_alist);
1779 if (CONSP (val))
1780 return XINT (FONTSET_ID (XCDR (val)));
1781 if (num_auto_fontsets++ == 0)
1782 alias = intern ("fontset-startup");
1783 else
1785 char temp[32];
1787 sprintf (temp, "fontset-auto%d", num_auto_fontsets - 1);
1788 alias = intern (temp);
1790 fontset_spec = Fcopy_font_spec (font_spec);
1791 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1792 name = Ffont_xlfd_name (fontset_spec, Qnil);
1793 if (NILP (name))
1794 abort ();
1795 fontset = make_fontset (Qnil, name, Qnil);
1796 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1797 Vfontset_alias_alist);
1798 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1799 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1800 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
1801 font_spec = Ffont_spec (0, NULL);
1802 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1804 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1806 if (CONSP (target))
1807 target = XCDR (target);
1808 if (! CHARSETP (target))
1809 target = Qlatin;
1810 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1811 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1814 FONTSET_ASCII (fontset) = font_name;
1816 return XINT (FONTSET_ID (fontset));
1820 /* Update auto_fontset_alist for FONTSET. When an ASCII font of
1821 FONTSET is changed, we delete an entry of FONTSET if any from
1822 auto_fontset_alist so that FONTSET is not re-used by
1823 fontset_from_font. */
1825 static void
1826 update_auto_fontset_alist (font_object, fontset)
1827 Lisp_Object font_object, fontset;
1829 Lisp_Object prev, tail;
1831 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1832 prev = tail, tail = XCDR (tail))
1833 if (EQ (fontset, XCDR (XCAR (tail))))
1835 if (NILP (prev))
1836 auto_fontset_alist = XCDR (tail);
1837 else
1838 XSETCDR (prev, XCDR (tail));
1839 break;
1844 /* Return a cons (FONT-OBJECT . GLYPH-CODE).
1845 FONT-OBJECT is the font for the character at POSITION in the current
1846 buffer. This is computed from all the text properties and overlays
1847 that apply to POSITION. POSTION may be nil, in which case,
1848 FONT-SPEC is the font for displaying the character CH with the
1849 default face.
1851 GLYPH-CODE is the glyph code in the font to use for the character.
1853 If the 2nd optional arg CH is non-nil, it is a character to check
1854 the font instead of the character at POSITION.
1856 It returns nil in the following cases:
1858 (1) The window system doesn't have a font for the character (thus
1859 it is displayed by an empty box).
1861 (2) The character code is invalid.
1863 (3) If POSITION is not nil, and the current buffer is not displayed
1864 in any window.
1866 In addition, the returned font name may not take into account of
1867 such redisplay engine hooks as what used in jit-lock-mode if
1868 POSITION is currently not visible. */
1871 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1872 doc: /* For internal use only. */)
1873 (position, ch)
1874 Lisp_Object position, ch;
1876 EMACS_INT pos, pos_byte, dummy;
1877 int face_id;
1878 int c;
1879 struct frame *f;
1880 struct face *face;
1881 int cs_id;
1883 if (NILP (position))
1885 CHECK_CHARACTER (ch);
1886 c = XINT (ch);
1887 f = XFRAME (selected_frame);
1888 face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
1889 pos = -1;
1890 cs_id = -1;
1892 else
1894 Lisp_Object window, charset;
1895 struct window *w;
1897 CHECK_NUMBER_COERCE_MARKER (position);
1898 pos = XINT (position);
1899 if (pos < BEGV || pos >= ZV)
1900 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1901 pos_byte = CHAR_TO_BYTE (pos);
1902 if (NILP (ch))
1903 c = FETCH_CHAR (pos_byte);
1904 else
1906 CHECK_NATNUM (ch);
1907 c = XINT (ch);
1909 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1910 if (NILP (window))
1911 return Qnil;
1912 w = XWINDOW (window);
1913 f = XFRAME (w->frame);
1914 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
1915 pos + 100, 0, -1);
1916 charset = Fget_char_property (position, Qcharset, Qnil);
1917 if (CHARSETP (charset))
1918 cs_id = XINT (CHARSET_SYMBOL_ID (charset));
1919 else
1920 cs_id = -1;
1922 if (! CHAR_VALID_P (c, 0))
1923 return Qnil;
1924 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1925 face = FACE_FROM_ID (f, face_id);
1926 if (face->font)
1928 unsigned code = face->font->driver->encode_char (face->font, c);
1929 Lisp_Object font_object;
1930 /* Assignment to EMACS_INT stops GCC whining about limited range
1931 of data type. */
1932 EMACS_INT cod = code;
1934 if (code == FONT_INVALID_CODE)
1935 return Qnil;
1936 XSETFONT (font_object, face->font);
1937 if (cod <= MOST_POSITIVE_FIXNUM)
1938 return Fcons (font_object, make_number (code));
1939 return Fcons (font_object, Fcons (make_number (code >> 16),
1940 make_number (code & 0xFFFF)));
1942 return Qnil;
1946 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1947 doc: /* Return information about a fontset FONTSET on frame FRAME.
1949 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1950 for the default fontset. FRAME nil means the selected frame.
1952 The value is a char-table whose elements have this form:
1954 ((FONT OPENED-FONT ...) ...)
1956 FONT is a name of font specified for a range of characters.
1958 OPENED-FONT is a name of a font actually opened.
1960 The char-table has one extra slot. If FONTSET is not the default
1961 fontset, the value the extra slot is a char-table containing the
1962 information about the derived fonts from the default fontset. The
1963 format is the same as above. */)
1964 (fontset, frame)
1965 Lisp_Object fontset, frame;
1967 FRAME_PTR f;
1968 Lisp_Object *realized[2], fontsets[2], tables[2];
1969 Lisp_Object val, elt;
1970 int c, i, j, k;
1972 (*check_window_system_func) ();
1974 fontset = check_fontset_name (fontset, &frame);
1975 f = XFRAME (frame);
1977 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1978 in the table `realized'. */
1979 realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1980 * ASIZE (Vfontset_table));
1981 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1983 elt = FONTSET_FROM_ID (i);
1984 if (!NILP (elt)
1985 && EQ (FONTSET_BASE (elt), fontset)
1986 && EQ (FONTSET_FRAME (elt), frame))
1987 realized[0][j++] = elt;
1989 realized[0][j] = Qnil;
1991 realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1992 * ASIZE (Vfontset_table));
1993 for (i = j = 0; ! NILP (realized[0][i]); i++)
1995 elt = FONTSET_DEFAULT (realized[0][i]);
1996 if (! NILP (elt))
1997 realized[1][j++] = elt;
1999 realized[1][j] = Qnil;
2001 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
2002 fontsets[0] = fontset;
2003 if (!EQ (fontset, Vdefault_fontset))
2005 tables[1] = Fmake_char_table (Qnil, Qnil);
2006 XCHAR_TABLE (tables[0])->extras[0] = tables[1];
2007 fontsets[1] = Vdefault_fontset;
2010 /* Accumulate information of the fontset in TABLE. The format of
2011 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
2012 for (k = 0; k <= 1; k++)
2014 for (c = 0; c <= MAX_CHAR; )
2016 int from = c, to = MAX_5_BYTE_CHAR;
2018 if (c <= MAX_5_BYTE_CHAR)
2020 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
2022 else
2024 val = FONTSET_FALLBACK (fontsets[k]);
2025 to = MAX_CHAR;
2027 if (VECTORP (val))
2029 Lisp_Object alist;
2031 /* At first, set ALIST to ((FONT-SPEC) ...). */
2032 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
2033 if (! NILP (AREF (val, i)))
2034 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
2035 alist);
2036 alist = Fnreverse (alist);
2038 /* Then store opened font names to cdr of each elements. */
2039 for (i = 0; ! NILP (realized[k][i]); i++)
2041 if (c <= MAX_5_BYTE_CHAR)
2042 val = FONTSET_REF (realized[k][i], c);
2043 else
2044 val = FONTSET_FALLBACK (realized[k][i]);
2045 if (! CONSP (val) || ! VECTORP (XCDR (val)))
2046 continue;
2047 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
2048 val = XCDR (val);
2049 for (j = 0; j < ASIZE (val); j++)
2051 elt = AREF (val, j);
2052 if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
2054 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
2055 Lisp_Object slot, name;
2057 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
2058 name = AREF (font_object, FONT_NAME_INDEX);
2059 if (NILP (Fmember (name, XCDR (slot))))
2060 nconc2 (slot, Fcons (name, Qnil));
2065 /* Store ALIST in TBL for characters C..TO. */
2066 if (c <= MAX_5_BYTE_CHAR)
2067 char_table_set_range (tables[k], c, to, alist);
2068 else
2069 XCHAR_TABLE (tables[k])->defalt = alist;
2071 /* At last, change each elements to font names. */
2072 for (; CONSP (alist); alist = XCDR (alist))
2074 elt = XCAR (alist);
2075 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
2078 c = to + 1;
2080 if (EQ (fontset, Vdefault_fontset))
2081 break;
2084 return tables[0];
2088 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
2089 doc: /* Return a font name pattern for character CH in fontset NAME.
2090 If NAME is t, find a pattern in the default fontset.
2091 If NAME is nil, find a pattern in the fontset of the selected frame.
2093 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2094 family name and REGISTRY is a font registry name. This is actually
2095 the first font name pattern for CH in the fontset or in the default
2096 fontset.
2098 If the 2nd optional arg ALL is non-nil, return a list of all font name
2099 patterns. */)
2100 (name, ch, all)
2101 Lisp_Object name, ch, all;
2103 int c;
2104 Lisp_Object fontset, elt, list, repertory, val;
2105 int i, j;
2106 Lisp_Object frame;
2108 frame = Qnil;
2109 fontset = check_fontset_name (name, &frame);
2111 CHECK_CHARACTER (ch);
2112 c = XINT (ch);
2113 list = Qnil;
2114 while (1)
2116 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
2117 i++, elt = FONTSET_FALLBACK (fontset))
2118 if (VECTORP (elt))
2119 for (j = 0; j < ASIZE (elt); j++)
2121 Lisp_Object family, registry;
2123 val = AREF (elt, j);
2124 if (NILP (val))
2125 return Qnil;
2126 repertory = AREF (val, 1);
2127 if (INTEGERP (repertory))
2129 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2131 if (! CHAR_CHARSET_P (c, charset))
2132 continue;
2134 else if (CHAR_TABLE_P (repertory))
2136 if (NILP (CHAR_TABLE_REF (repertory, c)))
2137 continue;
2139 val = AREF (val, 0);
2140 /* VAL is a FONT-SPEC */
2141 family = AREF (val, FONT_FAMILY_INDEX);
2142 if (! NILP (family))
2143 family = SYMBOL_NAME (family);
2144 registry = AREF (val, FONT_REGISTRY_INDEX);
2145 if (! NILP (registry))
2146 registry = SYMBOL_NAME (registry);
2147 val = Fcons (family, registry);
2148 if (NILP (all))
2149 return val;
2150 list = Fcons (val, list);
2152 if (EQ (fontset, Vdefault_fontset))
2153 break;
2154 fontset = Vdefault_fontset;
2156 return (Fnreverse (list));
2159 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2160 doc: /* Return a list of all defined fontset names. */)
2163 Lisp_Object fontset, list;
2164 int i;
2166 list = Qnil;
2167 for (i = 0; i < ASIZE (Vfontset_table); i++)
2169 fontset = FONTSET_FROM_ID (i);
2170 if (!NILP (fontset)
2171 && BASE_FONTSET_P (fontset))
2172 list = Fcons (FONTSET_NAME (fontset), list);
2175 return list;
2179 #ifdef FONTSET_DEBUG
2181 Lisp_Object
2182 dump_fontset (fontset)
2183 Lisp_Object fontset;
2185 Lisp_Object vec;
2187 vec = Fmake_vector (make_number (3), Qnil);
2188 ASET (vec, 0, FONTSET_ID (fontset));
2190 if (BASE_FONTSET_P (fontset))
2192 ASET (vec, 1, FONTSET_NAME (fontset));
2194 else
2196 Lisp_Object frame;
2198 frame = FONTSET_FRAME (fontset);
2199 if (FRAMEP (frame))
2201 FRAME_PTR f = XFRAME (frame);
2203 if (FRAME_LIVE_P (f))
2204 ASET (vec, 1,
2205 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
2206 else
2207 ASET (vec, 1,
2208 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2210 if (!NILP (FONTSET_DEFAULT (fontset)))
2211 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2213 return vec;
2216 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2217 doc: /* Return a brief summary of all fontsets for debug use. */)
2220 Lisp_Object val;
2221 int i;
2223 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2224 if (! NILP (AREF (Vfontset_table, i)))
2225 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2226 return (Fnreverse (val));
2228 #endif /* FONTSET_DEBUG */
2230 void
2231 syms_of_fontset ()
2233 DEFSYM (Qfontset, "fontset");
2234 Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
2235 DEFSYM (Qfontset_info, "fontset-info");
2236 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2238 DEFSYM (Qprepend, "prepend");
2239 DEFSYM (Qappend, "append");
2240 DEFSYM (Qlatin, "latin");
2242 Vcached_fontset_data = Qnil;
2243 staticpro (&Vcached_fontset_data);
2245 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2246 staticpro (&Vfontset_table);
2248 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2249 staticpro (&Vdefault_fontset);
2250 FONTSET_ID (Vdefault_fontset) = make_number (0);
2251 FONTSET_NAME (Vdefault_fontset)
2252 = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2253 ASET (Vfontset_table, 0, Vdefault_fontset);
2254 next_fontset_id = 1;
2256 auto_fontset_alist = Qnil;
2257 staticpro (&auto_fontset_alist);
2259 DEFVAR_LISP ("font-encoding-charset-alist", &Vfont_encoding_charset_alist,
2260 doc: /*
2261 Alist of charsets vs the charsets to determine the preferred font encoding.
2262 Each element looks like (CHARSET . ENCODING-CHARSET),
2263 where ENCODING-CHARSET is a charset registered in the variable
2264 `font-encoding-alist' as ENCODING.
2266 When a text has a property `charset' and the value is CHARSET, a font
2267 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2268 Vfont_encoding_charset_alist = Qnil;
2270 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent,
2271 doc: /*
2272 Char table of characters whose ascent values should be ignored.
2273 If an entry for a character is non-nil, the ascent value of the glyph
2274 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2276 This affects how a composite character which contains
2277 such a character is displayed on screen. */);
2278 Vuse_default_ascent = Qnil;
2280 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition,
2281 doc: /*
2282 Char table of characters which are not composed relatively.
2283 If an entry for a character is non-nil, a composition sequence
2284 which contains that character is displayed so that
2285 the glyph of that character is put without considering
2286 an ascent and descent value of a previous character. */);
2287 Vignore_relative_composition = Qnil;
2289 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist,
2290 doc: /* Alist of fontname vs list of the alternate fontnames.
2291 When a specified font name is not found, the corresponding
2292 alternate fontnames (if any) are tried instead. */);
2293 Valternate_fontname_alist = Qnil;
2295 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist,
2296 doc: /* Alist of fontset names vs the aliases. */);
2297 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
2298 make_pure_c_string ("fontset-default")),
2299 Qnil);
2301 DEFVAR_LISP ("vertical-centering-font-regexp",
2302 &Vvertical_centering_font_regexp,
2303 doc: /* *Regexp matching font names that require vertical centering on display.
2304 When a character is displayed with such fonts, the character is displayed
2305 at the vertical center of lines. */);
2306 Vvertical_centering_font_regexp = Qnil;
2308 DEFVAR_LISP ("otf-script-alist", &Votf_script_alist,
2309 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2310 Votf_script_alist = Qnil;
2312 defsubr (&Squery_fontset);
2313 defsubr (&Snew_fontset);
2314 defsubr (&Sset_fontset_font);
2315 defsubr (&Sinternal_char_font);
2316 defsubr (&Sfontset_info);
2317 defsubr (&Sfontset_font);
2318 defsubr (&Sfontset_list);
2319 #ifdef FONTSET_DEBUG
2320 defsubr (&Sfontset_list_all);
2321 #endif
2324 /* arch-tag: ea861585-2f5f-4e5b-9849-d04a9c3a3537
2325 (do not change this comment) */