Fix logic of caching display string positions for bidi display.
[bpt/emacs.git] / src / fontset.c
1 /* Fontset handler.
2
3 Copyright (C) 2001-2011 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
17 (at 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 /* #define FONTSET_DEBUG */
28
29 #include <config.h>
30 #include <stdio.h>
31 #include <setjmp.h>
32
33 #include "lisp.h"
34 #include "blockinput.h"
35 #include "buffer.h"
36 #include "character.h"
37 #include "charset.h"
38 #include "ccl.h"
39 #include "keyboard.h"
40 #include "frame.h"
41 #include "dispextern.h"
42 #include "intervals.h"
43 #include "fontset.h"
44 #include "window.h"
45 #ifdef HAVE_X_WINDOWS
46 #include "xterm.h"
47 #endif
48 #ifdef WINDOWSNT
49 #include "w32term.h"
50 #endif
51 #ifdef HAVE_NS
52 #include "nsterm.h"
53 #endif
54 #include "termhooks.h"
55
56 #include "font.h"
57
58 #undef xassert
59 #ifdef FONTSET_DEBUG
60 #define xassert(X) do {if (!(X)) abort ();} while (0)
61 #else /* not FONTSET_DEBUG */
62 #define xassert(X) (void) 0
63 #endif /* not FONTSET_DEBUG */
64
65 /* FONTSET
66
67 A fontset is a collection of font related information to give
68 similar appearance (style, etc) of characters. A fontset has two
69 roles. One is to use for the frame parameter `font' as if it is an
70 ASCII font. In that case, Emacs uses the font specified for
71 `ascii' script for the frame's default font.
72
73 Another role, the more important one, is to provide information
74 about which font to use for each non-ASCII character.
75
76 There are two kinds of fontsets; base and realized. A base fontset
77 is created by `new-fontset' from Emacs Lisp explicitly. A realized
78 fontset is created implicitly when a face is realized for ASCII
79 characters. A face is also realized for non-ASCII characters based
80 on an ASCII face. All of non-ASCII faces based on the same ASCII
81 face share the same realized fontset.
82
83 A fontset object is implemented by a char-table whose default value
84 and parent are always nil.
85
86 An element of a base fontset is a vector of FONT-DEFs which itself
87 is a vector [ FONT-SPEC ENCODING REPERTORY ].
88
89 An element of a realized fontset is nil, t, 0, or a vector of this
90 form:
91
92 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
93 RFONT-DEF0 RFONT-DEF1 ... ]
94
95 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
96
97 [ FACE-ID FONT-DEF FONT-OBJECT SORTING-SCORE ]
98
99 RFONT-DEFn are automatically reordered by the current charset
100 priority list.
101
102 The value nil means that we have not yet generated the above vector
103 from the base of the fontset.
104
105 The value t means that no font is available for the corresponding
106 range of characters.
107
108 The value 0 means that no font is available for the corresponding
109 range of characters in this fontset, but may be available in the
110 default fontset.
111
112
113 A fontset has 9 extra slots.
114
115 The 1st slot: the ID number of the fontset
116
117 The 2nd slot:
118 base: the name of the fontset
119 realized: nil
120
121 The 3rd slot:
122 base: nil
123 realized: the base fontset
124
125 The 4th slot:
126 base: nil
127 realized: the frame that the fontset belongs to
128
129 The 5th slot:
130 base: the font name for ASCII characters
131 realized: nil
132
133 The 6th slot:
134 base: nil
135 realized: the ID number of a face to use for characters that
136 has no font in a realized fontset.
137
138 The 7th slot:
139 base: nil
140 realized: Alist of font index vs the corresponding repertory
141 char-table.
142
143 The 8th slot:
144 base: nil
145 realized: If the base is not the default fontset, a fontset
146 realized from the default fontset, else nil.
147
148 The 9th slot:
149 base: Same as element value (but for fallback fonts).
150 realized: Likewise.
151
152 All fontsets are recorded in the vector Vfontset_table.
153
154
155 DEFAULT FONTSET
156
157 There's a special base fontset named `default fontset' which
158 defines the default font specifications. When a base fontset
159 doesn't specify a font for a specific character, the corresponding
160 value in the default fontset is used.
161
162 The parent of a realized fontset created for such a face that has
163 no fontset is the default fontset.
164
165
166 These structures are hidden from the other codes than this file.
167 The other codes handle fontsets only by their ID numbers. They
168 usually use the variable name `fontset' for IDs. But, in this
169 file, we always use varialbe name `id' for IDs, and name `fontset'
170 for an actual fontset object, i.e., char-table.
171
172 */
173
174 /********** VARIABLES and FUNCTION PROTOTYPES **********/
175
176 static Lisp_Object Qfontset;
177 static Lisp_Object Qfontset_info;
178 static Lisp_Object Qprepend, Qappend;
179 Lisp_Object Qlatin;
180
181 /* Vector containing all fontsets. */
182 static Lisp_Object Vfontset_table;
183
184 /* Next possibly free fontset ID. Usually this keeps the minimum
185 fontset ID not yet used. */
186 static int next_fontset_id;
187
188 /* The default fontset. This gives default FAMILY and REGISTRY of
189 font for each character. */
190 static Lisp_Object Vdefault_fontset;
191
192 /* Check if any window system is used now. */
193 void (*check_window_system_func) (void);
194
195
196 /* Prototype declarations for static functions. */
197 static Lisp_Object fontset_add (Lisp_Object, Lisp_Object, Lisp_Object,
198 Lisp_Object);
199 static Lisp_Object fontset_find_font (Lisp_Object, int, struct face *,
200 int, int);
201 static void reorder_font_vector (Lisp_Object, struct font *);
202 static Lisp_Object fontset_font (Lisp_Object, int, struct face *, int);
203 static Lisp_Object make_fontset (Lisp_Object, Lisp_Object, Lisp_Object);
204 static Lisp_Object fontset_pattern_regexp (Lisp_Object);
205 static void accumulate_script_ranges (Lisp_Object, Lisp_Object,
206 Lisp_Object);
207 static void set_fontset_font (Lisp_Object, Lisp_Object);
208
209 #ifdef FONTSET_DEBUG
210
211 /* Return 1 if ID is a valid fontset id, else return 0. */
212
213 static int
214 fontset_id_valid_p (int id)
215 {
216 return (id >= 0 && id < ASIZE (Vfontset_table) - 1);
217 }
218
219 #endif
220
221
222 \f
223 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
224
225 /* Return the fontset with ID. No check of ID's validness. */
226 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
227
228 /* Macros to access special values of FONTSET. */
229 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
230
231 /* Macros to access special values of (base) FONTSET. */
232 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
233 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
234 /* #define FONTSET_SPEC(fontset) XCHAR_TABLE (fontset)->extras[5] */
235
236 /* Macros to access special values of (realized) FONTSET. */
237 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
238 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
239 /* #define FONTSET_OBJLIST(fontset) XCHAR_TABLE (fontset)->extras[4] */
240 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
241 /* #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6] */
242 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
243
244 /* For both base and realized fontset. */
245 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
246
247 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
248
249
250 /* Macros for FONT-DEF and RFONT-DEF of fontset. */
251 #define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
252 do { \
253 (font_def) = Fmake_vector (make_number (3), (font_spec)); \
254 ASET ((font_def), 1, encoding); \
255 ASET ((font_def), 2, repertory); \
256 } while (0)
257
258 #define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
259 #define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
260 #define FONT_DEF_REPERTORY(font_def) AREF (font_def, 2)
261
262 #define RFONT_DEF_FACE(rfont_def) AREF (rfont_def, 0)
263 #define RFONT_DEF_SET_FACE(rfont_def, face_id) \
264 ASET ((rfont_def), 0, make_number (face_id))
265 #define RFONT_DEF_FONT_DEF(rfont_def) AREF (rfont_def, 1)
266 #define RFONT_DEF_SPEC(rfont_def) FONT_DEF_SPEC (AREF (rfont_def, 1))
267 #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2)
268 #define RFONT_DEF_SET_OBJECT(rfont_def, object) \
269 ASET ((rfont_def), 2, (object))
270 /* Score of RFONT_DEF is an integer value; the lowest 8 bits represent
271 the order of listing by font backends, the higher bits represents
272 the order given by charset priority list. The smaller value is
273 preferable. */
274 #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3))
275 #define RFONT_DEF_SET_SCORE(rfont_def, score) \
276 ASET ((rfont_def), 3, make_number (score))
277 #define RFONT_DEF_NEW(rfont_def, font_def) \
278 do { \
279 (rfont_def) = Fmake_vector (make_number (4), Qnil); \
280 ASET ((rfont_def), 1, (font_def)); \
281 RFONT_DEF_SET_SCORE ((rfont_def), 0); \
282 } while (0)
283
284
285 /* Return the element of FONTSET for the character C. If FONTSET is a
286 base fontset other then the default fontset and FONTSET doesn't
287 contain information for C, return the information in the default
288 fontset. */
289
290 #define FONTSET_REF(fontset, c) \
291 (EQ (fontset, Vdefault_fontset) \
292 ? CHAR_TABLE_REF (fontset, c) \
293 : fontset_ref ((fontset), (c)))
294
295 static Lisp_Object
296 fontset_ref (Lisp_Object fontset, int c)
297 {
298 Lisp_Object elt;
299
300 elt = CHAR_TABLE_REF (fontset, c);
301 if (NILP (elt) && ! EQ (fontset, Vdefault_fontset)
302 /* Don't check Vdefault_fontset for a realized fontset. */
303 && NILP (FONTSET_BASE (fontset)))
304 elt = CHAR_TABLE_REF (Vdefault_fontset, c);
305 return elt;
306 }
307
308 /* Set elements of FONTSET for characters in RANGE to the value ELT.
309 RANGE is a cons (FROM . TO), where FROM and TO are character codes
310 specifying a range. */
311
312 #define FONTSET_SET(fontset, range, elt) \
313 Fset_char_table_range ((fontset), (range), (elt))
314
315
316 /* Modify the elements of FONTSET for characters in RANGE by replacing
317 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
318 and TO are character codes specifying a range. If ADD is nil,
319 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
320 append ELT. */
321
322 #define FONTSET_ADD(fontset, range, elt, add) \
323 (NILP (add) \
324 ? (NILP (range) \
325 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
326 : Fset_char_table_range ((fontset), (range), \
327 Fmake_vector (make_number (1), (elt)))) \
328 : fontset_add ((fontset), (range), (elt), (add)))
329
330 static Lisp_Object
331 fontset_add (Lisp_Object fontset, Lisp_Object range, Lisp_Object elt, Lisp_Object add)
332 {
333 Lisp_Object args[2];
334 int idx = (EQ (add, Qappend) ? 0 : 1);
335
336 args[1 - idx] = Fmake_vector (make_number (1), elt);
337
338 if (CONSP (range))
339 {
340 int from = XINT (XCAR (range));
341 int to = XINT (XCDR (range));
342 int from1, to1;
343
344 do {
345 from1 = from, to1 = to;
346 args[idx] = char_table_ref_and_range (fontset, from, &from1, &to1);
347 char_table_set_range (fontset, from, to1,
348 NILP (args[idx]) ? args[1 - idx]
349 : Fvconcat (2, args));
350 from = to1 + 1;
351 } while (from < to);
352 }
353 else
354 {
355 args[idx] = FONTSET_FALLBACK (fontset);
356 FONTSET_FALLBACK (fontset)
357 = NILP (args[idx]) ? args[1 - idx] : Fvconcat (2, args);
358 }
359 return Qnil;
360 }
361
362 static int
363 fontset_compare_rfontdef (const void *val1, const void *val2)
364 {
365 return (RFONT_DEF_SCORE (*(Lisp_Object *) val1)
366 - RFONT_DEF_SCORE (*(Lisp_Object *) val2));
367 }
368
369 /* Update FONT-GROUP which has this form:
370 [ CHARSET-ORDERED-LIST-TICK PREFERRED-RFONT-DEF
371 RFONT-DEF0 RFONT-DEF1 ... ]
372 Reorder RFONT-DEFs according to the current language, and update
373 CHARSET-ORDERED-LIST-TICK.
374
375 If PREFERRED_FAMILY is not nil, that family has the higher priority
376 if the encoding charsets or languages in font-specs are the same. */
377
378 static void
379 reorder_font_vector (Lisp_Object font_group, struct font *font)
380 {
381 Lisp_Object vec, font_object;
382 int size;
383 int i;
384 int score_changed = 0;
385
386 if (font)
387 XSETFONT (font_object, font);
388 else
389 font_object = Qnil;
390
391 vec = XCDR (font_group);
392 size = ASIZE (vec);
393 /* Exclude the tailing nil element from the reordering. */
394 if (NILP (AREF (vec, size - 1)))
395 size--;
396
397 for (i = 0; i < size; i++)
398 {
399 Lisp_Object rfont_def = AREF (vec, i);
400 Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def);
401 Lisp_Object font_spec = FONT_DEF_SPEC (font_def);
402 int score = RFONT_DEF_SCORE (rfont_def) & 0xFF;
403 Lisp_Object otf_spec = Ffont_get (font_spec, QCotf);
404
405 if (! NILP (otf_spec))
406 /* A font-spec with :otf is preferable regardless of encoding
407 and language.. */
408 ;
409 else if (! font_match_p (font_spec, font_object))
410 {
411 Lisp_Object encoding = FONT_DEF_ENCODING (font_def);
412
413 if (! NILP (encoding))
414 {
415 Lisp_Object tail;
416
417 for (tail = Vcharset_ordered_list;
418 ! EQ (tail, Vcharset_non_preferred_head) && CONSP (tail);
419 score += 0x100, tail = XCDR (tail))
420 if (EQ (encoding, XCAR (tail)))
421 break;
422 }
423 else
424 {
425 Lisp_Object lang = Ffont_get (font_spec, QClang);
426
427 if (! NILP (lang)
428 && ! EQ (lang, Vcurrent_iso639_language)
429 && (! CONSP (Vcurrent_iso639_language)
430 || NILP (Fmemq (lang, Vcurrent_iso639_language))))
431 score |= 0x100;
432 }
433 }
434 if (RFONT_DEF_SCORE (rfont_def) != score)
435 {
436 RFONT_DEF_SET_SCORE (rfont_def, score);
437 score_changed = 1;
438 }
439 }
440
441 if (score_changed)
442 qsort (XVECTOR (vec)->contents, size, sizeof (Lisp_Object),
443 fontset_compare_rfontdef);
444 XSETCAR (font_group, make_number (charset_ordered_list_tick));
445 }
446
447 /* Return a font-group (actually a cons (-1 . FONT-GROUP-VECTOR)) for
448 character C in FONTSET. If C is -1, return a fallback font-group.
449 If C is not -1, the value may be Qt (FONTSET doesn't have a font
450 for C even in the fallback group, or 0 (a font for C may be found
451 only in the fallback group). */
452
453 static Lisp_Object
454 fontset_get_font_group (Lisp_Object fontset, int c)
455 {
456 Lisp_Object font_group;
457 Lisp_Object base_fontset;
458 int from = 0, to = MAX_CHAR, i;
459
460 xassert (! BASE_FONTSET_P (fontset));
461 if (c >= 0)
462 font_group = CHAR_TABLE_REF (fontset, c);
463 else
464 font_group = FONTSET_FALLBACK (fontset);
465 if (! NILP (font_group))
466 return font_group;
467 base_fontset = FONTSET_BASE (fontset);
468 if (c >= 0)
469 font_group = char_table_ref_and_range (base_fontset, c, &from, &to);
470 else
471 font_group = FONTSET_FALLBACK (base_fontset);
472 if (NILP (font_group))
473 {
474 font_group = make_number (0);
475 if (c >= 0)
476 char_table_set_range (fontset, from, to, font_group);
477 return font_group;
478 }
479 font_group = Fcopy_sequence (font_group);
480 for (i = 0; i < ASIZE (font_group); i++)
481 if (! NILP (AREF (font_group, i)))
482 {
483 Lisp_Object rfont_def;
484
485 RFONT_DEF_NEW (rfont_def, AREF (font_group, i));
486 /* Remember the original order. */
487 RFONT_DEF_SET_SCORE (rfont_def, i);
488 ASET (font_group, i, rfont_def);
489 }
490 font_group = Fcons (make_number (-1), font_group);
491 if (c >= 0)
492 char_table_set_range (fontset, from, to, font_group);
493 else
494 FONTSET_FALLBACK (fontset) = font_group;
495 return font_group;
496 }
497
498 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
499 character C. If no font is found, return Qnil if there's a
500 possibility that the default fontset or the fallback font groups
501 have a proper font, and return Qt if not.
502
503 If a font is found but is not yet opened, open it (if FACE is not
504 NULL) or return Qnil (if FACE is NULL).
505
506 ID is a charset-id that must be preferred, or -1 meaning no
507 preference.
508
509 If FALLBACK is nonzero, search only fallback fonts. */
510
511 static Lisp_Object
512 fontset_find_font (Lisp_Object fontset, int c, struct face *face, int id, int fallback)
513 {
514 Lisp_Object vec, font_group;
515 int i, charset_matched = 0, found_index;
516 FRAME_PTR f = (FRAMEP (FONTSET_FRAME (fontset))
517 ? XFRAME (FONTSET_FRAME (fontset)) : XFRAME (selected_frame));
518 Lisp_Object rfont_def;
519
520 font_group = fontset_get_font_group (fontset, fallback ? -1 : c);
521 if (! CONSP (font_group))
522 return font_group;
523 vec = XCDR (font_group);
524 if (ASIZE (vec) == 0)
525 return Qnil;
526
527 if (ASIZE (vec) > 1)
528 {
529 if (XINT (XCAR (font_group)) != charset_ordered_list_tick)
530 /* We have just created the font-group,
531 or the charset priorities were changed. */
532 reorder_font_vector (font_group, face->ascii_face->font);
533 if (id >= 0)
534 /* Find a spec matching with the charset ID to try at
535 first. */
536 for (i = 0; i < ASIZE (vec); i++)
537 {
538 Lisp_Object repertory;
539
540 rfont_def = AREF (vec, i);
541 if (NILP (rfont_def))
542 break;
543 repertory = FONT_DEF_REPERTORY (RFONT_DEF_FONT_DEF (rfont_def));
544
545 if (XINT (repertory) == id)
546 {
547 charset_matched = i;
548 break;
549 }
550 }
551 }
552
553 /* Find the first available font in the vector of RFONT-DEF. */
554 for (i = 0; i < ASIZE (vec); i++)
555 {
556 Lisp_Object font_def;
557 Lisp_Object font_entity, font_object;
558
559 found_index = i;
560 if (i == 0)
561 {
562 if (charset_matched > 0)
563 {
564 /* Try the element matching with the charset ID at first. */
565 found_index = charset_matched;
566 /* Make this negative so that we don't come here in the
567 next loop. */
568 charset_matched = - charset_matched;
569 /* We must try the first element in the next loop. */
570 i--;
571 }
572 }
573 else if (i == - charset_matched)
574 {
575 /* We have already tried this element and the followings
576 that have the same font specifications in the first
577 iteration. So, skip them all. */
578 rfont_def = AREF (vec, i);
579 font_def = RFONT_DEF_FONT_DEF (rfont_def);
580 for (; i + 1 < ASIZE (vec); i++)
581 {
582 rfont_def = AREF (vec, i + 1);
583 if (NILP (rfont_def))
584 break;
585 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
586 break;
587 }
588 continue;
589 }
590
591 rfont_def = AREF (vec, found_index);
592 if (NILP (rfont_def))
593 {
594 if (i < 0)
595 continue;
596 /* This is a sign of not to try the other fonts. */
597 return Qt;
598 }
599 if (INTEGERP (RFONT_DEF_FACE (rfont_def))
600 && XINT (RFONT_DEF_FACE (rfont_def)) < 0)
601 /* We couldn't open this font last time. */
602 continue;
603
604 font_object = RFONT_DEF_OBJECT (rfont_def);
605 if (NILP (font_object))
606 {
607 font_def = RFONT_DEF_FONT_DEF (rfont_def);
608
609 if (! face)
610 /* We have not yet opened the font. */
611 return Qnil;
612 /* Find a font best-matching with the spec without checking
613 the support of the character C. That checking is costly,
614 and even without the checking, the found font supports C
615 in high possibility. */
616 font_entity = font_find_for_lface (f, face->lface,
617 FONT_DEF_SPEC (font_def), -1);
618 if (NILP (font_entity))
619 {
620 /* Record that no font matches the spec. */
621 RFONT_DEF_SET_FACE (rfont_def, -1);
622 continue;
623 }
624 font_object = font_open_for_lface (f, font_entity, face->lface,
625 FONT_DEF_SPEC (font_def));
626 if (NILP (font_object))
627 {
628 /* Something strange happened, perhaps because of a
629 Font-backend problem. Too avoid crashing, record
630 that this spec is unsable. It may be better to find
631 another font of the same spec, but currently we don't
632 have such an API. */
633 RFONT_DEF_SET_FACE (rfont_def, -1);
634 continue;
635 }
636 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
637 }
638
639 if (font_has_char (f, font_object, c))
640 goto found;
641
642 /* Find a font already opened, maching with the current spec,
643 and supporting C. */
644 font_def = RFONT_DEF_FONT_DEF (rfont_def);
645 for (; found_index + 1 < ASIZE (vec); found_index++)
646 {
647 rfont_def = AREF (vec, found_index + 1);
648 if (NILP (rfont_def))
649 break;
650 if (! EQ (RFONT_DEF_FONT_DEF (rfont_def), font_def))
651 break;
652 font_object = RFONT_DEF_OBJECT (rfont_def);
653 if (! NILP (font_object) && font_has_char (f, font_object, c))
654 {
655 found_index++;
656 goto found;
657 }
658 }
659
660 /* Find a font-entity with the current spec and supporting C. */
661 font_entity = font_find_for_lface (f, face->lface,
662 FONT_DEF_SPEC (font_def), c);
663 if (! NILP (font_entity))
664 {
665 /* We found a font. Open it and insert a new element for
666 that font in VEC. */
667 Lisp_Object new_vec;
668 int j;
669
670 font_object = font_open_for_lface (f, font_entity, face->lface,
671 Qnil);
672 if (NILP (font_object))
673 continue;
674 RFONT_DEF_NEW (rfont_def, font_def);
675 RFONT_DEF_SET_OBJECT (rfont_def, font_object);
676 RFONT_DEF_SET_SCORE (rfont_def, RFONT_DEF_SCORE (rfont_def));
677 new_vec = Fmake_vector (make_number (ASIZE (vec) + 1), Qnil);
678 found_index++;
679 for (j = 0; j < found_index; j++)
680 ASET (new_vec, j, AREF (vec, j));
681 ASET (new_vec, j, rfont_def);
682 for (j++; j < ASIZE (new_vec); j++)
683 ASET (new_vec, j, AREF (vec, j - 1));
684 XSETCDR (font_group, new_vec);
685 vec = new_vec;
686 goto found;
687 }
688 if (i >= 0)
689 i = found_index;
690 }
691
692 FONTSET_SET (fontset, make_number (c), make_number (0));
693 return Qnil;
694
695 found:
696 if (fallback && found_index > 0)
697 {
698 /* The order of fonts in the fallback font-group is not that
699 important, and it is better to move the found font to the
700 first of the group so that the next try will find it
701 quickly. */
702 for (i = found_index; i > 0; i--)
703 ASET (vec, i, AREF (vec, i - 1));
704 ASET (vec, 0, rfont_def);
705 }
706 return rfont_def;
707 }
708
709
710 static Lisp_Object
711 fontset_font (Lisp_Object fontset, int c, struct face *face, int id)
712 {
713 Lisp_Object rfont_def, default_rfont_def IF_LINT (= Qnil);
714 Lisp_Object base_fontset;
715
716 /* Try a font-group of FONTSET. */
717 FONT_DEFERRED_LOG ("current fontset: font for", make_number (c), Qnil);
718 rfont_def = fontset_find_font (fontset, c, face, id, 0);
719 if (VECTORP (rfont_def))
720 return rfont_def;
721 if (NILP (rfont_def))
722 FONTSET_SET (fontset, make_number (c), make_number (0));
723
724 /* Try a font-group of the default fontset. */
725 base_fontset = FONTSET_BASE (fontset);
726 if (! EQ (base_fontset, Vdefault_fontset))
727 {
728 if (NILP (FONTSET_DEFAULT (fontset)))
729 FONTSET_DEFAULT (fontset)
730 = make_fontset (FONTSET_FRAME (fontset), Qnil, Vdefault_fontset);
731 FONT_DEFERRED_LOG ("default fontset: font for", make_number (c), Qnil);
732 default_rfont_def
733 = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 0);
734 if (VECTORP (default_rfont_def))
735 return default_rfont_def;
736 if (NILP (default_rfont_def))
737 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c),
738 make_number (0));
739 }
740
741 /* Try a fallback font-group of FONTSET. */
742 if (! EQ (rfont_def, Qt))
743 {
744 FONT_DEFERRED_LOG ("current fallback: font for", make_number (c), Qnil);
745 rfont_def = fontset_find_font (fontset, c, face, id, 1);
746 if (VECTORP (rfont_def))
747 return rfont_def;
748 /* Remember that FONTSET has no font for C. */
749 FONTSET_SET (fontset, make_number (c), Qt);
750 }
751
752 /* Try a fallback font-group of the default fontset. */
753 if (! EQ (base_fontset, Vdefault_fontset)
754 && ! EQ (default_rfont_def, Qt))
755 {
756 FONT_DEFERRED_LOG ("default fallback: font for", make_number (c), Qnil);
757 rfont_def = fontset_find_font (FONTSET_DEFAULT (fontset), c, face, id, 1);
758 if (VECTORP (rfont_def))
759 return rfont_def;
760 /* Remember that the default fontset has no font for C. */
761 FONTSET_SET (FONTSET_DEFAULT (fontset), make_number (c), Qt);
762 }
763
764 return Qnil;
765 }
766
767 /* Return a newly created fontset with NAME. If BASE is nil, make a
768 base fontset. Otherwise make a realized fontset whose base is
769 BASE. */
770
771 static Lisp_Object
772 make_fontset (Lisp_Object frame, Lisp_Object name, Lisp_Object base)
773 {
774 Lisp_Object fontset;
775 int size = ASIZE (Vfontset_table);
776 int id = next_fontset_id;
777
778 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
779 the next available fontset ID. So it is expected that this loop
780 terminates quickly. In addition, as the last element of
781 Vfontset_table is always nil, we don't have to check the range of
782 id. */
783 while (!NILP (AREF (Vfontset_table, id))) id++;
784
785 if (id + 1 == size)
786 Vfontset_table = larger_vector (Vfontset_table, size + 32, Qnil);
787
788 fontset = Fmake_char_table (Qfontset, Qnil);
789
790 FONTSET_ID (fontset) = make_number (id);
791 if (NILP (base))
792 {
793 FONTSET_NAME (fontset) = name;
794 }
795 else
796 {
797 FONTSET_NAME (fontset) = Qnil;
798 FONTSET_FRAME (fontset) = frame;
799 FONTSET_BASE (fontset) = base;
800 }
801
802 ASET (Vfontset_table, id, fontset);
803 next_fontset_id = id + 1;
804 return fontset;
805 }
806
807 \f
808 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
809
810 /* Return the name of the fontset who has ID. */
811
812 Lisp_Object
813 fontset_name (int id)
814 {
815 Lisp_Object fontset;
816
817 fontset = FONTSET_FROM_ID (id);
818 return FONTSET_NAME (fontset);
819 }
820
821
822 /* Return the ASCII font name of the fontset who has ID. */
823
824 Lisp_Object
825 fontset_ascii (int id)
826 {
827 Lisp_Object fontset, elt;
828
829 fontset= FONTSET_FROM_ID (id);
830 elt = FONTSET_ASCII (fontset);
831 if (CONSP (elt))
832 elt = XCAR (elt);
833 return elt;
834 }
835
836 static void
837 free_realized_fontset (FRAME_PTR f, Lisp_Object fontset)
838 {
839 #if 0
840 Lisp_Object tail;
841
842 if (0)
843 for (tail = FONTSET_OBJLIST (fontset); CONSP (tail); tail = XCDR (tail))
844 {
845 xassert (FONT_OBJECT_P (XCAR (tail)));
846 font_close_object (f, XCAR (tail));
847 }
848 #endif
849 }
850
851 /* Free fontset of FACE defined on frame F. Called from
852 free_realized_face. */
853
854 void
855 free_face_fontset (FRAME_PTR f, struct face *face)
856 {
857 Lisp_Object fontset;
858
859 fontset = FONTSET_FROM_ID (face->fontset);
860 if (NILP (fontset))
861 return;
862 xassert (! BASE_FONTSET_P (fontset));
863 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
864 free_realized_fontset (f, fontset);
865 ASET (Vfontset_table, face->fontset, Qnil);
866 if (face->fontset < next_fontset_id)
867 next_fontset_id = face->fontset;
868 if (! NILP (FONTSET_DEFAULT (fontset)))
869 {
870 int id = XINT (FONTSET_ID (FONTSET_DEFAULT (fontset)));
871
872 fontset = AREF (Vfontset_table, id);
873 xassert (!NILP (fontset) && ! BASE_FONTSET_P (fontset));
874 xassert (f == XFRAME (FONTSET_FRAME (fontset)));
875 free_realized_fontset (f, fontset);
876 ASET (Vfontset_table, id, Qnil);
877 if (id < next_fontset_id)
878 next_fontset_id = face->fontset;
879 }
880 face->fontset = -1;
881 }
882
883
884 #if 0
885 /* Return 1 if FACE is suitable for displaying character C.
886 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
887 when C is not an ASCII character. */
888
889 int
890 face_suitable_for_char_p (struct face *face, int c)
891 {
892 Lisp_Object fontset, rfont_def;
893
894 fontset = FONTSET_FROM_ID (face->fontset);
895 rfont_def = fontset_font (fontset, c, NULL, -1);
896 return (VECTORP (rfont_def)
897 && INTEGERP (RFONT_DEF_FACE (rfont_def))
898 && face->id == XINT (RFONT_DEF_FACE (rfont_def)));
899 }
900 #endif
901
902
903 /* Return ID of face suitable for displaying character C on frame F.
904 FACE must be reazlied for ASCII characters in advance. Called from
905 the macro FACE_FOR_CHAR. */
906
907 int
908 face_for_char (FRAME_PTR f, struct face *face, int c, int pos, Lisp_Object object)
909 {
910 Lisp_Object fontset, rfont_def, charset;
911 int face_id;
912 int id;
913
914 /* If face->fontset is negative (that happens when no font is found
915 for face), just return face->ascii_face because we can't do
916 anything. Perhaps, we should fix the callers to assure
917 that face->fontset is always valid. */
918 if (ASCII_CHAR_P (c) || face->fontset < 0)
919 return face->ascii_face->id;
920
921 xassert (fontset_id_valid_p (face->fontset));
922 fontset = FONTSET_FROM_ID (face->fontset);
923 xassert (!BASE_FONTSET_P (fontset));
924
925 if (pos < 0)
926 {
927 id = -1;
928 charset = Qnil;
929 }
930 else
931 {
932 charset = Fget_char_property (make_number (pos), Qcharset, object);
933 if (CHARSETP (charset))
934 {
935 Lisp_Object val;
936
937 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
938 if (CONSP (val) && CHARSETP (XCDR (val)))
939 charset = XCDR (val);
940 id = XINT (CHARSET_SYMBOL_ID (charset));
941 }
942 else
943 id = -1;
944 }
945
946 rfont_def = fontset_font (fontset, c, face, id);
947 if (VECTORP (rfont_def))
948 {
949 if (INTEGERP (RFONT_DEF_FACE (rfont_def)))
950 face_id = XINT (RFONT_DEF_FACE (rfont_def));
951 else
952 {
953 Lisp_Object font_object;
954
955 font_object = RFONT_DEF_OBJECT (rfont_def);
956 face_id = face_for_font (f, font_object, face);
957 RFONT_DEF_SET_FACE (rfont_def, face_id);
958 }
959 }
960 else
961 {
962 if (INTEGERP (FONTSET_NOFONT_FACE (fontset)))
963 face_id = XINT (FONTSET_NOFONT_FACE (fontset));
964 else
965 {
966 face_id = face_for_font (f, Qnil, face);
967 FONTSET_NOFONT_FACE (fontset) = make_number (face_id);
968 }
969 }
970 xassert (face_id >= 0);
971 return face_id;
972 }
973
974
975 Lisp_Object
976 font_for_char (struct face *face, int c, int pos, Lisp_Object object)
977 {
978 Lisp_Object fontset, rfont_def, charset;
979 int id;
980
981 if (ASCII_CHAR_P (c))
982 {
983 Lisp_Object font_object;
984
985 XSETFONT (font_object, face->ascii_face->font);
986 return font_object;
987 }
988
989 xassert (fontset_id_valid_p (face->fontset));
990 fontset = FONTSET_FROM_ID (face->fontset);
991 xassert (!BASE_FONTSET_P (fontset));
992 if (pos < 0)
993 {
994 id = -1;
995 charset = Qnil;
996 }
997 else
998 {
999 charset = Fget_char_property (make_number (pos), Qcharset, object);
1000 if (CHARSETP (charset))
1001 {
1002 Lisp_Object val;
1003
1004 val = assq_no_quit (charset, Vfont_encoding_charset_alist);
1005 if (CONSP (val) && CHARSETP (XCDR (val)))
1006 charset = XCDR (val);
1007 id = XINT (CHARSET_SYMBOL_ID (charset));
1008 }
1009 else
1010 id = -1;
1011 }
1012
1013 rfont_def = fontset_font (fontset, c, face, id);
1014 return (VECTORP (rfont_def)
1015 ? RFONT_DEF_OBJECT (rfont_def)
1016 : Qnil);
1017 }
1018
1019
1020 /* Make a realized fontset for ASCII face FACE on frame F from the
1021 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
1022 default fontset as the base. Value is the id of the new fontset.
1023 Called from realize_x_face. */
1024
1025 int
1026 make_fontset_for_ascii_face (FRAME_PTR f, int base_fontset_id, struct face *face)
1027 {
1028 Lisp_Object base_fontset, fontset, frame;
1029
1030 XSETFRAME (frame, f);
1031 if (base_fontset_id >= 0)
1032 {
1033 base_fontset = FONTSET_FROM_ID (base_fontset_id);
1034 if (!BASE_FONTSET_P (base_fontset))
1035 base_fontset = FONTSET_BASE (base_fontset);
1036 if (! BASE_FONTSET_P (base_fontset))
1037 abort ();
1038 }
1039 else
1040 base_fontset = Vdefault_fontset;
1041
1042 fontset = make_fontset (frame, Qnil, base_fontset);
1043 return XINT (FONTSET_ID (fontset));
1044 }
1045
1046 \f
1047
1048 /* Cache data used by fontset_pattern_regexp. The car part is a
1049 pattern string containing at least one wild card, the cdr part is
1050 the corresponding regular expression. */
1051 static Lisp_Object Vcached_fontset_data;
1052
1053 #define CACHED_FONTSET_NAME SSDATA (XCAR (Vcached_fontset_data))
1054 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1055
1056 /* If fontset name PATTERN contains any wild card, return regular
1057 expression corresponding to PATTERN. */
1058
1059 static Lisp_Object
1060 fontset_pattern_regexp (Lisp_Object pattern)
1061 {
1062 if (!strchr (SSDATA (pattern), '*')
1063 && !strchr (SSDATA (pattern), '?'))
1064 /* PATTERN does not contain any wild cards. */
1065 return Qnil;
1066
1067 if (!CONSP (Vcached_fontset_data)
1068 || strcmp (SSDATA (pattern), CACHED_FONTSET_NAME))
1069 {
1070 /* We must at first update the cached data. */
1071 unsigned char *regex, *p0, *p1;
1072 int ndashes = 0, nstars = 0, nescs = 0;
1073
1074 for (p0 = SDATA (pattern); *p0; p0++)
1075 {
1076 if (*p0 == '-')
1077 ndashes++;
1078 else if (*p0 == '*')
1079 nstars++;
1080 else if (*p0 == '['
1081 || *p0 == '.' || *p0 == '\\'
1082 || *p0 == '+' || *p0 == '^'
1083 || *p0 == '$')
1084 nescs++;
1085 }
1086
1087 /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise
1088 we convert "*" to "[^-]*" which is much faster in regular
1089 expression matching. */
1090 if (ndashes < 14)
1091 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 2 * nstars + 2 * nescs + 1);
1092 else
1093 p1 = regex = (unsigned char *) alloca (SBYTES (pattern) + 5 * nstars + 2 * nescs + 1);
1094
1095 *p1++ = '^';
1096 for (p0 = SDATA (pattern); *p0; p0++)
1097 {
1098 if (*p0 == '*')
1099 {
1100 if (ndashes < 14)
1101 *p1++ = '.';
1102 else
1103 *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']';
1104 *p1++ = '*';
1105 }
1106 else if (*p0 == '?')
1107 *p1++ = '.';
1108 else if (*p0 == '['
1109 || *p0 == '.' || *p0 == '\\'
1110 || *p0 == '+' || *p0 == '^'
1111 || *p0 == '$')
1112 *p1++ = '\\', *p1++ = *p0;
1113 else
1114 *p1++ = *p0;
1115 }
1116 *p1++ = '$';
1117 *p1++ = 0;
1118
1119 Vcached_fontset_data = Fcons (build_string (SSDATA (pattern)),
1120 build_string ((char *) regex));
1121 }
1122
1123 return CACHED_FONTSET_REGEX;
1124 }
1125
1126 /* Return ID of the base fontset named NAME. If there's no such
1127 fontset, return -1. NAME_PATTERN specifies how to treat NAME as this:
1128 0: pattern containing '*' and '?' as wildcards
1129 1: regular expression
1130 2: literal fontset name
1131 */
1132
1133 int
1134 fs_query_fontset (Lisp_Object name, int name_pattern)
1135 {
1136 Lisp_Object tem;
1137 int i;
1138
1139 name = Fdowncase (name);
1140 if (name_pattern != 1)
1141 {
1142 tem = Frassoc (name, Vfontset_alias_alist);
1143 if (NILP (tem))
1144 tem = Fassoc (name, Vfontset_alias_alist);
1145 if (CONSP (tem) && STRINGP (XCAR (tem)))
1146 name = XCAR (tem);
1147 else if (name_pattern == 0)
1148 {
1149 tem = fontset_pattern_regexp (name);
1150 if (STRINGP (tem))
1151 {
1152 name = tem;
1153 name_pattern = 1;
1154 }
1155 }
1156 }
1157
1158 for (i = 0; i < ASIZE (Vfontset_table); i++)
1159 {
1160 Lisp_Object fontset, this_name;
1161
1162 fontset = FONTSET_FROM_ID (i);
1163 if (NILP (fontset)
1164 || !BASE_FONTSET_P (fontset))
1165 continue;
1166
1167 this_name = FONTSET_NAME (fontset);
1168 if (name_pattern == 1
1169 ? fast_string_match_ignore_case (name, this_name) >= 0
1170 : !xstrcasecmp (SSDATA (name), SSDATA (this_name)))
1171 return i;
1172 }
1173 return -1;
1174 }
1175
1176
1177 DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 2, 0,
1178 doc: /* Return the name of a fontset that matches PATTERN.
1179 The value is nil if there is no matching fontset.
1180 PATTERN can contain `*' or `?' as a wildcard
1181 just as X font name matching algorithm allows.
1182 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1183 (Lisp_Object pattern, Lisp_Object regexpp)
1184 {
1185 Lisp_Object fontset;
1186 int id;
1187
1188 (*check_window_system_func) ();
1189
1190 CHECK_STRING (pattern);
1191
1192 if (SCHARS (pattern) == 0)
1193 return Qnil;
1194
1195 id = fs_query_fontset (pattern, !NILP (regexpp));
1196 if (id < 0)
1197 return Qnil;
1198
1199 fontset = FONTSET_FROM_ID (id);
1200 return FONTSET_NAME (fontset);
1201 }
1202
1203 /* Return a list of base fontset names matching PATTERN on frame F. */
1204
1205 Lisp_Object
1206 list_fontsets (FRAME_PTR f, Lisp_Object pattern, int size)
1207 {
1208 Lisp_Object frame, regexp, val;
1209 int id;
1210
1211 XSETFRAME (frame, f);
1212
1213 regexp = fontset_pattern_regexp (pattern);
1214 val = Qnil;
1215
1216 for (id = 0; id < ASIZE (Vfontset_table); id++)
1217 {
1218 Lisp_Object fontset, name;
1219
1220 fontset = FONTSET_FROM_ID (id);
1221 if (NILP (fontset)
1222 || !BASE_FONTSET_P (fontset)
1223 || !EQ (frame, FONTSET_FRAME (fontset)))
1224 continue;
1225 name = FONTSET_NAME (fontset);
1226
1227 if (STRINGP (regexp)
1228 ? (fast_string_match (regexp, name) < 0)
1229 : strcmp (SSDATA (pattern), SSDATA (name)))
1230 continue;
1231
1232 val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
1233 }
1234
1235 return val;
1236 }
1237
1238
1239 /* Free all realized fontsets whose base fontset is BASE. */
1240
1241 static void
1242 free_realized_fontsets (Lisp_Object base)
1243 {
1244 int id;
1245
1246 #if 0
1247 /* For the moment, this doesn't work because free_realized_face
1248 doesn't remove FACE from a cache. Until we find a solution, we
1249 suppress this code, and simply use Fclear_face_cache even though
1250 that is not efficient. */
1251 BLOCK_INPUT;
1252 for (id = 0; id < ASIZE (Vfontset_table); id++)
1253 {
1254 Lisp_Object this = AREF (Vfontset_table, id);
1255
1256 if (EQ (FONTSET_BASE (this), base))
1257 {
1258 Lisp_Object tail;
1259
1260 for (tail = FONTSET_FACE_ALIST (this); CONSP (tail);
1261 tail = XCDR (tail))
1262 {
1263 FRAME_PTR f = XFRAME (FONTSET_FRAME (this));
1264 int face_id = XINT (XCDR (XCAR (tail)));
1265 struct face *face = FACE_FROM_ID (f, face_id);
1266
1267 /* Face THIS itself is also freed by the following call. */
1268 free_realized_face (f, face);
1269 }
1270 }
1271 }
1272 UNBLOCK_INPUT;
1273 #else /* not 0 */
1274 /* But, we don't have to call Fclear_face_cache if no fontset has
1275 been realized from BASE. */
1276 for (id = 0; id < ASIZE (Vfontset_table); id++)
1277 {
1278 Lisp_Object this = AREF (Vfontset_table, id);
1279
1280 if (CHAR_TABLE_P (this) && EQ (FONTSET_BASE (this), base))
1281 {
1282 Fclear_face_cache (Qt);
1283 break;
1284 }
1285 }
1286 #endif /* not 0 */
1287 }
1288
1289
1290 /* Check validity of NAME as a fontset name and return the
1291 corresponding fontset. If not valid, signal an error.
1292
1293 If NAME is t, return Vdefault_fontset. If NAME is nil, return the
1294 fontset of *FRAME.
1295
1296 Set *FRAME to the actual frame. */
1297
1298 static Lisp_Object
1299 check_fontset_name (Lisp_Object name, Lisp_Object *frame)
1300 {
1301 int id;
1302
1303 if (NILP (*frame))
1304 *frame = selected_frame;
1305 CHECK_LIVE_FRAME (*frame);
1306
1307 if (EQ (name, Qt))
1308 return Vdefault_fontset;
1309 if (NILP (name))
1310 {
1311 id = FRAME_FONTSET (XFRAME (*frame));
1312 }
1313 else
1314 {
1315 CHECK_STRING (name);
1316 /* First try NAME as literal. */
1317 id = fs_query_fontset (name, 2);
1318 if (id < 0)
1319 /* For backward compatibility, try again NAME as pattern. */
1320 id = fs_query_fontset (name, 0);
1321 if (id < 0)
1322 error ("Fontset `%s' does not exist", SDATA (name));
1323 }
1324 return FONTSET_FROM_ID (id);
1325 }
1326
1327 static void
1328 accumulate_script_ranges (Lisp_Object arg, Lisp_Object range, Lisp_Object val)
1329 {
1330 if (EQ (XCAR (arg), val))
1331 {
1332 if (CONSP (range))
1333 XSETCDR (arg, Fcons (Fcons (XCAR (range), XCDR (range)), XCDR (arg)));
1334 else
1335 XSETCDR (arg, Fcons (Fcons (range, range), XCDR (arg)));
1336 }
1337 }
1338
1339
1340 /* Callback function for map_charset_chars in Fset_fontset_font.
1341 ARG is a vector [ FONTSET FONT_DEF ADD ASCII SCRIPT_RANGE_LIST ].
1342
1343 In FONTSET, set FONT_DEF in a fashion specified by ADD for
1344 characters in RANGE and ranges in SCRIPT_RANGE_LIST before RANGE.
1345 The consumed ranges are poped up from SCRIPT_RANGE_LIST, and the
1346 new SCRIPT_RANGE_LIST is stored in ARG.
1347
1348 If ASCII is nil, don't set FONT_DEF for ASCII characters. It is
1349 assured that SCRIPT_RANGE_LIST doesn't contain ASCII in that
1350 case. */
1351
1352 static void
1353 set_fontset_font (Lisp_Object arg, Lisp_Object range)
1354 {
1355 Lisp_Object fontset, font_def, add, ascii, script_range_list;
1356 int from = XINT (XCAR (range)), to = XINT (XCDR (range));
1357
1358 fontset = AREF (arg, 0);
1359 font_def = AREF (arg, 1);
1360 add = AREF (arg, 2);
1361 ascii = AREF (arg, 3);
1362 script_range_list = AREF (arg, 4);
1363
1364 if (NILP (ascii) && from < 0x80)
1365 {
1366 if (to < 0x80)
1367 return;
1368 from = 0x80;
1369 range = Fcons (make_number (0x80), XCDR (range));
1370 }
1371
1372 #define SCRIPT_FROM XINT (XCAR (XCAR (script_range_list)))
1373 #define SCRIPT_TO XINT (XCDR (XCAR (script_range_list)))
1374 #define POP_SCRIPT_RANGE() script_range_list = XCDR (script_range_list)
1375
1376 for (; CONSP (script_range_list) && SCRIPT_TO < from; POP_SCRIPT_RANGE ())
1377 FONTSET_ADD (fontset, XCAR (script_range_list), font_def, add);
1378 if (CONSP (script_range_list))
1379 {
1380 if (SCRIPT_FROM < from)
1381 range = Fcons (make_number (SCRIPT_FROM), XCDR (range));
1382 while (CONSP (script_range_list) && SCRIPT_TO <= to)
1383 POP_SCRIPT_RANGE ();
1384 if (CONSP (script_range_list) && SCRIPT_FROM <= to)
1385 XSETCAR (XCAR (script_range_list), make_number (to + 1));
1386 }
1387
1388 FONTSET_ADD (fontset, range, font_def, add);
1389 ASET (arg, 4, script_range_list);
1390 }
1391
1392 static void update_auto_fontset_alist (Lisp_Object, Lisp_Object);
1393
1394
1395 DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
1396 doc: /*
1397 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1398
1399 NAME is a fontset name string, nil for the fontset of FRAME, or t for
1400 the default fontset.
1401
1402 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1403 In that case, use FONT-SPEC for all characters in the range FROM and
1404 TO (inclusive).
1405
1406 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1407 all characters that belong to the script.
1408
1409 TARGET may be a charset. In that case, use FONT-SPEC for all
1410 characters in the charset.
1411
1412 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1413 that no FONT-SPEC is specified.
1414
1415 FONT-SPEC may one of these:
1416 * A font-spec object made by the function `font-spec' (which see).
1417 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1418 REGISTRY is a font registry name. FAMILY may contain foundry
1419 name, and REGISTRY may contain encoding name.
1420 * A font name string.
1421 * nil, which explicitly specifies that there's no font for TARGET.
1422
1423 Optional 4th argument FRAME is a frame or nil for the selected frame
1424 that is concerned in the case that NAME is nil.
1425
1426 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1427 to the font specifications for TARGET previously set. If it is
1428 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1429 appended. By default, FONT-SPEC overrides the previous settings. */)
1430 (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add)
1431 {
1432 Lisp_Object fontset;
1433 Lisp_Object font_def, registry, family;
1434 Lisp_Object range_list;
1435 struct charset *charset = NULL;
1436 Lisp_Object fontname;
1437 int ascii_changed = 0;
1438
1439 fontset = check_fontset_name (name, &frame);
1440
1441 fontname = Qnil;
1442 if (CONSP (font_spec))
1443 {
1444 Lisp_Object spec = Ffont_spec (0, NULL);
1445
1446 font_parse_family_registry (XCAR (font_spec), XCDR (font_spec), spec);
1447 font_spec = spec;
1448 fontname = Ffont_xlfd_name (font_spec, Qnil);
1449 }
1450 else if (STRINGP (font_spec))
1451 {
1452 Lisp_Object args[2];
1453
1454 fontname = font_spec;
1455 args[0] = QCname;
1456 args[1] = font_spec;
1457 font_spec = Ffont_spec (2, args);
1458 }
1459 else if (FONT_SPEC_P (font_spec))
1460 fontname = Ffont_xlfd_name (font_spec, Qnil);
1461 else if (! NILP (font_spec))
1462 Fsignal (Qfont, list2 (build_string ("Invalid font-spec"), font_spec));
1463
1464 if (! NILP (font_spec))
1465 {
1466 Lisp_Object encoding, repertory;
1467
1468 family = AREF (font_spec, FONT_FAMILY_INDEX);
1469 if (! NILP (family) )
1470 family = SYMBOL_NAME (family);
1471 registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1472 if (! NILP (registry))
1473 registry = Fdowncase (SYMBOL_NAME (registry));
1474 encoding = find_font_encoding (concat3 (family, build_string ("-"),
1475 registry));
1476 if (NILP (encoding))
1477 encoding = Qascii;
1478
1479 if (SYMBOLP (encoding))
1480 {
1481 CHECK_CHARSET (encoding);
1482 encoding = repertory = CHARSET_SYMBOL_ID (encoding);
1483 }
1484 else
1485 {
1486 repertory = XCDR (encoding);
1487 encoding = XCAR (encoding);
1488 CHECK_CHARSET (encoding);
1489 encoding = CHARSET_SYMBOL_ID (encoding);
1490 if (! NILP (repertory) && SYMBOLP (repertory))
1491 {
1492 CHECK_CHARSET (repertory);
1493 repertory = CHARSET_SYMBOL_ID (repertory);
1494 }
1495 }
1496 FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
1497 }
1498 else
1499 font_def = Qnil;
1500
1501 if (CHARACTERP (target))
1502 {
1503 if (XFASTINT (target) < 0x80)
1504 error ("Can't set a font for partial ASCII range");
1505 range_list = Fcons (Fcons (target, target), Qnil);
1506 }
1507 else if (CONSP (target))
1508 {
1509 Lisp_Object from, to;
1510
1511 from = Fcar (target);
1512 to = Fcdr (target);
1513 CHECK_CHARACTER (from);
1514 CHECK_CHARACTER (to);
1515 if (XFASTINT (from) < 0x80)
1516 {
1517 if (XFASTINT (from) != 0 || XFASTINT (to) < 0x7F)
1518 error ("Can't set a font for partial ASCII range");
1519 ascii_changed = 1;
1520 }
1521 range_list = Fcons (target, Qnil);
1522 }
1523 else if (SYMBOLP (target) && !NILP (target))
1524 {
1525 Lisp_Object script_list;
1526 Lisp_Object val;
1527
1528 range_list = Qnil;
1529 script_list = XCHAR_TABLE (Vchar_script_table)->extras[0];
1530 if (! NILP (Fmemq (target, script_list)))
1531 {
1532 if (EQ (target, Qlatin))
1533 ascii_changed = 1;
1534 val = Fcons (target, Qnil);
1535 map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table,
1536 val);
1537 range_list = Fnreverse (XCDR (val));
1538 }
1539 if (CHARSETP (target))
1540 {
1541 CHECK_CHARSET_GET_CHARSET (target, charset);
1542 if (charset->ascii_compatible_p)
1543 ascii_changed = 1;
1544 }
1545 else if (NILP (range_list))
1546 error ("Invalid script or charset name: %s",
1547 SDATA (SYMBOL_NAME (target)));
1548 }
1549 else if (NILP (target))
1550 range_list = Fcons (Qnil, Qnil);
1551 else
1552 error ("Invalid target for setting a font");
1553
1554 if (ascii_changed)
1555 {
1556 Lisp_Object val;
1557
1558 if (NILP (font_spec))
1559 error ("Can't set ASCII font to nil");
1560 val = CHAR_TABLE_REF (fontset, 0);
1561 if (! NILP (val) && EQ (add, Qappend))
1562 /* We are going to change just an additional font for ASCII. */
1563 ascii_changed = 0;
1564 }
1565
1566 if (charset)
1567 {
1568 Lisp_Object arg;
1569
1570 arg = Fmake_vector (make_number (5), Qnil);
1571 ASET (arg, 0, fontset);
1572 ASET (arg, 1, font_def);
1573 ASET (arg, 2, add);
1574 ASET (arg, 3, ascii_changed ? Qt : Qnil);
1575 ASET (arg, 4, range_list);
1576
1577 map_charset_chars (set_fontset_font, Qnil, arg, charset,
1578 CHARSET_MIN_CODE (charset),
1579 CHARSET_MAX_CODE (charset));
1580 range_list = AREF (arg, 4);
1581 }
1582 for (; CONSP (range_list); range_list = XCDR (range_list))
1583 FONTSET_ADD (fontset, XCAR (range_list), font_def, add);
1584
1585 if (ascii_changed)
1586 {
1587 Lisp_Object tail, fr, alist;
1588 int fontset_id = XINT (FONTSET_ID (fontset));
1589
1590 FONTSET_ASCII (fontset) = fontname;
1591 name = FONTSET_NAME (fontset);
1592 FOR_EACH_FRAME (tail, fr)
1593 {
1594 FRAME_PTR f = XFRAME (fr);
1595 Lisp_Object font_object;
1596 struct face *face;
1597
1598 if (FRAME_INITIAL_P (f) || FRAME_TERMCAP_P (f))
1599 continue;
1600 if (fontset_id != FRAME_FONTSET (f))
1601 continue;
1602 face = FACE_FROM_ID (f, DEFAULT_FACE_ID);
1603 if (face)
1604 font_object = font_load_for_lface (f, face->lface, font_spec);
1605 else
1606 font_object = font_open_by_spec (f, font_spec);
1607 if (! NILP (font_object))
1608 {
1609 update_auto_fontset_alist (font_object, fontset);
1610 alist = Fcons (Fcons (Qfont, Fcons (name, font_object)), Qnil);
1611 Fmodify_frame_parameters (fr, alist);
1612 }
1613 }
1614 }
1615
1616 /* Free all realized fontsets whose base is FONTSET. This way, the
1617 specified character(s) are surely redisplayed by a correct
1618 font. */
1619 free_realized_fontsets (fontset);
1620
1621 return Qnil;
1622 }
1623
1624
1625 DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
1626 doc: /* Create a new fontset NAME from font information in FONTLIST.
1627
1628 FONTLIST is an alist of scripts vs the corresponding font specification list.
1629 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1630 character of SCRIPT is displayed by a font that matches one of
1631 FONT-SPEC.
1632
1633 SCRIPT is a symbol that appears in the first extra slot of the
1634 char-table `char-script-table'.
1635
1636 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1637 `set-fontset-font' for the meaning. */)
1638 (Lisp_Object name, Lisp_Object fontlist)
1639 {
1640 Lisp_Object fontset;
1641 int id;
1642
1643 CHECK_STRING (name);
1644 CHECK_LIST (fontlist);
1645
1646 name = Fdowncase (name);
1647 id = fs_query_fontset (name, 0);
1648 if (id < 0)
1649 {
1650 Lisp_Object font_spec = Ffont_spec (0, NULL);
1651 Lisp_Object short_name;
1652 char xlfd[256];
1653 int len;
1654
1655 if (font_parse_xlfd (SSDATA (name), font_spec) < 0)
1656 error ("Fontset name must be in XLFD format");
1657 short_name = AREF (font_spec, FONT_REGISTRY_INDEX);
1658 if (strncmp (SSDATA (SYMBOL_NAME (short_name)), "fontset-", 8)
1659 || SBYTES (SYMBOL_NAME (short_name)) < 9)
1660 error ("Registry field of fontset name must be \"fontset-*\"");
1661 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (short_name)),
1662 Vfontset_alias_alist);
1663 ASET (font_spec, FONT_REGISTRY_INDEX, Qiso8859_1);
1664 fontset = make_fontset (Qnil, name, Qnil);
1665 len = font_unparse_xlfd (font_spec, 0, xlfd, 256);
1666 if (len < 0)
1667 error ("Invalid fontset name (perhaps too long): %s", SDATA (name));
1668 FONTSET_ASCII (fontset) = make_unibyte_string (xlfd, len);
1669 }
1670 else
1671 {
1672 fontset = FONTSET_FROM_ID (id);
1673 free_realized_fontsets (fontset);
1674 Fset_char_table_range (fontset, Qt, Qnil);
1675 }
1676
1677 for (; ! NILP (fontlist); fontlist = Fcdr (fontlist))
1678 {
1679 Lisp_Object elt, script;
1680
1681 elt = Fcar (fontlist);
1682 script = Fcar (elt);
1683 elt = Fcdr (elt);
1684 if (CONSP (elt) && (NILP (XCDR (elt)) || CONSP (XCDR (elt))))
1685 for (; CONSP (elt); elt = XCDR (elt))
1686 Fset_fontset_font (name, script, XCAR (elt), Qnil, Qappend);
1687 else
1688 Fset_fontset_font (name, script, elt, Qnil, Qappend);
1689 }
1690 return name;
1691 }
1692
1693
1694 /* Alist of automatically created fontsets. Each element is a cons
1695 (FONT-SPEC . FONTSET-ID). */
1696 static Lisp_Object auto_fontset_alist;
1697
1698 /* Number of automatically created fontsets. */
1699 static int num_auto_fontsets;
1700
1701 /* Retun a fontset synthesized from FONT-OBJECT. This is called from
1702 x_new_font when FONT-OBJECT is used for the default ASCII font of a
1703 frame, and the returned fontset is used for the default fontset of
1704 that frame. The fontset specifies a font of the same registry as
1705 FONT-OBJECT for all characters in the repertory of the registry
1706 (see Vfont_encoding_alist). If the repertory is not known, the
1707 fontset specifies the font for all Latin characters assuming that a
1708 user intends to use FONT-OBJECT for Latin characters. */
1709
1710 int
1711 fontset_from_font (Lisp_Object font_object)
1712 {
1713 Lisp_Object font_name = font_get_name (font_object);
1714 Lisp_Object font_spec = copy_font_spec (font_object);
1715 Lisp_Object registry = AREF (font_spec, FONT_REGISTRY_INDEX);
1716 Lisp_Object fontset_spec, alias, name, fontset;
1717 Lisp_Object val;
1718
1719 val = assoc_no_quit (font_spec, auto_fontset_alist);
1720 if (CONSP (val))
1721 return XINT (FONTSET_ID (XCDR (val)));
1722 if (num_auto_fontsets++ == 0)
1723 alias = intern ("fontset-startup");
1724 else
1725 {
1726 char temp[32];
1727
1728 sprintf (temp, "fontset-auto%d", num_auto_fontsets - 1);
1729 alias = intern (temp);
1730 }
1731 fontset_spec = copy_font_spec (font_spec);
1732 ASET (fontset_spec, FONT_REGISTRY_INDEX, alias);
1733 name = Ffont_xlfd_name (fontset_spec, Qnil);
1734 if (NILP (name))
1735 abort ();
1736 fontset = make_fontset (Qnil, name, Qnil);
1737 Vfontset_alias_alist = Fcons (Fcons (name, SYMBOL_NAME (alias)),
1738 Vfontset_alias_alist);
1739 alias = Fdowncase (AREF (font_object, FONT_NAME_INDEX));
1740 Vfontset_alias_alist = Fcons (Fcons (name, alias), Vfontset_alias_alist);
1741 auto_fontset_alist = Fcons (Fcons (font_spec, fontset), auto_fontset_alist);
1742 font_spec = Ffont_spec (0, NULL);
1743 ASET (font_spec, FONT_REGISTRY_INDEX, registry);
1744 {
1745 Lisp_Object target = find_font_encoding (SYMBOL_NAME (registry));
1746
1747 if (CONSP (target))
1748 target = XCDR (target);
1749 if (! CHARSETP (target))
1750 target = Qlatin;
1751 Fset_fontset_font (name, target, font_spec, Qnil, Qnil);
1752 Fset_fontset_font (name, Qnil, font_spec, Qnil, Qnil);
1753 }
1754
1755 FONTSET_ASCII (fontset) = font_name;
1756
1757 return XINT (FONTSET_ID (fontset));
1758 }
1759
1760
1761 /* Update auto_fontset_alist for FONTSET. When an ASCII font of
1762 FONTSET is changed, we delete an entry of FONTSET if any from
1763 auto_fontset_alist so that FONTSET is not re-used by
1764 fontset_from_font. */
1765
1766 static void
1767 update_auto_fontset_alist (Lisp_Object font_object, Lisp_Object fontset)
1768 {
1769 Lisp_Object prev, tail;
1770
1771 for (prev = Qnil, tail = auto_fontset_alist; CONSP (tail);
1772 prev = tail, tail = XCDR (tail))
1773 if (EQ (fontset, XCDR (XCAR (tail))))
1774 {
1775 if (NILP (prev))
1776 auto_fontset_alist = XCDR (tail);
1777 else
1778 XSETCDR (prev, XCDR (tail));
1779 break;
1780 }
1781 }
1782
1783
1784 /* Return a cons (FONT-OBJECT . GLYPH-CODE).
1785 FONT-OBJECT is the font for the character at POSITION in the current
1786 buffer. This is computed from all the text properties and overlays
1787 that apply to POSITION. POSTION may be nil, in which case,
1788 FONT-SPEC is the font for displaying the character CH with the
1789 default face.
1790
1791 GLYPH-CODE is the glyph code in the font to use for the character.
1792
1793 If the 2nd optional arg CH is non-nil, it is a character to check
1794 the font instead of the character at POSITION.
1795
1796 It returns nil in the following cases:
1797
1798 (1) The window system doesn't have a font for the character (thus
1799 it is displayed by an empty box).
1800
1801 (2) The character code is invalid.
1802
1803 (3) If POSITION is not nil, and the current buffer is not displayed
1804 in any window.
1805
1806 In addition, the returned font name may not take into account of
1807 such redisplay engine hooks as what used in jit-lock-mode if
1808 POSITION is currently not visible. */
1809
1810
1811 DEFUN ("internal-char-font", Finternal_char_font, Sinternal_char_font, 1, 2, 0,
1812 doc: /* For internal use only. */)
1813 (Lisp_Object position, Lisp_Object ch)
1814 {
1815 EMACS_INT pos, pos_byte, dummy;
1816 int face_id;
1817 int c;
1818 struct frame *f;
1819 struct face *face;
1820
1821 if (NILP (position))
1822 {
1823 CHECK_CHARACTER (ch);
1824 c = XINT (ch);
1825 f = XFRAME (selected_frame);
1826 face_id = lookup_basic_face (f, DEFAULT_FACE_ID);
1827 pos = -1;
1828 }
1829 else
1830 {
1831 Lisp_Object window;
1832 struct window *w;
1833
1834 CHECK_NUMBER_COERCE_MARKER (position);
1835 pos = XINT (position);
1836 if (pos < BEGV || pos >= ZV)
1837 args_out_of_range_3 (position, make_number (BEGV), make_number (ZV));
1838 pos_byte = CHAR_TO_BYTE (pos);
1839 if (NILP (ch))
1840 c = FETCH_CHAR (pos_byte);
1841 else
1842 {
1843 CHECK_NATNUM (ch);
1844 c = XINT (ch);
1845 }
1846 window = Fget_buffer_window (Fcurrent_buffer (), Qnil);
1847 if (NILP (window))
1848 return Qnil;
1849 w = XWINDOW (window);
1850 f = XFRAME (w->frame);
1851 face_id = face_at_buffer_position (w, pos, -1, -1, &dummy,
1852 pos + 100, 0, -1);
1853 }
1854 if (! CHAR_VALID_P (c))
1855 return Qnil;
1856 face_id = FACE_FOR_CHAR (f, FACE_FROM_ID (f, face_id), c, pos, Qnil);
1857 face = FACE_FROM_ID (f, face_id);
1858 if (face->font)
1859 {
1860 unsigned code = face->font->driver->encode_char (face->font, c);
1861 Lisp_Object font_object;
1862
1863 if (code == FONT_INVALID_CODE)
1864 return Qnil;
1865 XSETFONT (font_object, face->font);
1866 return Fcons (font_object, INTEGER_TO_CONS (code));
1867 }
1868 return Qnil;
1869 }
1870
1871
1872 DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
1873 doc: /* Return information about a fontset FONTSET on frame FRAME.
1874
1875 FONTSET is a fontset name string, nil for the fontset of FRAME, or t
1876 for the default fontset. FRAME nil means the selected frame.
1877
1878 The value is a char-table whose elements have this form:
1879
1880 ((FONT OPENED-FONT ...) ...)
1881
1882 FONT is a name of font specified for a range of characters.
1883
1884 OPENED-FONT is a name of a font actually opened.
1885
1886 The char-table has one extra slot. If FONTSET is not the default
1887 fontset, the value the extra slot is a char-table containing the
1888 information about the derived fonts from the default fontset. The
1889 format is the same as above. */)
1890 (Lisp_Object fontset, Lisp_Object frame)
1891 {
1892 Lisp_Object *realized[2], fontsets[2], tables[2];
1893 Lisp_Object val, elt;
1894 int c, i, j, k;
1895
1896 (*check_window_system_func) ();
1897
1898 fontset = check_fontset_name (fontset, &frame);
1899
1900 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1901 in the table `realized'. */
1902 realized[0] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1903 * ASIZE (Vfontset_table));
1904 for (i = j = 0; i < ASIZE (Vfontset_table); i++)
1905 {
1906 elt = FONTSET_FROM_ID (i);
1907 if (!NILP (elt)
1908 && EQ (FONTSET_BASE (elt), fontset)
1909 && EQ (FONTSET_FRAME (elt), frame))
1910 realized[0][j++] = elt;
1911 }
1912 realized[0][j] = Qnil;
1913
1914 realized[1] = (Lisp_Object *) alloca (sizeof (Lisp_Object)
1915 * ASIZE (Vfontset_table));
1916 for (i = j = 0; ! NILP (realized[0][i]); i++)
1917 {
1918 elt = FONTSET_DEFAULT (realized[0][i]);
1919 if (! NILP (elt))
1920 realized[1][j++] = elt;
1921 }
1922 realized[1][j] = Qnil;
1923
1924 tables[0] = Fmake_char_table (Qfontset_info, Qnil);
1925 fontsets[0] = fontset;
1926 if (!EQ (fontset, Vdefault_fontset))
1927 {
1928 tables[1] = Fmake_char_table (Qnil, Qnil);
1929 XCHAR_TABLE (tables[0])->extras[0] = tables[1];
1930 fontsets[1] = Vdefault_fontset;
1931 }
1932
1933 /* Accumulate information of the fontset in TABLE. The format of
1934 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1935 for (k = 0; k <= 1; k++)
1936 {
1937 for (c = 0; c <= MAX_CHAR; )
1938 {
1939 int from = c, to = MAX_5_BYTE_CHAR;
1940
1941 if (c <= MAX_5_BYTE_CHAR)
1942 {
1943 val = char_table_ref_and_range (fontsets[k], c, &from, &to);
1944 }
1945 else
1946 {
1947 val = FONTSET_FALLBACK (fontsets[k]);
1948 to = MAX_CHAR;
1949 }
1950 if (VECTORP (val))
1951 {
1952 Lisp_Object alist;
1953
1954 /* At first, set ALIST to ((FONT-SPEC) ...). */
1955 for (alist = Qnil, i = 0; i < ASIZE (val); i++)
1956 if (! NILP (AREF (val, i)))
1957 alist = Fcons (Fcons (FONT_DEF_SPEC (AREF (val, i)), Qnil),
1958 alist);
1959 alist = Fnreverse (alist);
1960
1961 /* Then store opened font names to cdr of each elements. */
1962 for (i = 0; ! NILP (realized[k][i]); i++)
1963 {
1964 if (c <= MAX_5_BYTE_CHAR)
1965 val = FONTSET_REF (realized[k][i], c);
1966 else
1967 val = FONTSET_FALLBACK (realized[k][i]);
1968 if (! CONSP (val) || ! VECTORP (XCDR (val)))
1969 continue;
1970 /* VAL: (int . [[FACE-ID FONT-DEF FONT-OBJECT int] ... ]) */
1971 val = XCDR (val);
1972 for (j = 0; j < ASIZE (val); j++)
1973 {
1974 elt = AREF (val, j);
1975 if (FONT_OBJECT_P (RFONT_DEF_OBJECT (elt)))
1976 {
1977 Lisp_Object font_object = RFONT_DEF_OBJECT (elt);
1978 Lisp_Object slot, name;
1979
1980 slot = Fassq (RFONT_DEF_SPEC (elt), alist);
1981 name = AREF (font_object, FONT_NAME_INDEX);
1982 if (NILP (Fmember (name, XCDR (slot))))
1983 nconc2 (slot, Fcons (name, Qnil));
1984 }
1985 }
1986 }
1987
1988 /* Store ALIST in TBL for characters C..TO. */
1989 if (c <= MAX_5_BYTE_CHAR)
1990 char_table_set_range (tables[k], c, to, alist);
1991 else
1992 XCHAR_TABLE (tables[k])->defalt = alist;
1993
1994 /* At last, change each elements to font names. */
1995 for (; CONSP (alist); alist = XCDR (alist))
1996 {
1997 elt = XCAR (alist);
1998 XSETCAR (elt, Ffont_xlfd_name (XCAR (elt), Qnil));
1999 }
2000 }
2001 c = to + 1;
2002 }
2003 if (EQ (fontset, Vdefault_fontset))
2004 break;
2005 }
2006
2007 return tables[0];
2008 }
2009
2010
2011 DEFUN ("fontset-font", Ffontset_font, Sfontset_font, 2, 3, 0,
2012 doc: /* Return a font name pattern for character CH in fontset NAME.
2013 If NAME is t, find a pattern in the default fontset.
2014 If NAME is nil, find a pattern in the fontset of the selected frame.
2015
2016 The value has the form (FAMILY . REGISTRY), where FAMILY is a font
2017 family name and REGISTRY is a font registry name. This is actually
2018 the first font name pattern for CH in the fontset or in the default
2019 fontset.
2020
2021 If the 2nd optional arg ALL is non-nil, return a list of all font name
2022 patterns. */)
2023 (Lisp_Object name, Lisp_Object ch, Lisp_Object all)
2024 {
2025 int c;
2026 Lisp_Object fontset, elt, list, repertory, val;
2027 int i, j;
2028 Lisp_Object frame;
2029
2030 frame = Qnil;
2031 fontset = check_fontset_name (name, &frame);
2032
2033 CHECK_CHARACTER (ch);
2034 c = XINT (ch);
2035 list = Qnil;
2036 while (1)
2037 {
2038 for (i = 0, elt = FONTSET_REF (fontset, c); i < 2;
2039 i++, elt = FONTSET_FALLBACK (fontset))
2040 if (VECTORP (elt))
2041 for (j = 0; j < ASIZE (elt); j++)
2042 {
2043 Lisp_Object family, registry;
2044
2045 val = AREF (elt, j);
2046 if (NILP (val))
2047 return Qnil;
2048 repertory = AREF (val, 1);
2049 if (INTEGERP (repertory))
2050 {
2051 struct charset *charset = CHARSET_FROM_ID (XINT (repertory));
2052
2053 if (! CHAR_CHARSET_P (c, charset))
2054 continue;
2055 }
2056 else if (CHAR_TABLE_P (repertory))
2057 {
2058 if (NILP (CHAR_TABLE_REF (repertory, c)))
2059 continue;
2060 }
2061 val = AREF (val, 0);
2062 /* VAL is a FONT-SPEC */
2063 family = AREF (val, FONT_FAMILY_INDEX);
2064 if (! NILP (family))
2065 family = SYMBOL_NAME (family);
2066 registry = AREF (val, FONT_REGISTRY_INDEX);
2067 if (! NILP (registry))
2068 registry = SYMBOL_NAME (registry);
2069 val = Fcons (family, registry);
2070 if (NILP (all))
2071 return val;
2072 list = Fcons (val, list);
2073 }
2074 if (EQ (fontset, Vdefault_fontset))
2075 break;
2076 fontset = Vdefault_fontset;
2077 }
2078 return (Fnreverse (list));
2079 }
2080
2081 DEFUN ("fontset-list", Ffontset_list, Sfontset_list, 0, 0, 0,
2082 doc: /* Return a list of all defined fontset names. */)
2083 (void)
2084 {
2085 Lisp_Object fontset, list;
2086 int i;
2087
2088 list = Qnil;
2089 for (i = 0; i < ASIZE (Vfontset_table); i++)
2090 {
2091 fontset = FONTSET_FROM_ID (i);
2092 if (!NILP (fontset)
2093 && BASE_FONTSET_P (fontset))
2094 list = Fcons (FONTSET_NAME (fontset), list);
2095 }
2096
2097 return list;
2098 }
2099
2100
2101 #ifdef FONTSET_DEBUG
2102
2103 Lisp_Object
2104 dump_fontset (Lisp_Object fontset)
2105 {
2106 Lisp_Object vec;
2107
2108 vec = Fmake_vector (make_number (3), Qnil);
2109 ASET (vec, 0, FONTSET_ID (fontset));
2110
2111 if (BASE_FONTSET_P (fontset))
2112 {
2113 ASET (vec, 1, FONTSET_NAME (fontset));
2114 }
2115 else
2116 {
2117 Lisp_Object frame;
2118
2119 frame = FONTSET_FRAME (fontset);
2120 if (FRAMEP (frame))
2121 {
2122 FRAME_PTR f = XFRAME (frame);
2123
2124 if (FRAME_LIVE_P (f))
2125 ASET (vec, 1,
2126 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), f->name));
2127 else
2128 ASET (vec, 1,
2129 Fcons (FONTSET_NAME (FONTSET_BASE (fontset)), Qnil));
2130 }
2131 if (!NILP (FONTSET_DEFAULT (fontset)))
2132 ASET (vec, 2, FONTSET_ID (FONTSET_DEFAULT (fontset)));
2133 }
2134 return vec;
2135 }
2136
2137 DEFUN ("fontset-list-all", Ffontset_list_all, Sfontset_list_all, 0, 0, 0,
2138 doc: /* Return a brief summary of all fontsets for debug use. */)
2139 (void)
2140 {
2141 Lisp_Object val;
2142 int i;
2143
2144 for (i = 0, val = Qnil; i < ASIZE (Vfontset_table); i++)
2145 if (! NILP (AREF (Vfontset_table, i)))
2146 val = Fcons (dump_fontset (AREF (Vfontset_table, i)), val);
2147 return (Fnreverse (val));
2148 }
2149 #endif /* FONTSET_DEBUG */
2150
2151 void
2152 syms_of_fontset (void)
2153 {
2154 DEFSYM (Qfontset, "fontset");
2155 Fput (Qfontset, Qchar_table_extra_slots, make_number (9));
2156 DEFSYM (Qfontset_info, "fontset-info");
2157 Fput (Qfontset_info, Qchar_table_extra_slots, make_number (1));
2158
2159 DEFSYM (Qprepend, "prepend");
2160 DEFSYM (Qappend, "append");
2161 DEFSYM (Qlatin, "latin");
2162
2163 Vcached_fontset_data = Qnil;
2164 staticpro (&Vcached_fontset_data);
2165
2166 Vfontset_table = Fmake_vector (make_number (32), Qnil);
2167 staticpro (&Vfontset_table);
2168
2169 Vdefault_fontset = Fmake_char_table (Qfontset, Qnil);
2170 staticpro (&Vdefault_fontset);
2171 FONTSET_ID (Vdefault_fontset) = make_number (0);
2172 FONTSET_NAME (Vdefault_fontset)
2173 = make_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
2174 ASET (Vfontset_table, 0, Vdefault_fontset);
2175 next_fontset_id = 1;
2176
2177 auto_fontset_alist = Qnil;
2178 staticpro (&auto_fontset_alist);
2179
2180 DEFVAR_LISP ("font-encoding-charset-alist", Vfont_encoding_charset_alist,
2181 doc: /*
2182 Alist of charsets vs the charsets to determine the preferred font encoding.
2183 Each element looks like (CHARSET . ENCODING-CHARSET),
2184 where ENCODING-CHARSET is a charset registered in the variable
2185 `font-encoding-alist' as ENCODING.
2186
2187 When a text has a property `charset' and the value is CHARSET, a font
2188 whose encoding corresponds to ENCODING-CHARSET is preferred. */);
2189 Vfont_encoding_charset_alist = Qnil;
2190
2191 DEFVAR_LISP ("use-default-ascent", Vuse_default_ascent,
2192 doc: /*
2193 Char table of characters whose ascent values should be ignored.
2194 If an entry for a character is non-nil, the ascent value of the glyph
2195 is assumed to be specified by _MULE_DEFAULT_ASCENT property of a font.
2196
2197 This affects how a composite character which contains
2198 such a character is displayed on screen. */);
2199 Vuse_default_ascent = Qnil;
2200
2201 DEFVAR_LISP ("ignore-relative-composition", Vignore_relative_composition,
2202 doc: /*
2203 Char table of characters which are not composed relatively.
2204 If an entry for a character is non-nil, a composition sequence
2205 which contains that character is displayed so that
2206 the glyph of that character is put without considering
2207 an ascent and descent value of a previous character. */);
2208 Vignore_relative_composition = Qnil;
2209
2210 DEFVAR_LISP ("alternate-fontname-alist", Valternate_fontname_alist,
2211 doc: /* Alist of fontname vs list of the alternate fontnames.
2212 When a specified font name is not found, the corresponding
2213 alternate fontnames (if any) are tried instead. */);
2214 Valternate_fontname_alist = Qnil;
2215
2216 DEFVAR_LISP ("fontset-alias-alist", Vfontset_alias_alist,
2217 doc: /* Alist of fontset names vs the aliases. */);
2218 Vfontset_alias_alist = Fcons (Fcons (FONTSET_NAME (Vdefault_fontset),
2219 make_pure_c_string ("fontset-default")),
2220 Qnil);
2221
2222 DEFVAR_LISP ("vertical-centering-font-regexp",
2223 Vvertical_centering_font_regexp,
2224 doc: /* *Regexp matching font names that require vertical centering on display.
2225 When a character is displayed with such fonts, the character is displayed
2226 at the vertical center of lines. */);
2227 Vvertical_centering_font_regexp = Qnil;
2228
2229 DEFVAR_LISP ("otf-script-alist", Votf_script_alist,
2230 doc: /* Alist of OpenType script tags vs the corresponding script names. */);
2231 Votf_script_alist = Qnil;
2232
2233 defsubr (&Squery_fontset);
2234 defsubr (&Snew_fontset);
2235 defsubr (&Sset_fontset_font);
2236 defsubr (&Sinternal_char_font);
2237 defsubr (&Sfontset_info);
2238 defsubr (&Sfontset_font);
2239 defsubr (&Sfontset_list);
2240 #ifdef FONTSET_DEBUG
2241 defsubr (&Sfontset_list_all);
2242 #endif
2243 }