]> code.delx.au - gnu-emacs/blob - src/fontset.c
Merge from origin/emacs-25
[gnu-emacs] / src / fontset.c
1 /* Fontset handler.
2
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
11
12 This file is part of GNU Emacs.
13
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.
18
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.
23
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/>. */
26
27 #include <config.h>
28 #include <stdio.h>
29
30 #include "lisp.h"
31 #include "blockinput.h"
32 #include "character.h"
33 #include "charset.h"
34 #include "frame.h"
35 #include "dispextern.h"
36 #include "fontset.h"
37 #ifdef HAVE_WINDOW_SYSTEM
38 #include TERM_HEADER
39 #endif /* HAVE_WINDOW_SYSTEM */
40 #include "font.h"
41
42 /* FONTSET
43
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.
49
50 Another role, the more important one, is to provide information
51 about which font to use for each non-ASCII character.
52
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.
59
60 A fontset object is implemented by a char-table whose default value
61 and parent are always nil.
62
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 ].
65
66 An element of a realized fontset is nil, t, 0, or a cons that has
67 this from:
68
69 (CHARSET-ORDERED-LIST-TICK . FONT-GROUP)
70
71 CHARSET_ORDERED_LIST_TICK is the same as charset_ordered_list_tick or -1.
72
73 FONT-GROUP is a vector of elements that have this form:
74
75 [ RFONT-DEF0 RFONT-DEF1 ... ]
76
77 Each RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
78
79 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
80
81 RFONT-DEFn are automatically reordered considering the current
82 charset priority list, the current language environment, and
83 priorities determined by font-backends.
84
85 RFONT-DEFn may not be a vector in the following cases.
86
87 The value nil means that we have not yet generated the above vector
88 from the base of the fontset.
89
90 The value t means that no font is available for the corresponding
91 range of characters.
92
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.
96
97 A fontset has 8 extra slots.
98
99 The 1st slot:
100 base: the ID number of the fontset
101 realized: Likewise
102
103 The 2nd slot:
104 base: the name of the fontset
105 realized: nil
106
107 The 3rd slot:
108 base: the font name for ASCII characters
109 realized: nil
110
111 The 4th slot:
112 base: nil
113 realized: the base fontset
114
115 The 5th slot:
116 base: nil
117 realized: the frame that the fontset belongs to
118
119 The 6th slot:
120 base: nil
121 realized: the ID number of a face to use for characters that
122 has no font in a realized fontset.
123
124 The 7th slot:
125 base: nil
126 realized: If the base is not the default fontset, a fontset
127 realized from the default fontset, else nil.
128
129 The 8th slot:
130 base: Same as element value (but for fallback fonts).
131 realized: Likewise.
132
133 All fontsets are recorded in the vector Vfontset_table.
134
135
136 DEFAULT FONTSET
137
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.
142
143 The parent of a realized fontset created for such a face that has
144 no fontset is the default fontset.
145
146
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.
152
153 */
154
155 /********** VARIABLES and FUNCTION PROTOTYPES **********/
156
157 /* Vector containing all fontsets. */
158 static Lisp_Object Vfontset_table;
159
160 /* Next possibly free fontset ID. Usually this keeps the minimum
161 fontset ID not yet used. */
162 static int next_fontset_id;
163
164 /* The default fontset. This gives default FAMILY and REGISTRY of
165 font for each character. */
166 static Lisp_Object Vdefault_fontset;
167
168 /* Prototype declarations for static functions. */
169 static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
170
171 /* Return true if ID is a valid fontset id.
172 Optimized away if ENABLE_CHECKING is not defined. */
173
174 static bool
175 fontset_id_valid_p (int id)
176 {
177 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
178 }
179
180
181 \f
182 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
183
184 /* Return the fontset with ID. No check of ID's validness. */
185 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
186
187 /* Access special values of FONTSET. */
188
189 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
190 static void
191 set_fontset_id (Lisp_Object fontset, Lisp_Object id)
192 {
193 set_char_table_extras (fontset, 0, id);
194 }
195
196 /* Access special values of (base) FONTSET. */
197
198 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
199 static void
200 set_fontset_name (Lisp_Object fontset, Lisp_Object name)
201 {
202 set_char_table_extras (fontset, 1, name);
203 }
204
205 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[2]
206 static void
207 set_fontset_ascii (Lisp_Object fontset, Lisp_Object ascii)
208 {
209 set_char_table_extras (fontset, 2, ascii);
210 }
211
212 /* Access special values of (realized) FONTSET. */
213
214 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[3]
215 static void
216 set_fontset_base (Lisp_Object fontset, Lisp_Object base)
217 {
218 set_char_table_extras (fontset, 3, base);
219 }
220
221 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[4]
222 static void
223 set_fontset_frame (Lisp_Object fontset, Lisp_Object frame)
224 {
225 set_char_table_extras (fontset, 4, frame);
226 }
227
228 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
229 static void
230 set_fontset_nofont_face (Lisp_Object fontset, Lisp_Object face)
231 {
232 set_char_table_extras (fontset, 5, face);
233 }
234
235 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[6]
236 static void
237 set_fontset_default (Lisp_Object fontset, Lisp_Object def)
238 {
239 set_char_table_extras (fontset, 6, def);
240 }
241
242 /* For both base and realized fontset. */
243
244 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[7]
245 static void
246 set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
247 {
248 set_char_table_extras (fontset, 7, fallback);
249 }
250
251 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
252
253 /* Macros for FONT-DEF and RFONT-DEF of fontset. */
254 #define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
255 do { \
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); \
260 } while (0)
261
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)
265
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
277 preferable. */
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) \
282 do { \
283 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
284 ASET ((rfont_def), 1, (font_def)); \
285 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
286 } while (0)
287
288
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
292 fontset. */
293
294 #define FONTSET_REF(fontset, c) \
295 (EQ (fontset, Vdefault_fontset) \
296 ? CHAR_TABLE_REF (fontset, c) \
297 : fontset_ref ((fontset), (c)))
298
299 static Lisp_Object
300 fontset_ref (Lisp_Object fontset, int c)
301 {
302 Lisp_Object elt;
303
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);
309 return elt;
310 }
311
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. */
315
316 #define FONTSET_SET(fontset, range, elt) \
317 Fset_char_table_range ((fontset), (range), (elt))
318
319
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,
324 append ELT. */
325
326 #define FONTSET_ADD(fontset, range, elt, add) \
327 (NILP (add) \
328 ? (NILP (range) \
329 ? (set_fontset_fallback \
330 (fontset, Fmake_vector (make_number (1), (elt)))) \
331 : ((void) \
332 Fset_char_table_range (fontset, range, \
333 Fmake_vector (make_number (1), elt)))) \
334 : fontset_add ((fontset), (range), (elt), (add)))
335
336 static void
337 fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
338 {
339 Lisp_Object args[2];
340 int idx = (EQ (add, Qappend) ? 0 : 1);
341
342 args[1 - idx] = Fmake_vector (make_number (1), elt);
343
344 if (CONSP (range))
345 {
346 int from = XINT (XCAR (range));
347 int to = XINT (XCDR (range));
348 int from1, to1;
349
350 do {
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)));
356 from = to1 + 1;
357 } while (from < to);
358 }
359 else
360 {
361 args[idx] = FONTSET_FALLBACK (fontset);
362 set_fontset_fallback (fontset,
363 (NILP (args[idx]) ? args[1 - idx]
364 : CALLMANY (Fvconcat, args)));
365 }
366 }
367
368 static int
369 fontset_compare_rfontdef (const void *val1, const void *val2)
370 {
371 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
372 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
373 }
374
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. */
381
382 static void
383 reorder_font_vector (Lisp_Object font_group, struct font *font)
384 {
385 Lisp_Object vec, font_object;
386 int size;
387 int i;
388 bool score_changed = false;
389
390 if (font)
391 XSETFONT (font_object, font);
392 else
393 font_object = Qnil;
394
395 vec = XCDR (font_group);
396 size = ASIZE (vec);
397 /* Exclude the tailing nil element from the reordering. */
398 if (NILP (AREF (vec, size - 1)))
399 size--;
400
401 for (i = 0; i < size; i++)
402 {
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);
408
409 if (! NILP (otf_spec))
410 /* A font-spec with :otf is preferable regardless of encoding
411 and language.. */
412 ;
413 else if (! font_match_p (font_spec, font_object))
414 {
415 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
416
417 if (! NILP (encoding))
418 {
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. */
422 Lisp_Object tail;
423
424 for (tail = Vcharset_ordered_list;
425 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
426 tail = XCDR (tail))
427 if (EQ (encoding, XCAR (tail)))
428 break;
429 else if (score <= min (INT_MAX, MOST_POSITIVE_FIXNUM) - 0x100)
430 score += 0x100;
431 }
432 else
433 {
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
437 larger. */
438 Lisp_Object lang = Ffont_get (font_spec, QClang);
439
440 if (! NILP (lang)
441 && ! EQ (lang, Vcurrent_iso639_language)
442 && (! CONSP (Vcurrent_iso639_language)
443 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
444 score |= 0x100;
445 }
446 }
447 if (RFONT_DEF_SCORE (rfont_def) != score)
448 {
449 RFONT_DEF_SET_SCORE (rfont_def, score);
450 score_changed = true;
451 }
452 }
453
454 if (score_changed)
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));
459 }
460
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. */
466
467 static Lisp_Object
468 fontset_get_font_group (Lisp_Object fontset, int c)
469 {
470 Lisp_Object font_group;
471 Lisp_Object base_fontset;
472 int from = 0, to = MAX_CHAR, i;
473
474 eassert (! BASE_FONTSET_P (fontset));
475 if (c >= 0)
476 font_group = CHAR_TABLE_REF (fontset, c);
477 else
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). */
483 return font_group;
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. */
488 font_group = Qnil;
489 else if (c >= 0)
490 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
491 else
492 font_group = FONTSET_FALLBACK (base_fontset);
493
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))
497 {
498 font_group = make_number (0);
499 if (c >= 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);
504 return font_group;
505 }
506 if (!VECTORP (font_group))
507 return font_group;
508
509 /* Now realize FONT-DEFs of this font group, and update the realized
510 fontset FONTSET. */
511 font_group = Fcopy_sequence (font_group);
512 for (i = 0; i < ASIZE (font_group); i++)
513 if (! NILP (AREF (font_group, i)))
514 {
515 Lisp_Object rfont_def;
516
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);
521 }
522 font_group = Fcons (make_number (-1), font_group);
523 if (c >= 0)
524 char_table_set_range (fontset, from, to, font_group);
525 else
526 set_fontset_fallback (fontset, font_group);
527 return font_group;
528 }
529
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.
534
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).
537
538 CHARSET_ID is a charset-id that must be preferred, or -1 meaning no
539 preference.
540
541 If FALLBACK, search only fallback fonts. */
542
543 static Lisp_Object
544 fontset_find_font (Lisp_Object fontset, int c, struct face *face,
545 int charset_id, bool fallback)
546 {
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;
553
554 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
555 if (! CONSP (font_group))
556 return font_group;
557 vec = XCDR (font_group);
558 if (ASIZE (vec) == 0)
559 return Qnil;
560
561 if (ASIZE (vec) > 1)
562 {
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);
567 if (charset_id >= 0)
568 /* Find a spec matching with CHARSET_ID to try it at
569 first. */
570 for (i = 0; i < ASIZE (vec); i++)
571 {
572 Lisp_Object repertory;
573
574 rfont_def = AREF (vec, i);
575 if (NILP (rfont_def))
576 break;
577 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
578
579 if (XINT (repertory) == charset_id)
580 {
581 charset_matched = i;
582 break;
583 }
584 }
585 }
586
587 /* Find the first available font in the vector of RFONT-DEF. If
588 CHARSET_MATCHED > 0, try the corresponding RFONT-DEF first, then
589 try the rest. */
590 for (i = 0; i < ASIZE (vec); i++)
591 {
592 Lisp_Object font_def;
593 Lisp_Object font_entity, font_object;
594
595 found_index = i;
596 if (i == 0)
597 {
598 if (charset_matched > 0)
599 {
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
603 next loop. */
604 charset_matched = - charset_matched;
605 /* We must try the first element in the next loop. */
606 i = -1;
607 }
608 }
609 else if (i == - charset_matched)
610 {
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++)
617 {
618 rfont_def = AREF (vec, i + 1);
619 if (NILP (rfont_def))
620 break;
621 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
622 break;
623 }
624 continue;
625 }
626
627 rfont_def = AREF (vec, found_index);
628 if (NILP (rfont_def))
629 {
630 if (i < 0)
631 continue;
632 /* This is a sign of not to try the other fonts. */
633 return Qt;
634 }
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. */
638 continue;
639
640 font_object = RFONT_DEF_OBJECT (rfont_def);
641 if (NILP (font_object))
642 {
643 font_def = RFONT_DEF_FONT_DEF (rfont_def);
644
645 if (! face)
646 /* We have not yet opened the font. */
647 return Qnil;
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))
655 {
656 /* Record that no font matches the spec. */
657 RFONT_DEF_SET_FACE (rfont_def, -1);
658 continue;
659 }
660 font_object = font_open_for_lface (f, font_entity, face->lface,
661 FONT_DEF_SPEC (font_def));
662 if (NILP (font_object))
663 {
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);
670 continue;
671 }
672 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
673 }
674
675 if (font_has_char (f, font_object, c))
676 goto found;
677
678 /* Find a font already opened, matching with the current spec,
679 and supporting C. */
680 font_def = RFONT_DEF_FONT_DEF (rfont_def);
681 for (; found_index + 1 < ASIZE (vec); found_index++)
682 {
683 rfont_def = AREF (vec, found_index + 1);
684 if (NILP (rfont_def))
685 break;
686 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
687 break;
688 font_object = RFONT_DEF_OBJECT (rfont_def);
689 if (! NILP (font_object) && font_has_char (f, font_object, c))
690 {
691 found_index++;
692 goto found;
693 }
694 }
695
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))
700 {
701 /* We found a font. Open it and insert a new element for
702 that font in VEC. */
703 Lisp_Object new_vec;
704 int j;
705
706 font_object = font_open_for_lface (f, font_entity, face->lface,
707 Qnil);
708 if (NILP (font_object))
709 continue;
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);
714 found_index++;
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);
721 vec = new_vec;
722 goto found;
723 }
724 if (i >= 0)
725 i = found_index;
726 }
727
728 /* Record that no font in this font group supports C. */
729 FONTSET_SET (fontset, make_number (c), make_number (0));
730 return Qnil;
731
732 found:
733 if (fallback && found_index > 0)
734 {
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
738 quickly. */
739 for (i = found_index; i > 0; i--)
740 ASET (vec, i, AREF (vec, i - 1));
741 ASET (vec, 0, rfont_def);
742 }
743 return rfont_def;
744 }
745
746
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. */
749
750 static Lisp_Object
751 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
752 {
753 Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
754 Lisp_Object base_fontset;
755
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))
760 return rfont_def;
761 if (NILP (rfont_def))
762 FONTSET_SET (fontset, make_number (c), make_number (0));
763
764 /* Try a font-group of the default fontset. */
765 base_fontset = FONTSET_BASE (fontset);
766 if (! EQ (base_fontset, Vdefault_fontset))
767 {
768 if (NILP (FONTSET_DEFAULT (fontset)))
769 set_fontset_default
770 (fontset,
771 make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
772 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
773 default_rfont_def
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),
779 make_number (0));
780 }
781
782 /* Try a fallback font-group of FONTSET. */
783 if (! EQ (rfont_def, Qt))
784 {
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))
788 return rfont_def;
789 /* Remember that FONTSET has no font for C. */
790 FONTSET_SET (fontset, make_number (c), Qt);
791 }
792
793 /* Try a fallback font-group of the default fontset. */
794 if (! EQ (base_fontset, Vdefault_fontset)
795 && ! EQ (default_rfont_def, Qt))
796 {
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))
800 return rfont_def;
801 /* Remember that the default fontset has no font for C. */
802 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
803 }
804
805 return Qnil;
806 }
807
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
810 BASE. */
811
812 static Lisp_Object
813 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
814 {
815 Lisp_Object fontset;
816 int size = ASIZE (Vfontset_table);
817 int id = next_fontset_id;
818
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
823 id. */
824 while (!NILP (AREF (Vfontset_table, id))) id++;
825
826 if (id + 1 == size)
827 Vfontset_table = larger_vector (Vfontset_table, 1, -1);
828
829 fontset = Fmake_char_table (Qfontset, Qnil);
830
831 set_fontset_id (fontset, make_number (id));
832 if (NILP (base))
833 set_fontset_name (fontset, name);
834 else
835 {
836 set_fontset_name (fontset, Qnil);
837 set_fontset_frame (fontset, frame);
838 set_fontset_base (fontset, base);
839 }
840
841 ASET (Vfontset_table, id, fontset);
842 next_fontset_id = id + 1;
843 return fontset;
844 }
845
846 \f
847 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
848
849 /* Return the name of the fontset who has ID. */
850
851 Lisp_Object
852 fontset_name (int id)
853 {
854 Lisp_Object fontset;
855
856 fontset = FONTSET_FROM_ID (id);
857 return FONTSET_NAME (fontset);
858 }
859
860
861 /* Return the ASCII font name of the fontset who has ID. */
862
863 Lisp_Object
864 fontset_ascii (int id)
865 {
866 Lisp_Object fontset, elt;
867
868 fontset= FONTSET_FROM_ID (id);
869 elt = FONTSET_ASCII (fontset);
870 if (CONSP (elt))
871 elt = XCAR (elt);
872 return elt;
873 }
874
875 /* Free fontset of FACE defined on frame F. Called from
876 free_realized_face. */
877
878 void
879 free_face_fontset (struct frame *f, struct face *face)
880 {
881 Lisp_Object fontset;
882
883 fontset = FONTSET_FROM_ID (face->fontset);
884 if (NILP (fontset))
885 return;
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)))
892 {
893 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
894
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;
901 }
902 face->fontset = -1;
903 }
904
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. */
908
909 int
910 face_for_char (struct frame *f, struct face *face, int c,
911 ptrdiff_t pos, Lisp_Object object)
912 {
913 Lisp_Object fontset, rfont_def, charset;
914 int face_id;
915 int id;
916
917 eassert (fontset_id_valid_p (face->fontset));
918
919 if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
920 return face->ascii_face->id;
921
922 if (c > 0 && EQ (CHAR_TABLE_REF (Vchar_script_table, c), Qsymbol))
923 {
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;
939
940 if (face->ascii_face->font)
941 {
942 XSETFONT (font_object, face->ascii_face->font);
943 if (font_has_char (f, font_object, c))
944 return face->ascii_face->id;
945 }
946
947 #if 0
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. */
955 if (face->font)
956 {
957 XSETFONT (font_object, face->font);
958 if (font_has_char (f, font_object, c)) return face->id;
959 }
960 #endif
961 }
962
963 fontset = FONTSET_FROM_ID (face->fontset);
964 eassert (!BASE_FONTSET_P (fontset));
965
966 if (pos < 0)
967 {
968 id = -1;
969 charset = Qnil;
970 }
971 else
972 {
973 charset = Fget_char_property (make_number (pos), Qcharset, object);
974 if (CHARSETP (charset))
975 {
976 Lisp_Object val;
977
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));
982 }
983 else
984 id = -1;
985 }
986
987 rfont_def = fontset_font (fontset, c, face, id);
988 if (VECTORP (rfont_def))
989 {
990 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
991 face_id = XINT (RFONT_DEF_FACE (rfont_def));
992 else
993 {
994 Lisp_Object font_object;
995
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);
999 }
1000 }
1001 else
1002 {
1003 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
1004 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
1005 else
1006 {
1007 face_id = face_for_font (f, Qnil, face);
1008 set_fontset_nofont_face (fontset, make_number (face_id));
1009 }
1010 }
1011 eassert (face_id >= 0);
1012 return face_id;
1013 }
1014
1015
1016 Lisp_Object
1017 font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
1018 {
1019 Lisp_Object fontset, rfont_def, charset;
1020 int id;
1021
1022 if (ASCII_CHAR_P (c))
1023 {
1024 Lisp_Object font_object;
1025
1026 XSETFONT (font_object, face->ascii_face->font);
1027 return font_object;
1028 }
1029
1030 eassert (fontset_id_valid_p (face->fontset));
1031 fontset = FONTSET_FROM_ID (face->fontset);
1032 eassert (!BASE_FONTSET_P (fontset));
1033 if (pos < 0)
1034 {
1035 id = -1;
1036 charset = Qnil;
1037 }
1038 else
1039 {
1040 charset = Fget_char_property (make_number (pos), Qcharset, object);
1041 if (CHARSETP (charset))
1042 {
1043 Lisp_Object val;
1044
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));
1049 }
1050 else
1051 id = -1;
1052 }
1053
1054 rfont_def = fontset_font (fontset, c, face, id);
1055 return (VECTORP (rfont_def)
1056 ? RFONT_DEF_OBJECT (rfont_def)
1057 : Qnil);
1058 }
1059
1060
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. */
1065
1066 int
1067 make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
1068 {
1069 Lisp_Object base_fontset, fontset, frame;
1070
1071 XSETFRAME (frame, f);
1072 if (base_fontset_id >= 0)
1073 {
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));
1078 }
1079 else
1080 base_fontset = Vdefault_fontset;
1081
1082 fontset = make_fontset (frame, Qnil, base_fontset);
1083 return XINT (FONTSET_ID (fontset));
1084 }
1085
1086 \f
1087
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;
1092
1093 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1094 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1095
1096 /* If fontset name PATTERN contains any wild card, return regular
1097 expression corresponding to PATTERN. */
1098
1099 static Lisp_Object
1100 fontset_pattern_regexp (Lisp_Object pattern)
1101 {
1102 if (!strchr (SSDATA (pattern), '*')
1103 && !strchr (SSDATA (pattern), '?'))
1104 /* PATTERN does not contain any wild cards. */
1105 return Qnil;
1106
1107 if (!CONSP (Vcached_fontset_data)
1108 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
1109 {
1110 /* We must at first update the cached data. */
1111 unsigned char *regex, *p0, *p1;
1112 int ndashes = 0, nstars = 0, nescs = 0;
1113
1114 for (p0 = SDATA (pattern); *p0; p0++)
1115 {
1116 if (*p0 == '-')
1117 ndashes++;
1118 else if (*p0 == '*')
1119 nstars++;
1120 else if (*p0 == '['
1121 || *p0 == '.' || *p0 == '\\'
1122 || *p0 == '+' || *p0 == '^'
1123 || *p0 == '$')
1124 nescs++;
1125 }
1126
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
1132 + 2 * nescs + 3);
1133 USE_SAFE_ALLOCA;
1134 p1 = regex = SAFE_ALLOCA (regexsize);
1135
1136 *p1++ = '^';
1137 for (p0 = SDATA (pattern); *p0; p0++)
1138 {
1139 if (*p0 == '*')
1140 {
1141 if (ndashes < 14)
1142 *p1++ = '.';
1143 else
1144 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1145 *p1++ = '*';
1146 }
1147 else if (*p0 == '?')
1148 *p1++ = '.';
1149 else if (*p0 == '['
1150 || *p0 == '.' || *p0 == '\\'
1151 || *p0 == '+' || *p0 == '^'
1152 || *p0 == '$')
1153 *p1++ = '\\', *p1++ = *p0;
1154 else
1155 *p1++ = *p0;
1156 }
1157 *p1++ = '$';
1158 *p1++ = 0;
1159
1160 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
1161 build_string ((char *) regex));
1162 SAFE_FREE ();
1163 }
1164
1165 return CACHED_FONTSET_REGEX;
1166 }
1167
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
1173 */
1174
1175 int
1176 fs_query_fontset (Lisp_Object name, int name_pattern)
1177 {
1178 Lisp_Object tem;
1179 int i;
1180
1181 name = Fdowncase (name);
1182 if (name_pattern != 1)
1183 {
1184 tem = Frassoc (name, Vfontset_alias_alist);
1185 if (NILP (tem))
1186 tem = Fassoc (name, Vfontset_alias_alist);
1187 if (CONSP (tem) && STRINGP (XCAR (tem)))
1188 name = XCAR (tem);
1189 else if (name_pattern == 0)
1190 {
1191 tem = fontset_pattern_regexp (name);
1192 if (STRINGP (tem))
1193 {
1194 name = tem;
1195 name_pattern = 1;
1196 }
1197 }
1198 }
1199
1200 for (i = 0; i < ASIZE (Vfontset_table); i++)
1201 {
1202 Lisp_Object fontset, this_name;
1203
1204 fontset = FONTSET_FROM_ID (i);
1205 if (NILP (fontset)
1206 || !BASE_FONTSET_P (fontset))
1207 continue;
1208
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)))
1213 return i;
1214 }
1215 return -1;
1216 }
1217
1218
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)
1226 {
1227 Lisp_Object fontset;
1228 int id;
1229
1230 check_window_system (NULL);
1231
1232 CHECK_STRING (pattern);
1233
1234 if (SCHARS (pattern) == 0)
1235 return Qnil;
1236
1237 id = fs_query_fontset (pattern, !NILP (regexpp));
1238 if (id < 0)
1239 return Qnil;
1240
1241 fontset = FONTSET_FROM_ID (id);
1242 return FONTSET_NAME (fontset);
1243 }
1244
1245 /* Return a list of base fontset names matching PATTERN on frame F. */
1246
1247 Lisp_Object
1248 list_fontsets (struct frame *f, Lisp_Object pattern, int size)
1249 {
1250 Lisp_Object frame, regexp, val;
1251 int id;
1252
1253 XSETFRAME (frame, f);
1254
1255 regexp = fontset_pattern_regexp (pattern);
1256 val = Qnil;
1257
1258 for (id = 0; id < ASIZE (Vfontset_table); id++)
1259 {
1260 Lisp_Object fontset, name;
1261
1262 fontset = FONTSET_FROM_ID (id);
1263 if (NILP (fontset)
1264 || !BASE_FONTSET_P (fontset)
1265 || !EQ (frame, FONTSET_FRAME (fontset)))
1266 continue;
1267 name = FONTSET_NAME (fontset);
1268
1269 if (STRINGP (regexp)
1270 ? (fast_string_match (regexp, name) < 0)
1271 : strcmp (SSDATA (pattern), SSDATA (name)))
1272 continue;
1273
1274 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1275 }
1276
1277 return val;
1278 }
1279
1280
1281 /* Free all realized fontsets whose base fontset is BASE. */
1282
1283 static void
1284 free_realized_fontsets (Lisp_Object base)
1285 {
1286 int id;
1287
1288 #if 0
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. */
1293 block_input ();
1294 for (id = 0; id < ASIZE (Vfontset_table); id++)
1295 {
1296 Lisp_Object this = AREF (Vfontset_table, id);
1297
1298 if (EQ (FONTSET_BASE (this), base))
1299 {
1300 Lisp_Object tail;
1301
1302 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1303 tail = XCDR (tail))
1304 {
1305 struct frame *f = XFRAME (FONTSET_FRAME (this));
1306 int face_id = XINT (XCDR (XCAR (tail)));
1307 struct face *face = FACE_OPT_FROM_ID (f, face_id);
1308
1309 /* Face THIS itself is also freed by the following call. */
1310 free_realized_face (f, face);
1311 }
1312 }
1313 }
1314 unblock_input ();
1315 #else /* not 0 */
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++)
1319 {
1320 Lisp_Object this = AREF (Vfontset_table, id);
1321
1322 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1323 {
1324 Fclear_face_cache (Qt);
1325 break;
1326 }
1327 }
1328 #endif /* not 0 */
1329 }
1330
1331
1332 /* Check validity of NAME as a fontset name and return the
1333 corresponding fontset. If not valid, signal an error.
1334
1335 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1336 fontset of *FRAME.
1337
1338 Set *FRAME to the actual frame. */
1339
1340 static Lisp_Object
1341 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
1342 {
1343 int id;
1344 struct frame *f = decode_live_frame (*frame);
1345
1346 XSETFRAME (*frame, f);
1347
1348 if (EQ (name, Qt))
1349 return Vdefault_fontset;
1350 if (NILP (name))
1351 id = FRAME_FONTSET (f);
1352 else
1353 {
1354 CHECK_STRING (name);
1355 /* First try NAME as literal. */
1356 id = fs_query_fontset (name, 2);
1357 if (id < 0)
1358 /* For backward compatibility, try again NAME as pattern. */
1359 id = fs_query_fontset (name, 0);
1360 if (id < 0)
1361 error ("Fontset `%s' does not exist", SDATA (name));
1362 }
1363 return FONTSET_FROM_ID (id);
1364 }
1365
1366 static void
1367 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1368 {
1369 if (EQ (XCAR (arg), val))
1370 {
1371 if (CONSP (range))
1372 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1373 else
1374 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1375 }
1376 }
1377
1378
1379 /* Callback function for map_charset_chars in Fset_fontset_font.
1380 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1381
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.
1386
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
1389 case. */
1390
1391 static void
1392 set_fontset_font (Lisp_Object arg, Lisp_Object range)
1393 {
1394 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1395 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1396
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);
1402
1403 if (NILP (ascii) && from < 0x80)
1404 {
1405 if (to < 0x80)
1406 return;
1407 from = 0x80;
1408 range = Fcons (make_number (0x80), XCDR (range));
1409 }
1410
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)
1414
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))
1418 {
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));
1425 }
1426
1427 FONTSET_ADD (fontset, range, font_def, add);
1428 ASET (arg, 4, script_range_list);
1429 }
1430
1431 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
1432
1433
1434 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1435 doc: /*
1436 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1437
1438 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1439 the default fontset.
1440
1441 TARGET may be a single character to use FONT-SPEC for.
1442
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
1445 and TO (inclusive).
1446
1447 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1448 all characters that belong to the script.
1449
1450 TARGET may be a charset. In that case, use FONT-SPEC for all
1451 characters in the charset.
1452
1453 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1454 that no FONT-SPEC is specified.
1455
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.
1463
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.
1466
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)
1472 {
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;
1479
1480 fontset = check_fontset_name (name, &frame);
1481
1482 fontname = Qnil;
1483 if (CONSP (font_spec))
1484 {
1485 Lisp_Object spec = Ffont_spec (0, NULL);
1486
1487 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1488 font_spec = spec;
1489 fontname = Ffont_xlfd_name (font_spec, Qnil);
1490 }
1491 else if (STRINGP (font_spec))
1492 {
1493 fontname = font_spec;
1494 font_spec = CALLN (Ffont_spec, QCname, fontname);
1495 }
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));
1500
1501 if (! NILP (font_spec))
1502 {
1503 Lisp_Object encoding, repertory;
1504
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))
1514 encoding = Qascii;
1515
1516 if (SYMBOLP (encoding))
1517 {
1518 CHECK_CHARSET (encoding);
1519 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1520 }
1521 else
1522 {
1523 repertory = XCDR (encoding);
1524 encoding = XCAR (encoding);
1525 CHECK_CHARSET (encoding);
1526 encoding = CHARSET_SYMBOL_ID (encoding);
1527 if (! NILP (repertory) && SYMBOLP (repertory))
1528 {
1529 CHECK_CHARSET (repertory);
1530 repertory = CHARSET_SYMBOL_ID (repertory);
1531 }
1532 }
1533 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1534 }
1535 else
1536 font_def = Qnil;
1537
1538 if (CHARACTERP (target))
1539 {
1540 if (XFASTINT (target) < 0x80)
1541 error ("Can't set a font for partial ASCII range");
1542 range_list = list1 (Fcons (target, target));
1543 }
1544 else if (CONSP (target))
1545 {
1546 Lisp_Object from, to;
1547
1548 from = Fcar (target);
1549 to = Fcdr (target);
1550 CHECK_CHARACTER (from);
1551 CHECK_CHARACTER (to);
1552 if (XFASTINT (from) < 0x80)
1553 {
1554 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1555 error ("Can't set a font for partial ASCII range");
1556 ascii_changed = 1;
1557 }
1558 range_list = list1 (target);
1559 }
1560 else if (SYMBOLP (target) && !NILP (target))
1561 {
1562 Lisp_Object script_list;
1563 Lisp_Object val;
1564
1565 range_list = Qnil;
1566 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1567 if (! NILP (Fmemq (target, script_list)))
1568 {
1569 if (EQ (target, Qlatin))
1570 ascii_changed = 1;
1571 val = list1 (target);
1572 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1573 val);
1574 range_list = Fnreverse (XCDR (val));
1575 }
1576 if (CHARSETP (target))
1577 {
1578 CHECK_CHARSET_GET_CHARSET (target, charset);
1579 if (charset->ascii_compatible_p)
1580 ascii_changed = 1;
1581 }
1582 else if (NILP (range_list))
1583 error ("Invalid script or charset name: %s",
1584 SDATA (SYMBOL_NAME (target)));
1585 }
1586 else if (NILP (target))
1587 range_list = list1 (Qnil);
1588 else
1589 error ("Invalid target for setting a font");
1590
1591 if (ascii_changed)
1592 {
1593 Lisp_Object val;
1594
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. */
1600 ascii_changed = 0;
1601 }
1602
1603 if (charset)
1604 {
1605 Lisp_Object arg;
1606
1607 arg = make_uninit_vector (5);
1608 ASET (arg, 0, fontset);
1609 ASET (arg, 1, font_def);
1610 ASET (arg, 2, add);
1611 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1612 ASET (arg, 4, range_list);
1613
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);
1618 }
1619 for (; CONSP (range_list); range_list = XCDR (range_list))
1620 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1621
1622 if (ascii_changed)
1623 {
1624 Lisp_Object tail, fr;
1625 int fontset_id = XINT (FONTSET_ID (fontset));
1626
1627 set_fontset_ascii (fontset, fontname);
1628 name = FONTSET_NAME (fontset);
1629 FOR_EACH_FRAME (tail, fr)
1630 {
1631 struct frame *f = XFRAME (fr);
1632 Lisp_Object font_object;
1633 struct face *face;
1634
1635 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1636 continue;
1637 if (fontset_id != FRAME_FONTSET (f))
1638 continue;
1639 face = FACE_OPT_FROM_ID (f, DEFAULT_FACE_ID);
1640 if (face)
1641 font_object = font_load_for_lface (f, face->lface, font_spec);
1642 else
1643 font_object = font_open_by_spec (f, font_spec);
1644 if (! NILP (font_object))
1645 {
1646 update_auto_fontset_alist (font_object, fontset);
1647 AUTO_FRAME_ARG (arg, Qfont, Fcons (name, font_object));
1648 Fmodify_frame_parameters (fr, arg);
1649 }
1650 }
1651 }
1652
1653 /* Free all realized fontsets whose base is FONTSET. This way, the
1654 specified character(s) are surely redisplayed by a correct
1655 font. */
1656 free_realized_fontsets (fontset);
1657
1658 return Qnil;
1659 }
1660
1661
1662 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1663 doc: /* Create a new fontset NAME from font information in FONTLIST.
1664
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
1668 FONT-SPEC.
1669
1670 SCRIPT is a symbol that appears in the first extra slot of the
1671 char-table `char-script-table'.
1672
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)
1676 {
1677 Lisp_Object fontset;
1678 int id;
1679
1680 CHECK_STRING (name);
1681 CHECK_LIST (fontlist);
1682
1683 name = Fdowncase (name);
1684 id = fs_query_fontset (name, 0);
1685 if (id < 0)
1686 {
1687 Lisp_Object font_spec = Ffont_spec (0, NULL);
1688 Lisp_Object short_name;
1689 char xlfd[256];
1690 int len;
1691
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);
1703 if (len < 0)
1704 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1705 set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
1706 }
1707 else
1708 {
1709 fontset = FONTSET_FROM_ID (id);
1710 free_realized_fontsets (fontset);
1711 Fset_char_table_range (fontset, Qt, Qnil);
1712 }
1713
1714 for (; CONSP (fontlist); fontlist = XCDR (fontlist))
1715 {
1716 Lisp_Object elt, script;
1717
1718 elt = XCAR (fontlist);
1719 script = Fcar (elt);
1720 elt = Fcdr (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);
1724 else
1725 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1726 }
1727 return name;
1728 }
1729
1730
1731 /* Alist of automatically created fontsets. Each element is a cons
1732 (FONT-SPEC . FONTSET-ID). */
1733 static Lisp_Object auto_fontset_alist;
1734
1735 /* Number of automatically created fontsets. */
1736 static ptrdiff_t num_auto_fontsets;
1737
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. */
1746
1747 int
1748 fontset_from_font (Lisp_Object font_object)
1749 {
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;
1754 Lisp_Object val;
1755
1756 val = assoc_no_quit (font_spec, auto_fontset_alist);
1757 if (CONSP (val))
1758 return XINT (FONTSET_ID (XCDR (val)));
1759 if (num_auto_fontsets++ == 0)
1760 alias = intern ("fontset-startup");
1761 else
1762 {
1763 char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
1764
1765 sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
1766 alias = intern (temp);
1767 }
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);
1780 {
1781 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1782
1783 if (CONSP (target))
1784 target = XCDR (target);
1785 if (! CHARSETP (target))
1786 target = Qlatin;
1787 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1788 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1789 }
1790
1791 set_fontset_ascii (fontset, font_name);
1792
1793 return XINT (FONTSET_ID (fontset));
1794 }
1795
1796
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. */
1801
1802 static void
1803 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
1804 {
1805 Lisp_Object prev, tail;
1806
1807 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1808 prev = tail, tail = XCDR (tail))
1809 if (EQ (fontset, XCDR (XCAR (tail))))
1810 {
1811 if (NILP (prev))
1812 auto_fontset_alist = XCDR (tail);
1813 else
1814 XSETCDR (prev, XCDR (tail));
1815 break;
1816 }
1817 }
1818
1819
1820 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1821 doc: /* Return information about a fontset FONTSET on frame FRAME.
1822
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.
1825
1826 The value is a char-table whose elements have this form:
1827
1828 ((FONT OPENED-FONT ...) ...)
1829
1830 FONT is a name of font specified for a range of characters.
1831
1832 OPENED-FONT is a name of a font actually opened.
1833
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)
1839 {
1840 Lisp_Object *realized[2], fontsets[2], tables[2];
1841 Lisp_Object val, elt;
1842 int c, i, j, k;
1843
1844 check_window_system (NULL);
1845 fontset = check_fontset_name (fontset, &frame);
1846
1847 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1848 in the table `realized'. */
1849 USE_SAFE_ALLOCA;
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++)
1853 {
1854 elt = FONTSET_FROM_ID (i);
1855 if (!NILP (elt)
1856 && EQ (FONTSET_BASE (elt), fontset)
1857 && EQ (FONTSET_FRAME (elt), frame))
1858 realized[0][j++] = elt;
1859 }
1860 realized[0][j] = Qnil;
1861
1862 for (i = j = 0; ! NILP (realized[0][i]); i++)
1863 {
1864 elt = FONTSET_DEFAULT (realized[0][i]);
1865 if (! NILP (elt))
1866 realized[1][j++] = elt;
1867 }
1868 realized[1][j] = Qnil;
1869
1870 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1871 fontsets[0] = fontset;
1872 if (!EQ (fontset, Vdefault_fontset))
1873 {
1874 tables[1] = Fmake_char_table (Qnil, Qnil);
1875 set_char_table_extras (tables[0], 0, tables[1]);
1876 fontsets[1] = Vdefault_fontset;
1877 }
1878
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++)
1882 {
1883 for (c = 0; c <= MAX_CHAR; )
1884 {
1885 int from = c, to = MAX_5_BYTE_CHAR;
1886
1887 if (c <= MAX_5_BYTE_CHAR)
1888 {
1889 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
1890 }
1891 else
1892 {
1893 val = FONTSET_FALLBACK (fontsets[k]);
1894 to = MAX_CHAR;
1895 }
1896 if (VECTORP (val))
1897 {
1898 Lisp_Object alist;
1899
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),
1904 alist);
1905 alist = Fnreverse (alist);
1906
1907 /* Then store opened font names to cdr of each elements. */
1908 for (i = 0; ! NILP (realized[k][i]); i++)
1909 {
1910 if (c <= MAX_5_BYTE_CHAR)
1911 val = FONTSET_REF (realized[k][i], c);
1912 else
1913 val = FONTSET_FALLBACK (realized[k][i]);
1914 if (! CONSP (val) || ! VECTORP (XCDR (val)))
1915 continue;
1916 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1917 val = XCDR (val);
1918 for (j = 0; j < ASIZE (val); j++)
1919 {
1920 elt = AREF (val, j);
1921 if (!NILP (elt) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1922 {
1923 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1924 Lisp_Object slot, name;
1925
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));
1930 }
1931 }
1932 }
1933
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);
1937 else
1938 set_char_table_defalt (tables[k], alist);
1939
1940 /* At last, change each elements to font names. */
1941 for (; CONSP (alist); alist = XCDR (alist))
1942 {
1943 elt = XCAR (alist);
1944 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
1945 }
1946 }
1947 c = to + 1;
1948 }
1949 if (EQ (fontset, Vdefault_fontset))
1950 break;
1951 }
1952
1953 SAFE_FREE ();
1954 return tables[0];
1955 }
1956
1957
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.
1962
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
1966 fontset.
1967
1968 If the 2nd optional arg ALL is non-nil, return a list of all font name
1969 patterns. */)
1970 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
1971 {
1972 int c;
1973 Lisp_Object fontset, elt, list, repertory, val;
1974 int i, j;
1975 Lisp_Object frame;
1976
1977 frame = Qnil;
1978 fontset = check_fontset_name (name, &frame);
1979
1980 CHECK_CHARACTER (ch);
1981 c = XINT (ch);
1982 list = Qnil;
1983 while (1)
1984 {
1985 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
1986 i++, elt = FONTSET_FALLBACK (fontset))
1987 if (VECTORP (elt))
1988 for (j = 0; j < ASIZE (elt); j++)
1989 {
1990 Lisp_Object family, registry;
1991
1992 val = AREF (elt, j);
1993 if (NILP (val))
1994 return Qnil;
1995 repertory = AREF (val, 1);
1996 if (INTEGERP (repertory))
1997 {
1998 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
1999
2000 if (! CHAR_CHARSET_P (c, charset))
2001 continue;
2002 }
2003 else if (CHAR_TABLE_P (repertory))
2004 {
2005 if (NILP (CHAR_TABLE_REF (repertory, c)))
2006 continue;
2007 }
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);
2017 if (NILP (all))
2018 return val;
2019 list = Fcons (val, list);
2020 }
2021 if (EQ (fontset, Vdefault_fontset))
2022 break;
2023 fontset = Vdefault_fontset;
2024 }
2025 return (Fnreverse (list));
2026 }
2027
2028 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2029 doc: /* Return a list of all defined fontset names. */)
2030 (void)
2031 {
2032 Lisp_Object fontset, list;
2033 int i;
2034
2035 list = Qnil;
2036 for (i = 0; i < ASIZE (Vfontset_table); i++)
2037 {
2038 fontset = FONTSET_FROM_ID (i);
2039 if (!NILP (fontset)
2040 && BASE_FONTSET_P (fontset))
2041 list = Fcons (FONTSET_NAME (fontset), list);
2042 }
2043
2044 return list;
2045 }
2046
2047
2048 #ifdef ENABLE_CHECKING
2049
2050 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
2051
2052 Lisp_Object
2053 dump_fontset (Lisp_Object fontset)
2054 {
2055 Lisp_Object vec;
2056
2057 vec = Fmake_vector (make_number (3), Qnil);
2058 ASET (vec, 0, FONTSET_ID (fontset));
2059
2060 if (BASE_FONTSET_P (fontset))
2061 {
2062 ASET (vec, 1, FONTSET_NAME (fontset));
2063 }
2064 else
2065 {
2066 Lisp_Object frame;
2067
2068 frame = FONTSET_FRAME (fontset);
2069 if (FRAMEP (frame))
2070 {
2071 struct frame *f = XFRAME (frame);
2072
2073 if (FRAME_LIVE_P (f))
2074 ASET (vec, 1,
2075 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
2076 f->name));
2077 else
2078 ASET (vec, 1,
2079 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2080 }
2081 if (!NILP (FONTSET_DEFAULT (fontset)))
2082 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2083 }
2084 return vec;
2085 }
2086
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. */)
2089 (void)
2090 {
2091 Lisp_Object val;
2092 int i;
2093
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));
2098 }
2099 #endif /* ENABLE_CHECKING */
2100
2101 void
2102 syms_of_fontset (void)
2103 {
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));
2108
2109 DEFSYM (Qappend, "append");
2110 DEFSYM (Qlatin, "latin");
2111
2112 Vcached_fontset_data = Qnil;
2113 staticpro (&Vcached_fontset_data);
2114
2115 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2116 staticpro (&Vfontset_table);
2117
2118 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2119 staticpro (&Vdefault_fontset);
2120 set_fontset_id (Vdefault_fontset, make_number (0));
2121 set_fontset_name
2122 (Vdefault_fontset,
2123 build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
2124 ASET (Vfontset_table, 0, Vdefault_fontset);
2125 next_fontset_id = 1;
2126
2127 auto_fontset_alist = Qnil;
2128 staticpro (&auto_fontset_alist);
2129
2130 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
2131 doc: /*
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.
2136
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;
2140
2141 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
2142 doc: /*
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.
2146
2147 This affects how a composite character which contains
2148 such a character is displayed on screen. */);
2149 Vuse_default_ascent = Qnil;
2150
2151 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
2152 doc: /*
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;
2159
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;
2165
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")));
2171
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;
2178
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;
2182
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);
2191 #endif
2192 }