]> code.delx.au - gnu-emacs/blob - src/fontset.c
Fix an error in Tramp for rsync
[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;
754 Lisp_Object default_rfont_def UNINIT;
755 Lisp_Object base_fontset;
756
757 /* Try a font-group of FONTSET. */
758 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
759 rfont_def = fontset_find_font (fontset, c, face, id, 0);
760 if (VECTORP (rfont_def))
761 return rfont_def;
762 if (NILP (rfont_def))
763 FONTSET_SET (fontset, make_number (c), make_number (0));
764
765 /* Try a font-group of the default fontset. */
766 base_fontset = FONTSET_BASE (fontset);
767 if (! EQ (base_fontset, Vdefault_fontset))
768 {
769 if (NILP (FONTSET_DEFAULT (fontset)))
770 set_fontset_default
771 (fontset,
772 make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset));
773 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
774 default_rfont_def
775 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
776 if (VECTORP (default_rfont_def))
777 return default_rfont_def;
778 if (NILP (default_rfont_def))
779 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
780 make_number (0));
781 }
782
783 /* Try a fallback font-group of FONTSET. */
784 if (! EQ (rfont_def, Qt))
785 {
786 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
787 rfont_def = fontset_find_font (fontset, c, face, id, 1);
788 if (VECTORP (rfont_def))
789 return rfont_def;
790 /* Remember that FONTSET has no font for C. */
791 FONTSET_SET (fontset, make_number (c), Qt);
792 }
793
794 /* Try a fallback font-group of the default fontset. */
795 if (! EQ (base_fontset, Vdefault_fontset)
796 && ! EQ (default_rfont_def, Qt))
797 {
798 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
799 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
800 if (VECTORP (rfont_def))
801 return rfont_def;
802 /* Remember that the default fontset has no font for C. */
803 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
804 }
805
806 return Qnil;
807 }
808
809 /* Return a newly created fontset with NAME. If BASE is nil, make a
810 base fontset. Otherwise make a realized fontset whose base is
811 BASE. */
812
813 static Lisp_Object
814 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
815 {
816 Lisp_Object fontset;
817 int size = ASIZE (Vfontset_table);
818 int id = next_fontset_id;
819
820 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
821 the next available fontset ID. So it is expected that this loop
822 terminates quickly. In addition, as the last element of
823 Vfontset_table is always nil, we don't have to check the range of
824 id. */
825 while (!NILP (AREF (Vfontset_table, id))) id++;
826
827 if (id + 1 == size)
828 Vfontset_table = larger_vector (Vfontset_table, 1, -1);
829
830 fontset = Fmake_char_table (Qfontset, Qnil);
831
832 set_fontset_id (fontset, make_number (id));
833 if (NILP (base))
834 set_fontset_name (fontset, name);
835 else
836 {
837 set_fontset_name (fontset, Qnil);
838 set_fontset_frame (fontset, frame);
839 set_fontset_base (fontset, base);
840 }
841
842 ASET (Vfontset_table, id, fontset);
843 next_fontset_id = id + 1;
844 return fontset;
845 }
846
847 \f
848 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
849
850 /* Return the name of the fontset who has ID. */
851
852 Lisp_Object
853 fontset_name (int id)
854 {
855 Lisp_Object fontset;
856
857 fontset = FONTSET_FROM_ID (id);
858 return FONTSET_NAME (fontset);
859 }
860
861
862 /* Return the ASCII font name of the fontset who has ID. */
863
864 Lisp_Object
865 fontset_ascii (int id)
866 {
867 Lisp_Object fontset, elt;
868
869 fontset= FONTSET_FROM_ID (id);
870 elt = FONTSET_ASCII (fontset);
871 if (CONSP (elt))
872 elt = XCAR (elt);
873 return elt;
874 }
875
876 /* Free fontset of FACE defined on frame F. Called from
877 free_realized_face. */
878
879 void
880 free_face_fontset (struct frame *f, struct face *face)
881 {
882 Lisp_Object fontset;
883
884 fontset = FONTSET_FROM_ID (face->fontset);
885 if (NILP (fontset))
886 return;
887 eassert (! BASE_FONTSET_P (fontset));
888 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
889 ASET (Vfontset_table, face->fontset, Qnil);
890 if (face->fontset < next_fontset_id)
891 next_fontset_id = face->fontset;
892 if (! NILP (FONTSET_DEFAULT (fontset)))
893 {
894 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
895
896 fontset = AREF (Vfontset_table, id);
897 eassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
898 eassert (f == XFRAME (FONTSET_FRAME (fontset)));
899 ASET (Vfontset_table, id, Qnil);
900 if (id < next_fontset_id)
901 next_fontset_id = face->fontset;
902 }
903 face->fontset = -1;
904 }
905
906 /* Return ID of face suitable for displaying character C at buffer position
907 POS on frame F. FACE must be realized for ASCII characters in advance.
908 Called from the macro FACE_FOR_CHAR. */
909
910 int
911 face_for_char (struct frame *f, struct face *face, int c,
912 ptrdiff_t pos, Lisp_Object object)
913 {
914 Lisp_Object fontset, rfont_def, charset;
915 int face_id;
916 int id;
917
918 eassert (fontset_id_valid_p (face->fontset));
919
920 if (ASCII_CHAR_P (c) || CHAR_BYTE8_P (c))
921 return face->ascii_face->id;
922
923 if (c > 0 && EQ (CHAR_TABLE_REF (Vchar_script_table, c), Qsymbol))
924 {
925 /* Fonts often have characters for punctuation and other
926 symbols, even if they don't match the 'symbol' script. So
927 check if the character is present in the current ASCII face
928 first, and if so, use the same font as used by that face.
929 This avoids unnecessarily switching to another font when the
930 frame's default font will do. We only do this for symbols so
931 that users could still setup fontsets to force Emacs to use
932 specific fonts for characters from other scripts, because
933 choice of fonts is frequently affected by cultural
934 preferences and font features, not by font coverage.
935 However, these considerations are unlikely to be relevant to
936 punctuation and other symbols, since the latter generally
937 aren't specific to any culture, and don't require
938 sophisticated OTF features. */
939 Lisp_Object font_object;
940
941 if (face->ascii_face->font)
942 {
943 XSETFONT (font_object, face->ascii_face->font);
944 if (font_has_char (f, font_object, c))
945 return face->ascii_face->id;
946 }
947
948 #if 0
949 /* Try the current face. Disabled because it can cause
950 counter-intuitive results, whereby the font used for some
951 character depends on the characters that precede it on
952 display. See the discussion of bug #15138. Note that the
953 original bug reported in #15138 was in a situation where face
954 == face->ascii_face, so the above code solves that situation
955 without risking the undesirable consequences. */
956 if (face->font)
957 {
958 XSETFONT (font_object, face->font);
959 if (font_has_char (f, font_object, c)) return face->id;
960 }
961 #endif
962 }
963
964 fontset = FONTSET_FROM_ID (face->fontset);
965 eassert (!BASE_FONTSET_P (fontset));
966
967 if (pos < 0)
968 {
969 id = -1;
970 charset = Qnil;
971 }
972 else
973 {
974 charset = Fget_char_property (make_number (pos), Qcharset, object);
975 if (CHARSETP (charset))
976 {
977 Lisp_Object val;
978
979 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
980 if (CONSP (val) && CHARSETP (XCDR (val)))
981 charset = XCDR (val);
982 id = XINT (CHARSET_SYMBOL_ID (charset));
983 }
984 else
985 id = -1;
986 }
987
988 rfont_def = fontset_font (fontset, c, face, id);
989 if (VECTORP (rfont_def))
990 {
991 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
992 face_id = XINT (RFONT_DEF_FACE (rfont_def));
993 else
994 {
995 Lisp_Object font_object;
996
997 font_object = RFONT_DEF_OBJECT (rfont_def);
998 face_id = face_for_font (f, font_object, face);
999 RFONT_DEF_SET_FACE (rfont_def, face_id);
1000 }
1001 }
1002 else
1003 {
1004 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
1005 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
1006 else
1007 {
1008 face_id = face_for_font (f, Qnil, face);
1009 set_fontset_nofont_face (fontset, make_number (face_id));
1010 }
1011 }
1012 eassert (face_id >= 0);
1013 return face_id;
1014 }
1015
1016
1017 Lisp_Object
1018 font_for_char (struct face *face, int c, ptrdiff_t pos, Lisp_Object object)
1019 {
1020 Lisp_Object fontset, rfont_def, charset;
1021 int id;
1022
1023 if (ASCII_CHAR_P (c))
1024 {
1025 Lisp_Object font_object;
1026
1027 XSETFONT (font_object, face->ascii_face->font);
1028 return font_object;
1029 }
1030
1031 eassert (fontset_id_valid_p (face->fontset));
1032 fontset = FONTSET_FROM_ID (face->fontset);
1033 eassert (!BASE_FONTSET_P (fontset));
1034 if (pos < 0)
1035 {
1036 id = -1;
1037 charset = Qnil;
1038 }
1039 else
1040 {
1041 charset = Fget_char_property (make_number (pos), Qcharset, object);
1042 if (CHARSETP (charset))
1043 {
1044 Lisp_Object val;
1045
1046 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1047 if (CONSP (val) && CHARSETP (XCDR (val)))
1048 charset = XCDR (val);
1049 id = XINT (CHARSET_SYMBOL_ID (charset));
1050 }
1051 else
1052 id = -1;
1053 }
1054
1055 rfont_def = fontset_font (fontset, c, face, id);
1056 return (VECTORP (rfont_def)
1057 ? RFONT_DEF_OBJECT (rfont_def)
1058 : Qnil);
1059 }
1060
1061
1062 /* Make a realized fontset for ASCII face FACE on frame F from the
1063 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1064 default fontset as the base. Value is the id of the new fontset.
1065 Called from realize_x_face. */
1066
1067 int
1068 make_fontset_for_ascii_face (struct frame *f, int base_fontset_id, struct face *face)
1069 {
1070 Lisp_Object base_fontset, fontset, frame;
1071
1072 XSETFRAME (frame, f);
1073 if (base_fontset_id >= 0)
1074 {
1075 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1076 if (!BASE_FONTSET_P (base_fontset))
1077 base_fontset = FONTSET_BASE (base_fontset);
1078 eassert (BASE_FONTSET_P (base_fontset));
1079 }
1080 else
1081 base_fontset = Vdefault_fontset;
1082
1083 fontset = make_fontset (frame, Qnil, base_fontset);
1084 return XINT (FONTSET_ID (fontset));
1085 }
1086
1087 \f
1088
1089 /* Cache data used by fontset_pattern_regexp. The car part is a
1090 pattern string containing at least one wild card, the cdr part is
1091 the corresponding regular expression. */
1092 static Lisp_Object Vcached_fontset_data;
1093
1094 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1095 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1096
1097 /* If fontset name PATTERN contains any wild card, return regular
1098 expression corresponding to PATTERN. */
1099
1100 static Lisp_Object
1101 fontset_pattern_regexp (Lisp_Object pattern)
1102 {
1103 if (!strchr (SSDATA (pattern), '*')
1104 && !strchr (SSDATA (pattern), '?'))
1105 /* PATTERN does not contain any wild cards. */
1106 return Qnil;
1107
1108 if (!CONSP (Vcached_fontset_data)
1109 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
1110 {
1111 /* We must at first update the cached data. */
1112 unsigned char *regex, *p0, *p1;
1113 int ndashes = 0, nstars = 0, nescs = 0;
1114
1115 for (p0 = SDATA (pattern); *p0; p0++)
1116 {
1117 if (*p0 == '-')
1118 ndashes++;
1119 else if (*p0 == '*')
1120 nstars++;
1121 else if (*p0 == '['
1122 || *p0 == '.' || *p0 == '\\'
1123 || *p0 == '+' || *p0 == '^'
1124 || *p0 == '$')
1125 nescs++;
1126 }
1127
1128 /* If PATTERN is not full XLFD we convert "*" to ".*". Otherwise
1129 we convert "*" to "[^-]*" which is much faster in regular
1130 expression matching. */
1131 ptrdiff_t regexsize = (SBYTES (pattern)
1132 + (ndashes < 14 ? 2 : 5) * nstars
1133 + 2 * nescs + 3);
1134 USE_SAFE_ALLOCA;
1135 p1 = regex = SAFE_ALLOCA (regexsize);
1136
1137 *p1++ = '^';
1138 for (p0 = SDATA (pattern); *p0; p0++)
1139 {
1140 if (*p0 == '*')
1141 {
1142 if (ndashes < 14)
1143 *p1++ = '.';
1144 else
1145 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1146 *p1++ = '*';
1147 }
1148 else if (*p0 == '?')
1149 *p1++ = '.';
1150 else if (*p0 == '['
1151 || *p0 == '.' || *p0 == '\\'
1152 || *p0 == '+' || *p0 == '^'
1153 || *p0 == '$')
1154 *p1++ = '\\', *p1++ = *p0;
1155 else
1156 *p1++ = *p0;
1157 }
1158 *p1++ = '$';
1159 *p1++ = 0;
1160
1161 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
1162 build_string ((char *) regex));
1163 SAFE_FREE ();
1164 }
1165
1166 return CACHED_FONTSET_REGEX;
1167 }
1168
1169 /* Return ID of the base fontset named NAME. If there's no such
1170 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1171 0: pattern containing '*' and '?' as wildcards
1172 1: regular expression
1173 2: literal fontset name
1174 */
1175
1176 int
1177 fs_query_fontset (Lisp_Object name, int name_pattern)
1178 {
1179 Lisp_Object tem;
1180 int i;
1181
1182 name = Fdowncase (name);
1183 if (name_pattern != 1)
1184 {
1185 tem = Frassoc (name, Vfontset_alias_alist);
1186 if (NILP (tem))
1187 tem = Fassoc (name, Vfontset_alias_alist);
1188 if (CONSP (tem) && STRINGP (XCAR (tem)))
1189 name = XCAR (tem);
1190 else if (name_pattern == 0)
1191 {
1192 tem = fontset_pattern_regexp (name);
1193 if (STRINGP (tem))
1194 {
1195 name = tem;
1196 name_pattern = 1;
1197 }
1198 }
1199 }
1200
1201 for (i = 0; i < ASIZE (Vfontset_table); i++)
1202 {
1203 Lisp_Object fontset, this_name;
1204
1205 fontset = FONTSET_FROM_ID (i);
1206 if (NILP (fontset)
1207 || !BASE_FONTSET_P (fontset))
1208 continue;
1209
1210 this_name = FONTSET_NAME (fontset);
1211 if (name_pattern == 1
1212 ? fast_string_match_ignore_case (name, this_name) >= 0
1213 : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
1214 return i;
1215 }
1216 return -1;
1217 }
1218
1219
1220 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1221 doc: /* Return the name of a fontset that matches PATTERN.
1222 The value is nil if there is no matching fontset.
1223 PATTERN can contain `*' or `?' as a wildcard
1224 just as X font name matching algorithm allows.
1225 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1226 (Lisp_Object pattern, Lisp_Object regexpp)
1227 {
1228 Lisp_Object fontset;
1229 int id;
1230
1231 check_window_system (NULL);
1232
1233 CHECK_STRING (pattern);
1234
1235 if (SCHARS (pattern) == 0)
1236 return Qnil;
1237
1238 id = fs_query_fontset (pattern, !NILP (regexpp));
1239 if (id < 0)
1240 return Qnil;
1241
1242 fontset = FONTSET_FROM_ID (id);
1243 return FONTSET_NAME (fontset);
1244 }
1245
1246 /* Return a list of base fontset names matching PATTERN on frame F. */
1247
1248 Lisp_Object
1249 list_fontsets (struct frame *f, Lisp_Object pattern, int size)
1250 {
1251 Lisp_Object frame, regexp, val;
1252 int id;
1253
1254 XSETFRAME (frame, f);
1255
1256 regexp = fontset_pattern_regexp (pattern);
1257 val = Qnil;
1258
1259 for (id = 0; id < ASIZE (Vfontset_table); id++)
1260 {
1261 Lisp_Object fontset, name;
1262
1263 fontset = FONTSET_FROM_ID (id);
1264 if (NILP (fontset)
1265 || !BASE_FONTSET_P (fontset)
1266 || !EQ (frame, FONTSET_FRAME (fontset)))
1267 continue;
1268 name = FONTSET_NAME (fontset);
1269
1270 if (STRINGP (regexp)
1271 ? (fast_string_match (regexp, name) < 0)
1272 : strcmp (SSDATA (pattern), SSDATA (name)))
1273 continue;
1274
1275 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1276 }
1277
1278 return val;
1279 }
1280
1281
1282 /* Free all realized fontsets whose base fontset is BASE. */
1283
1284 static void
1285 free_realized_fontsets (Lisp_Object base)
1286 {
1287 int id;
1288
1289 #if 0
1290 /* For the moment, this doesn't work because free_realized_face
1291 doesn't remove FACE from a cache. Until we find a solution, we
1292 suppress this code, and simply use Fclear_face_cache even though
1293 that is not efficient. */
1294 block_input ();
1295 for (id = 0; id < ASIZE (Vfontset_table); id++)
1296 {
1297 Lisp_Object this = AREF (Vfontset_table, id);
1298
1299 if (EQ (FONTSET_BASE (this), base))
1300 {
1301 Lisp_Object tail;
1302
1303 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1304 tail = XCDR (tail))
1305 {
1306 struct frame *f = XFRAME (FONTSET_FRAME (this));
1307 int face_id = XINT (XCDR (XCAR (tail)));
1308 struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
1309
1310 /* Face THIS itself is also freed by the following call. */
1311 free_realized_face (f, face);
1312 }
1313 }
1314 }
1315 unblock_input ();
1316 #else /* not 0 */
1317 /* But, we don't have to call Fclear_face_cache if no fontset has
1318 been realized from BASE. */
1319 for (id = 0; id < ASIZE (Vfontset_table); id++)
1320 {
1321 Lisp_Object this = AREF (Vfontset_table, id);
1322
1323 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1324 {
1325 Fclear_face_cache (Qt);
1326 break;
1327 }
1328 }
1329 #endif /* not 0 */
1330 }
1331
1332
1333 /* Check validity of NAME as a fontset name and return the
1334 corresponding fontset. If not valid, signal an error.
1335
1336 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1337 fontset of *FRAME.
1338
1339 Set *FRAME to the actual frame. */
1340
1341 static Lisp_Object
1342 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
1343 {
1344 int id;
1345 struct frame *f = decode_live_frame (*frame);
1346
1347 XSETFRAME (*frame, f);
1348
1349 if (EQ (name, Qt))
1350 return Vdefault_fontset;
1351 if (NILP (name))
1352 id = FRAME_FONTSET (f);
1353 else
1354 {
1355 CHECK_STRING (name);
1356 /* First try NAME as literal. */
1357 id = fs_query_fontset (name, 2);
1358 if (id < 0)
1359 /* For backward compatibility, try again NAME as pattern. */
1360 id = fs_query_fontset (name, 0);
1361 if (id < 0)
1362 error ("Fontset `%s' does not exist", SDATA (name));
1363 }
1364 return FONTSET_FROM_ID (id);
1365 }
1366
1367 static void
1368 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1369 {
1370 if (EQ (XCAR (arg), val))
1371 {
1372 if (CONSP (range))
1373 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1374 else
1375 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1376 }
1377 }
1378
1379
1380 /* Callback function for map_charset_chars in Fset_fontset_font.
1381 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1382
1383 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1384 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1385 The consumed ranges are popped up from SCRIPT_RANGE_LIST, and the
1386 new SCRIPT_RANGE_LIST is stored in ARG.
1387
1388 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1389 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1390 case. */
1391
1392 static void
1393 set_fontset_font (Lisp_Object arg, Lisp_Object range)
1394 {
1395 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1396 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1397
1398 fontset = AREF (arg, 0);
1399 font_def = AREF (arg, 1);
1400 add = AREF (arg, 2);
1401 ascii = AREF (arg, 3);
1402 script_range_list = AREF (arg, 4);
1403
1404 if (NILP (ascii) && from < 0x80)
1405 {
1406 if (to < 0x80)
1407 return;
1408 from = 0x80;
1409 range = Fcons (make_number (0x80), XCDR (range));
1410 }
1411
1412 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1413 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1414 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1415
1416 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1417 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1418 if (CONSP (script_range_list))
1419 {
1420 if (SCRIPT_FROM < from)
1421 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1422 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1423 POP_SCRIPT_RANGE ();
1424 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1425 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1426 }
1427
1428 FONTSET_ADD (fontset, range, font_def, add);
1429 ASET (arg, 4, script_range_list);
1430 }
1431
1432 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
1433
1434
1435 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1436 doc: /*
1437 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1438
1439 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1440 the default fontset.
1441
1442 TARGET may be a single character to use FONT-SPEC for.
1443
1444 Target may be a cons (FROM . TO), where FROM and TO are characters.
1445 In that case, use FONT-SPEC for all characters in the range FROM
1446 and TO (inclusive).
1447
1448 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1449 all characters that belong to the script.
1450
1451 TARGET may be a charset. In that case, use FONT-SPEC for all
1452 characters in the charset.
1453
1454 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1455 that no FONT-SPEC is specified.
1456
1457 FONT-SPEC may one of these:
1458 * A font-spec object made by the function `font-spec' (which see).
1459 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1460 REGISTRY is a font registry name. FAMILY may contain foundry
1461 name, and REGISTRY may contain encoding name.
1462 * A font name string.
1463 * nil, which explicitly specifies that there's no font for TARGET.
1464
1465 Optional 4th argument FRAME is a frame or nil for the selected frame
1466 that is concerned in the case that NAME is nil.
1467
1468 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1469 to the font specifications for TARGET previously set. If it is
1470 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1471 appended. By default, FONT-SPEC overrides the previous settings. */)
1472 (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
1473 {
1474 Lisp_Object fontset;
1475 Lisp_Object font_def, registry, family;
1476 Lisp_Object range_list;
1477 struct charset *charset = NULL;
1478 Lisp_Object fontname;
1479 bool ascii_changed = 0;
1480
1481 fontset = check_fontset_name (name, &frame);
1482
1483 fontname = Qnil;
1484 if (CONSP (font_spec))
1485 {
1486 Lisp_Object spec = Ffont_spec (0, NULL);
1487
1488 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1489 font_spec = spec;
1490 fontname = Ffont_xlfd_name (font_spec, Qnil);
1491 }
1492 else if (STRINGP (font_spec))
1493 {
1494 fontname = font_spec;
1495 font_spec = CALLN (Ffont_spec, QCname, fontname);
1496 }
1497 else if (FONT_SPEC_P (font_spec))
1498 fontname = Ffont_xlfd_name (font_spec, Qnil);
1499 else if (! NILP (font_spec))
1500 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1501
1502 if (! NILP (font_spec))
1503 {
1504 Lisp_Object encoding, repertory;
1505
1506 family = AREF (font_spec, FONT_FAMILY_INDEX);
1507 if (! NILP (family) )
1508 family = SYMBOL_NAME (family);
1509 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1510 if (! NILP (registry))
1511 registry = Fdowncase (SYMBOL_NAME (registry));
1512 AUTO_STRING (dash, "-");
1513 encoding = find_font_encoding (concat3 (family, dash, registry));
1514 if (NILP (encoding))
1515 encoding = Qascii;
1516
1517 if (SYMBOLP (encoding))
1518 {
1519 CHECK_CHARSET (encoding);
1520 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1521 }
1522 else
1523 {
1524 repertory = XCDR (encoding);
1525 encoding = XCAR (encoding);
1526 CHECK_CHARSET (encoding);
1527 encoding = CHARSET_SYMBOL_ID (encoding);
1528 if (! NILP (repertory) && SYMBOLP (repertory))
1529 {
1530 CHECK_CHARSET (repertory);
1531 repertory = CHARSET_SYMBOL_ID (repertory);
1532 }
1533 }
1534 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1535 }
1536 else
1537 font_def = Qnil;
1538
1539 if (CHARACTERP (target))
1540 {
1541 if (XFASTINT (target) < 0x80)
1542 error ("Can't set a font for partial ASCII range");
1543 range_list = list1 (Fcons (target, target));
1544 }
1545 else if (CONSP (target))
1546 {
1547 Lisp_Object from, to;
1548
1549 from = Fcar (target);
1550 to = Fcdr (target);
1551 CHECK_CHARACTER (from);
1552 CHECK_CHARACTER (to);
1553 if (XFASTINT (from) < 0x80)
1554 {
1555 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1556 error ("Can't set a font for partial ASCII range");
1557 ascii_changed = 1;
1558 }
1559 range_list = list1 (target);
1560 }
1561 else if (SYMBOLP (target) && !NILP (target))
1562 {
1563 Lisp_Object script_list;
1564 Lisp_Object val;
1565
1566 range_list = Qnil;
1567 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1568 if (! NILP (Fmemq (target, script_list)))
1569 {
1570 if (EQ (target, Qlatin))
1571 ascii_changed = 1;
1572 val = list1 (target);
1573 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1574 val);
1575 range_list = Fnreverse (XCDR (val));
1576 }
1577 if (CHARSETP (target))
1578 {
1579 CHECK_CHARSET_GET_CHARSET (target, charset);
1580 if (charset->ascii_compatible_p)
1581 ascii_changed = 1;
1582 }
1583 else if (NILP (range_list))
1584 error ("Invalid script or charset name: %s",
1585 SDATA (SYMBOL_NAME (target)));
1586 }
1587 else if (NILP (target))
1588 range_list = list1 (Qnil);
1589 else
1590 error ("Invalid target for setting a font");
1591
1592 if (ascii_changed)
1593 {
1594 Lisp_Object val;
1595
1596 if (NILP (font_spec))
1597 error ("Can't set ASCII font to nil");
1598 val = CHAR_TABLE_REF (fontset, 0);
1599 if (! NILP (val) && EQ (add, Qappend))
1600 /* We are going to change just an additional font for ASCII. */
1601 ascii_changed = 0;
1602 }
1603
1604 if (charset)
1605 {
1606 Lisp_Object arg;
1607
1608 arg = make_uninit_vector (5);
1609 ASET (arg, 0, fontset);
1610 ASET (arg, 1, font_def);
1611 ASET (arg, 2, add);
1612 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1613 ASET (arg, 4, range_list);
1614
1615 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1616 CHARSET_MIN_CODE (charset),
1617 CHARSET_MAX_CODE (charset));
1618 range_list = AREF (arg, 4);
1619 }
1620 for (; CONSP (range_list); range_list = XCDR (range_list))
1621 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1622
1623 if (ascii_changed)
1624 {
1625 Lisp_Object tail, fr;
1626 int fontset_id = XINT (FONTSET_ID (fontset));
1627
1628 set_fontset_ascii (fontset, fontname);
1629 name = FONTSET_NAME (fontset);
1630 FOR_EACH_FRAME (tail, fr)
1631 {
1632 struct frame *f = XFRAME (fr);
1633 Lisp_Object font_object;
1634 struct face *face;
1635
1636 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1637 continue;
1638 if (fontset_id != FRAME_FONTSET (f))
1639 continue;
1640 face = FACE_FROM_ID_OR_NULL (f, DEFAULT_FACE_ID);
1641 if (face)
1642 font_object = font_load_for_lface (f, face->lface, font_spec);
1643 else
1644 font_object = font_open_by_spec (f, font_spec);
1645 if (! NILP (font_object))
1646 {
1647 update_auto_fontset_alist (font_object, fontset);
1648 AUTO_FRAME_ARG (arg, Qfont, Fcons (name, font_object));
1649 Fmodify_frame_parameters (fr, arg);
1650 }
1651 }
1652 }
1653
1654 /* Free all realized fontsets whose base is FONTSET. This way, the
1655 specified character(s) are surely redisplayed by a correct
1656 font. */
1657 free_realized_fontsets (fontset);
1658
1659 return Qnil;
1660 }
1661
1662
1663 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1664 doc: /* Create a new fontset NAME from font information in FONTLIST.
1665
1666 FONTLIST is an alist of scripts vs the corresponding font specification list.
1667 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1668 character of SCRIPT is displayed by a font that matches one of
1669 FONT-SPEC.
1670
1671 SCRIPT is a symbol that appears in the first extra slot of the
1672 char-table `char-script-table'.
1673
1674 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1675 `set-fontset-font' for the meaning. */)
1676 (Lisp_Object name, Lisp_Object fontlist)
1677 {
1678 Lisp_Object fontset;
1679 int id;
1680
1681 CHECK_STRING (name);
1682 CHECK_LIST (fontlist);
1683
1684 name = Fdowncase (name);
1685 id = fs_query_fontset (name, 0);
1686 if (id < 0)
1687 {
1688 Lisp_Object font_spec = Ffont_spec (0, NULL);
1689 Lisp_Object short_name;
1690 char xlfd[256];
1691 int len;
1692
1693 if (font_parse_xlfd (SSDATA (name), SBYTES (name), font_spec) < 0)
1694 error ("Fontset name must be in XLFD format");
1695 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1696 if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1697 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1698 error ("Registry field of fontset name must be \"fontset-*\"");
1699 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1700 Vfontset_alias_alist);
1701 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1702 fontset = make_fontset (Qnil, name, Qnil);
1703 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1704 if (len < 0)
1705 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1706 set_fontset_ascii (fontset, make_unibyte_string (xlfd, len));
1707 }
1708 else
1709 {
1710 fontset = FONTSET_FROM_ID (id);
1711 free_realized_fontsets (fontset);
1712 Fset_char_table_range (fontset, Qt, Qnil);
1713 }
1714
1715 for (; CONSP (fontlist); fontlist = XCDR (fontlist))
1716 {
1717 Lisp_Object elt, script;
1718
1719 elt = XCAR (fontlist);
1720 script = Fcar (elt);
1721 elt = Fcdr (elt);
1722 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1723 for (; CONSP (elt); elt = XCDR (elt))
1724 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1725 else
1726 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1727 }
1728 return name;
1729 }
1730
1731
1732 /* Alist of automatically created fontsets. Each element is a cons
1733 (FONT-SPEC . FONTSET-ID). */
1734 static Lisp_Object auto_fontset_alist;
1735
1736 /* Number of automatically created fontsets. */
1737 static ptrdiff_t num_auto_fontsets;
1738
1739 /* Return a fontset synthesized from FONT-OBJECT. This is called from
1740 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1741 frame, and the returned fontset is used for the default fontset of
1742 that frame. The fontset specifies a font of the same registry as
1743 FONT-OBJECT for all characters in the repertory of the registry
1744 (see Vfont_encoding_alist). If the repertory is not known, the
1745 fontset specifies the font for all Latin characters assuming that a
1746 user intends to use FONT-OBJECT for Latin characters. */
1747
1748 int
1749 fontset_from_font (Lisp_Object font_object)
1750 {
1751 Lisp_Object font_name = font_get_name (font_object);
1752 Lisp_Object font_spec = copy_font_spec (font_object);
1753 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1754 Lisp_Object fontset_spec, alias, name, fontset;
1755 Lisp_Object val;
1756
1757 val = assoc_no_quit (font_spec, auto_fontset_alist);
1758 if (CONSP (val))
1759 return XINT (FONTSET_ID (XCDR (val)));
1760 if (num_auto_fontsets++ == 0)
1761 alias = intern ("fontset-startup");
1762 else
1763 {
1764 char temp[sizeof "fontset-auto" + INT_STRLEN_BOUND (ptrdiff_t)];
1765
1766 sprintf (temp, "fontset-auto%"pD"d", num_auto_fontsets - 1);
1767 alias = intern (temp);
1768 }
1769 fontset_spec = copy_font_spec (font_spec);
1770 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1771 name = Ffont_xlfd_name (fontset_spec, Qnil);
1772 eassert (!NILP (name));
1773 fontset = make_fontset (Qnil, name, Qnil);
1774 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1775 Vfontset_alias_alist);
1776 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1777 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1778 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
1779 font_spec = Ffont_spec (0, NULL);
1780 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1781 {
1782 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1783
1784 if (CONSP (target))
1785 target = XCDR (target);
1786 if (! CHARSETP (target))
1787 target = Qlatin;
1788 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1789 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1790 }
1791
1792 set_fontset_ascii (fontset, font_name);
1793
1794 return XINT (FONTSET_ID (fontset));
1795 }
1796
1797
1798 /* Update auto_fontset_alist for FONTSET. When an ASCII font of
1799 FONTSET is changed, we delete an entry of FONTSET if any from
1800 auto_fontset_alist so that FONTSET is not re-used by
1801 fontset_from_font. */
1802
1803 static void
1804 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
1805 {
1806 Lisp_Object prev, tail;
1807
1808 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1809 prev = tail, tail = XCDR (tail))
1810 if (EQ (fontset, XCDR (XCAR (tail))))
1811 {
1812 if (NILP (prev))
1813 auto_fontset_alist = XCDR (tail);
1814 else
1815 XSETCDR (prev, XCDR (tail));
1816 break;
1817 }
1818 }
1819
1820
1821 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1822 doc: /* Return information about a fontset FONTSET on frame FRAME.
1823
1824 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1825 for the default fontset. FRAME nil means the selected frame.
1826
1827 The value is a char-table whose elements have this form:
1828
1829 ((FONT OPENED-FONT ...) ...)
1830
1831 FONT is a name of font specified for a range of characters.
1832
1833 OPENED-FONT is a name of a font actually opened.
1834
1835 The char-table has one extra slot. If FONTSET is not the default
1836 fontset, the value the extra slot is a char-table containing the
1837 information about the derived fonts from the default fontset. The
1838 format is the same as above. */)
1839 (Lisp_Object fontset, Lisp_Object frame)
1840 {
1841 Lisp_Object *realized[2], fontsets[2], tables[2];
1842 Lisp_Object val, elt;
1843 int c, i, j, k;
1844
1845 check_window_system (NULL);
1846 fontset = check_fontset_name (fontset, &frame);
1847
1848 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1849 in the table `realized'. */
1850 USE_SAFE_ALLOCA;
1851 SAFE_ALLOCA_LISP (realized[0], 2 * ASIZE (Vfontset_table));
1852 realized[1] = realized[0] + ASIZE (Vfontset_table);
1853 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1854 {
1855 elt = FONTSET_FROM_ID (i);
1856 if (!NILP (elt)
1857 && EQ (FONTSET_BASE (elt), fontset)
1858 && EQ (FONTSET_FRAME (elt), frame))
1859 realized[0][j++] = elt;
1860 }
1861 realized[0][j] = Qnil;
1862
1863 for (i = j = 0; ! NILP (realized[0][i]); i++)
1864 {
1865 elt = FONTSET_DEFAULT (realized[0][i]);
1866 if (! NILP (elt))
1867 realized[1][j++] = elt;
1868 }
1869 realized[1][j] = Qnil;
1870
1871 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1872 fontsets[0] = fontset;
1873 if (!EQ (fontset, Vdefault_fontset))
1874 {
1875 tables[1] = Fmake_char_table (Qnil, Qnil);
1876 set_char_table_extras (tables[0], 0, tables[1]);
1877 fontsets[1] = Vdefault_fontset;
1878 }
1879
1880 /* Accumulate information of the fontset in TABLE. The format of
1881 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1882 for (k = 0; k <= 1; k++)
1883 {
1884 for (c = 0; c <= MAX_CHAR; )
1885 {
1886 int from = c, to = MAX_5_BYTE_CHAR;
1887
1888 if (c <= MAX_5_BYTE_CHAR)
1889 {
1890 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
1891 }
1892 else
1893 {
1894 val = FONTSET_FALLBACK (fontsets[k]);
1895 to = MAX_CHAR;
1896 }
1897 if (VECTORP (val))
1898 {
1899 Lisp_Object alist;
1900
1901 /* At first, set ALIST to ((FONT-SPEC) ...). */
1902 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1903 if (! NILP (AREF (val, i)))
1904 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
1905 alist);
1906 alist = Fnreverse (alist);
1907
1908 /* Then store opened font names to cdr of each elements. */
1909 for (i = 0; ! NILP (realized[k][i]); i++)
1910 {
1911 if (c <= MAX_5_BYTE_CHAR)
1912 val = FONTSET_REF (realized[k][i], c);
1913 else
1914 val = FONTSET_FALLBACK (realized[k][i]);
1915 if (! CONSP (val) || ! VECTORP (XCDR (val)))
1916 continue;
1917 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1918 val = XCDR (val);
1919 for (j = 0; j < ASIZE (val); j++)
1920 {
1921 elt = AREF (val, j);
1922 if (!NILP (elt) && FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1923 {
1924 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1925 Lisp_Object slot, name;
1926
1927 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
1928 name = AREF (font_object, FONT_NAME_INDEX);
1929 if (NILP (Fmember (name, XCDR (slot))))
1930 nconc2 (slot, list1 (name));
1931 }
1932 }
1933 }
1934
1935 /* Store ALIST in TBL for characters C..TO. */
1936 if (c <= MAX_5_BYTE_CHAR)
1937 char_table_set_range (tables[k], c, to, alist);
1938 else
1939 set_char_table_defalt (tables[k], alist);
1940
1941 /* At last, change each elements to font names. */
1942 for (; CONSP (alist); alist = XCDR (alist))
1943 {
1944 elt = XCAR (alist);
1945 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
1946 }
1947 }
1948 c = to + 1;
1949 }
1950 if (EQ (fontset, Vdefault_fontset))
1951 break;
1952 }
1953
1954 SAFE_FREE ();
1955 return tables[0];
1956 }
1957
1958
1959 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
1960 doc: /* Return a font name pattern for character CH in fontset NAME.
1961 If NAME is t, find a pattern in the default fontset.
1962 If NAME is nil, find a pattern in the fontset of the selected frame.
1963
1964 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
1965 family name and REGISTRY is a font registry name. This is actually
1966 the first font name pattern for CH in the fontset or in the default
1967 fontset.
1968
1969 If the 2nd optional arg ALL is non-nil, return a list of all font name
1970 patterns. */)
1971 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
1972 {
1973 int c;
1974 Lisp_Object fontset, elt, list, repertory, val;
1975 int i, j;
1976 Lisp_Object frame;
1977
1978 frame = Qnil;
1979 fontset = check_fontset_name (name, &frame);
1980
1981 CHECK_CHARACTER (ch);
1982 c = XINT (ch);
1983 list = Qnil;
1984 while (1)
1985 {
1986 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
1987 i++, elt = FONTSET_FALLBACK (fontset))
1988 if (VECTORP (elt))
1989 for (j = 0; j < ASIZE (elt); j++)
1990 {
1991 Lisp_Object family, registry;
1992
1993 val = AREF (elt, j);
1994 if (NILP (val))
1995 return Qnil;
1996 repertory = AREF (val, 1);
1997 if (INTEGERP (repertory))
1998 {
1999 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2000
2001 if (! CHAR_CHARSET_P (c, charset))
2002 continue;
2003 }
2004 else if (CHAR_TABLE_P (repertory))
2005 {
2006 if (NILP (CHAR_TABLE_REF (repertory, c)))
2007 continue;
2008 }
2009 val = AREF (val, 0);
2010 /* VAL is a FONT-SPEC */
2011 family = AREF (val, FONT_FAMILY_INDEX);
2012 if (! NILP (family))
2013 family = SYMBOL_NAME (family);
2014 registry = AREF (val, FONT_REGISTRY_INDEX);
2015 if (! NILP (registry))
2016 registry = SYMBOL_NAME (registry);
2017 val = Fcons (family, registry);
2018 if (NILP (all))
2019 return val;
2020 list = Fcons (val, list);
2021 }
2022 if (EQ (fontset, Vdefault_fontset))
2023 break;
2024 fontset = Vdefault_fontset;
2025 }
2026 return (Fnreverse (list));
2027 }
2028
2029 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2030 doc: /* Return a list of all defined fontset names. */)
2031 (void)
2032 {
2033 Lisp_Object fontset, list;
2034 int i;
2035
2036 list = Qnil;
2037 for (i = 0; i < ASIZE (Vfontset_table); i++)
2038 {
2039 fontset = FONTSET_FROM_ID (i);
2040 if (!NILP (fontset)
2041 && BASE_FONTSET_P (fontset))
2042 list = Fcons (FONTSET_NAME (fontset), list);
2043 }
2044
2045 return list;
2046 }
2047
2048
2049 #ifdef ENABLE_CHECKING
2050
2051 Lisp_Object dump_fontset (Lisp_Object) EXTERNALLY_VISIBLE;
2052
2053 Lisp_Object
2054 dump_fontset (Lisp_Object fontset)
2055 {
2056 Lisp_Object vec;
2057
2058 vec = Fmake_vector (make_number (3), Qnil);
2059 ASET (vec, 0, FONTSET_ID (fontset));
2060
2061 if (BASE_FONTSET_P (fontset))
2062 {
2063 ASET (vec, 1, FONTSET_NAME (fontset));
2064 }
2065 else
2066 {
2067 Lisp_Object frame;
2068
2069 frame = FONTSET_FRAME (fontset);
2070 if (FRAMEP (frame))
2071 {
2072 struct frame *f = XFRAME (frame);
2073
2074 if (FRAME_LIVE_P (f))
2075 ASET (vec, 1,
2076 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)),
2077 f->name));
2078 else
2079 ASET (vec, 1,
2080 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2081 }
2082 if (!NILP (FONTSET_DEFAULT (fontset)))
2083 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2084 }
2085 return vec;
2086 }
2087
2088 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2089 doc: /* Return a brief summary of all fontsets for debug use. */)
2090 (void)
2091 {
2092 Lisp_Object val;
2093 int i;
2094
2095 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2096 if (! NILP (AREF (Vfontset_table, i)))
2097 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2098 return (Fnreverse (val));
2099 }
2100 #endif /* ENABLE_CHECKING */
2101
2102 void
2103 syms_of_fontset (void)
2104 {
2105 DEFSYM (Qfontset, "fontset");
2106 Fput (Qfontset, Qchar_table_extra_slots, make_number (8));
2107 DEFSYM (Qfontset_info, "fontset-info");
2108 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2109
2110 DEFSYM (Qappend, "append");
2111 DEFSYM (Qlatin, "latin");
2112
2113 Vcached_fontset_data = Qnil;
2114 staticpro (&Vcached_fontset_data);
2115
2116 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2117 staticpro (&Vfontset_table);
2118
2119 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2120 staticpro (&Vdefault_fontset);
2121 set_fontset_id (Vdefault_fontset, make_number (0));
2122 set_fontset_name
2123 (Vdefault_fontset,
2124 build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
2125 ASET (Vfontset_table, 0, Vdefault_fontset);
2126 next_fontset_id = 1;
2127
2128 auto_fontset_alist = Qnil;
2129 staticpro (&auto_fontset_alist);
2130
2131 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
2132 doc: /*
2133 Alist of charsets vs the charsets to determine the preferred font encoding.
2134 Each element looks like (CHARSET . ENCODING-CHARSET),
2135 where ENCODING-CHARSET is a charset registered in the variable
2136 `font-encoding-alist' as ENCODING.
2137
2138 When a text has a property `charset' and the value is CHARSET, a font
2139 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2140 Vfont_encoding_charset_alist = Qnil;
2141
2142 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
2143 doc: /*
2144 Char table of characters whose ascent values should be ignored.
2145 If an entry for a character is non-nil, the ascent value of the glyph
2146 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2147
2148 This affects how a composite character which contains
2149 such a character is displayed on screen. */);
2150 Vuse_default_ascent = Qnil;
2151
2152 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
2153 doc: /*
2154 Char table of characters which are not composed relatively.
2155 If an entry for a character is non-nil, a composition sequence
2156 which contains that character is displayed so that
2157 the glyph of that character is put without considering
2158 an ascent and descent value of a previous character. */);
2159 Vignore_relative_composition = Qnil;
2160
2161 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
2162 doc: /* Alist of fontname vs list of the alternate fontnames.
2163 When a specified font name is not found, the corresponding
2164 alternate fontnames (if any) are tried instead. */);
2165 Valternate_fontname_alist = Qnil;
2166
2167 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
2168 doc: /* Alist of fontset names vs the aliases. */);
2169 Vfontset_alias_alist
2170 = list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
2171 build_pure_c_string ("fontset-default")));
2172
2173 DEFVAR_LISP ("vertical-centering-font-regexp",
2174 Vvertical_centering_font_regexp,
2175 doc: /* Regexp matching font names that require vertical centering on display.
2176 When a character is displayed with such fonts, the character is displayed
2177 at the vertical center of lines. */);
2178 Vvertical_centering_font_regexp = Qnil;
2179
2180 DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
2181 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2182 Votf_script_alist = Qnil;
2183
2184 defsubr (&Squery_fontset);
2185 defsubr (&Snew_fontset);
2186 defsubr (&Sset_fontset_font);
2187 defsubr (&Sfontset_info);
2188 defsubr (&Sfontset_font);
2189 defsubr (&Sfontset_list);
2190 #ifdef ENABLE_CHECKING
2191 defsubr (&Sfontset_list_all);
2192 #endif
2193 }