2 Copyright (C) 1995, 1997, 2000 Electrotechnical Laboratory, JAPAN.
3 Licensed to the Free Software Foundation.
5 National Institute of Advanced Industrial Science and Technology (AIST)
6 Registration Number H13PRO009
8 This file is part of GNU Emacs.
10 GNU Emacs is free software; you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation; either version 2, or (at your option)
15 GNU Emacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with GNU Emacs; see the file COPYING. If not, write to
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 Boston, MA 02111-1307, USA. */
25 /* #define FONTSET_DEBUG */
34 #include "blockinput.h"
36 #include "character.h"
41 #include "dispextern.h"
42 #include "intervals.h"
48 #define xassert(X) do {if (!(X)) abort ();} while (0)
51 #else /* not FONTSET_DEBUG */
52 #define xassert(X) (void) 0
53 #endif /* not FONTSET_DEBUG */
55 EXFUN (Fclear_face_cache
, 1);
59 A fontset is a collection of font related information to give
60 similar appearance (style, etc) of characters. A fontset has two
61 roles. One is to use for the frame parameter `font' as if it is an
62 ASCII font. In that case, Emacs uses the font specified for
63 `ascii' script for the frame's default font.
65 Another role, the more important one, is to provide information
66 about which font to use for each non-ASCII character.
68 There are two kinds of fontsets; base and realized. A base fontset
69 is created by `new-fontset' from Emacs Lisp explicitly. A realized
70 fontset is created implicitly when a face is realized for ASCII
71 characters. A face is also realized for non-ASCII characters based
72 on an ASCII face. All of non-ASCII faces based on the same ASCII
73 face share the same realized fontset.
75 A fontset object is implemented by a char-table whose default value
76 and parent are always nil.
78 An element of a base fontset is a vector of FONT-DEFs which itself
79 is a vector [ FONT-SPEC ENCODING REPERTORY ].
82 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
85 where FAMILY, WEIGHT, SLANT, SWIDTH, ADSTYLE, REGISTRY, and
86 FONT-NAME are strings.
88 Note: Currently WEIGHT through ADSTYLE are ignored.
90 ENCODING is a charset ID that can convert characters to glyph codes
91 of the corresponding font.
93 REPERTORY is a charset ID, a char-table, or nil. If REPERTORY is a
94 charset ID, the repertory of the charset exactly matches with that
95 of the font. If REPERTORY is a char-table, all characters who have
96 a non-nil value in the table are supported. If REPERTORY is nil,
97 we consult with the font itself to get the repertory.
99 ENCODING and REPERTORY are extracted from the variable
100 Vfont_encoding_alist by using a font name generated from FONT-SPEC
101 (if it is a vector) or FONT-NAME as a matching target.
104 An element of a realized fontset is nil or t, or has this form:
106 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID
107 PREFERRED-RFONT-DEF RFONT-DEF0 RFONT-DEF1 ...].
109 RFONT-DEFn (i.e. Realized FONT-DEF) has this form:
111 [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ]
113 RFONT-DEFn is automatically reordered by the current charset
116 The value nil means that we have not yet generated the above vector
117 from the base of the fontset.
119 The value t means that no font is available for the corresponding
123 A fontset has 9 extra slots.
125 The 1st slot: the ID number of the fontset
128 base: the name of the fontset
133 realized: the base fontset
137 realized: the frame that the fontset belongs to
140 base: the font name for ASCII characters
145 realized: the ID number of a face to use for characters that
146 has no font in a realized fontset.
150 realized: Alist of font index vs the corresponding repertory
155 realized: If the base is not the default fontset, a fontset
156 realized from the default fontset, else nil.
159 base: Same as element value (but for fallback fonts).
162 All fontsets are recorded in the vector Vfontset_table.
167 There's a special base fontset named `default fontset' which
168 defines the default font specifications. When a base fontset
169 doesn't specify a font for a specific character, the corresponding
170 value in the default fontset is used.
172 The parent of a realized fontset created for such a face that has
173 no fontset is the default fontset.
176 These structures are hidden from the other codes than this file.
177 The other codes handle fontsets only by their ID numbers. They
178 usually use the variable name `fontset' for IDs. But, in this
179 file, we always use varialbe name `id' for IDs, and name `fontset'
180 for an actual fontset object, i.e., char-table.
184 /********** VARIABLES and FUNCTION PROTOTYPES **********/
186 extern Lisp_Object Qfont
;
187 static Lisp_Object Qfontset
;
188 static Lisp_Object Qfontset_info
;
189 static Lisp_Object Qprepend
, Qappend
;
191 /* Vector containing all fontsets. */
192 static Lisp_Object Vfontset_table
;
194 /* Next possibly free fontset ID. Usually this keeps the minimum
195 fontset ID not yet used. */
196 static int next_fontset_id
;
198 /* The default fontset. This gives default FAMILY and REGISTRY of
199 font for each character. */
200 static Lisp_Object Vdefault_fontset
;
202 Lisp_Object Vfont_encoding_alist
;
203 Lisp_Object Vuse_default_ascent
;
204 Lisp_Object Vignore_relative_composition
;
205 Lisp_Object Valternate_fontname_alist
;
206 Lisp_Object Vfontset_alias_alist
;
207 Lisp_Object Vvertical_centering_font_regexp
;
209 /* The following six are declarations of callback functions depending
210 on window system. See the comments in src/fontset.h for more
213 /* Return a pointer to struct font_info of font FONT_IDX of frame F. */
214 struct font_info
*(*get_font_info_func
) P_ ((FRAME_PTR f
, int font_idx
));
216 /* Return a list of font names which matches PATTERN. See the documentation
217 of `x-list-fonts' for more details. */
218 Lisp_Object (*list_fonts_func
) P_ ((struct frame
*f
,
223 /* Load a font named NAME for frame F and return a pointer to the
224 information of the loaded font. If loading is failed, return 0. */
225 struct font_info
*(*load_font_func
) P_ ((FRAME_PTR f
, char *name
, int));
227 /* Return a pointer to struct font_info of a font named NAME for frame F. */
228 struct font_info
*(*query_font_func
) P_ ((FRAME_PTR f
, char *name
));
230 /* Additional function for setting fontset or changing fontset
231 contents of frame F. */
232 void (*set_frame_fontset_func
) P_ ((FRAME_PTR f
, Lisp_Object arg
,
233 Lisp_Object oldval
));
235 /* To find a CCL program, fs_load_font calls this function.
236 The argument is a pointer to the struct font_info.
237 This function set the member `encoder' of the structure. */
238 void (*find_ccl_program_func
) P_ ((struct font_info
*));
240 Lisp_Object (*get_font_repertory_func
) P_ ((struct frame
*,
241 struct font_info
*));
243 /* Check if any window system is used now. */
244 void (*check_window_system_func
) P_ ((void));
247 /* Prototype declarations for static functions. */
248 static Lisp_Object fontset_add
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
250 static Lisp_Object fontset_font
P_ ((Lisp_Object
, int, struct face
*, int));
251 static Lisp_Object make_fontset
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
252 static Lisp_Object fontset_pattern_regexp
P_ ((Lisp_Object
));
253 static void accumulate_script_ranges
P_ ((Lisp_Object
, Lisp_Object
,
255 static Lisp_Object find_font_encoding
P_ ((char *));
257 static void set_fontset_font
P_ ((Lisp_Object
, Lisp_Object
));
261 /* Return 1 if ID is a valid fontset id, else return 0. */
264 fontset_id_valid_p (id
)
267 return (id
>= 0 && id
< ASIZE (Vfontset_table
) - 1);
274 /********** MACROS AND FUNCTIONS TO HANDLE FONTSET **********/
276 /* Return the fontset with ID. No check of ID's validness. */
277 #define FONTSET_FROM_ID(id) AREF (Vfontset_table, id)
279 /* Macros to access special values of FONTSET. */
280 #define FONTSET_ID(fontset) XCHAR_TABLE (fontset)->extras[0]
282 /* Macros to access special values of (base) FONTSET. */
283 #define FONTSET_NAME(fontset) XCHAR_TABLE (fontset)->extras[1]
284 #define FONTSET_ASCII(fontset) XCHAR_TABLE (fontset)->extras[4]
286 /* Macros to access special values of (realized) FONTSET. */
287 #define FONTSET_BASE(fontset) XCHAR_TABLE (fontset)->extras[2]
288 #define FONTSET_FRAME(fontset) XCHAR_TABLE (fontset)->extras[3]
289 #define FONTSET_NOFONT_FACE(fontset) XCHAR_TABLE (fontset)->extras[5]
290 #define FONTSET_REPERTORY(fontset) XCHAR_TABLE (fontset)->extras[6]
291 #define FONTSET_DEFAULT(fontset) XCHAR_TABLE (fontset)->extras[7]
293 /* For both base and realized fontset. */
294 #define FONTSET_FALLBACK(fontset) XCHAR_TABLE (fontset)->extras[8]
296 #define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
299 /* Return the element of FONTSET for the character C. If FONTSET is a
300 base fontset other then the default fontset and FONTSET doesn't
301 contain information for C, return the information in the default
304 #define FONTSET_REF(fontset, c) \
305 (EQ (fontset, Vdefault_fontset) \
306 ? CHAR_TABLE_REF (fontset, c) \
307 : fontset_ref ((fontset), (c)))
310 fontset_ref (fontset
, c
)
316 elt
= CHAR_TABLE_REF (fontset
, c
);
317 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
318 /* Don't check Vdefault_fontset for a realized fontset. */
319 && NILP (FONTSET_BASE (fontset
)))
320 elt
= CHAR_TABLE_REF (Vdefault_fontset
, c
);
325 /* Return the element of FONTSET for the character C, set FROM and TO
326 to the range of characters around C that have the same value as C.
327 If FONTSET is a base fontset other then the default fontset and
328 FONTSET doesn't contain information for C, return the information
329 in the default fontset. */
331 #define FONTSET_REF_AND_RANGE(fontset, c, form, to) \
332 (EQ (fontset, Vdefault_fontset) \
333 ? char_table_ref_and_range (fontset, c, &from, &to) \
334 : fontset_ref_and_range (fontset, c, &from, &to))
337 fontset_ref_and_range (fontset
, c
, from
, to
)
344 elt
= char_table_ref_and_range (fontset
, c
, from
, to
);
345 if (NILP (elt
) && ! EQ (fontset
, Vdefault_fontset
)
346 /* Don't check Vdefault_fontset for a realized fontset. */
347 && NILP (FONTSET_BASE (fontset
)))
351 elt
= char_table_ref_and_range (Vdefault_fontset
, c
, &from1
, &to1
);
361 /* Set elements of FONTSET for characters in RANGE to the value ELT.
362 RANGE is a cons (FROM . TO), where FROM and TO are character codes
363 specifying a range. */
365 #define FONTSET_SET(fontset, range, elt) \
366 Fset_char_table_range ((fontset), (range), (elt))
369 /* Modify the elements of FONTSET for characters in RANGE by replacing
370 with ELT or adding ELT. RANGE is a cons (FROM . TO), where FROM
371 and TO are character codes specifying a range. If ADD is nil,
372 replace with ELT, if ADD is `prepend', prepend ELT, otherwise,
375 #define FONTSET_ADD(fontset, range, elt, add) \
378 ? (FONTSET_FALLBACK (fontset) = Fmake_vector (make_number (1), (elt))) \
379 : Fset_char_table_range ((fontset), (range), \
380 Fmake_vector (make_number (1), (elt)))) \
381 : fontset_add ((fontset), (range), (elt), (add)))
384 fontset_add (fontset
, range
, elt
, add
)
385 Lisp_Object fontset
, range
, elt
, add
;
388 int idx
= (EQ (add
, Qappend
) ? 0 : 1);
390 args
[1 - idx
] = Fmake_vector (make_number (1), elt
);
394 int from
= XINT (XCAR (range
));
395 int to
= XINT (XCDR (range
));
399 args
[idx
] = char_table_ref_and_range (fontset
, from
, &from1
, &to1
);
402 char_table_set_range (fontset
, from
, to1
,
403 NILP (args
[idx
]) ? args
[1 - idx
]
404 : Fvconcat (2, args
));
410 args
[idx
] = FONTSET_FALLBACK (fontset
);
411 FONTSET_FALLBACK (fontset
)
412 = NILP (args
[idx
]) ? args
[1 - idx
] : Fvconcat (2, args
);
418 /* Update FONTSET_ELEMENT which has this form:
419 [CHARSET-ORDERED-LIST-TICK PREFERRED-CHARSET-ID PREFERRED-RFONT-DEF
420 RFONT-DEF0 RFONT-DEF1 ...].
421 Reorder RFONT-DEFs according to the current order of charset
422 (Vcharset_ordered_list), and update CHARSET-ORDERED-LIST-TICK to
426 reorder_font_vector (fontset_element
)
427 Lisp_Object fontset_element
;
429 Lisp_Object vec
, list
, *new_vec
;
430 Lisp_Object font_def
;
432 int *charset_id_table
;
435 ASET (fontset_element
, 0, make_number (charset_ordered_list_tick
));
436 size
= ASIZE (fontset_element
) - 3;
438 /* No need to reorder VEC. */
440 charset_id_table
= (int *) alloca (sizeof (int) * size
);
441 new_vec
= (Lisp_Object
*) alloca (sizeof (Lisp_Object
) * size
);
443 /* At first, extract ENCODING (a chaset ID) from each FONT-DEF.
444 FONT-DEF has this form:
445 [FACE-ID FONT-INDEX [ FONT-SPEC ENCODING REPERTORY ]] */
446 for (i
= 0; i
< size
; i
++)
448 font_def
= AREF (fontset_element
, i
+ 3);
449 charset_id_table
[i
] = XINT (AREF (AREF (font_def
, 2), 1));
452 /* Then, store FONT-DEFs in NEW_VEC in the correct order. */
453 for (idx
= 0, list
= Vcharset_ordered_list
;
454 idx
< size
&& CONSP (list
); list
= XCDR (list
))
456 for (i
= 0; i
< size
; i
++)
457 if (charset_id_table
[i
] == XINT (XCAR (list
)))
458 new_vec
[idx
++] = AREF (fontset_element
, i
+ 3);
461 /* At last, update FONT-DEFs. */
462 for (i
= 0; i
< size
; i
++)
463 ASET (fontset_element
, i
+ 3, new_vec
[i
]);
467 /* Load a font matching the font related attributes in FACE->lface and
468 font pattern in FONT_DEF of FONTSET, and return an index of the
469 font. FONT_DEF has this form:
470 [ FONT-SPEC ENCODING REPERTORY ]
471 If REPERTORY is nil, generate a char-table representing the font
472 repertory by looking into the font itself. */
475 load_font_get_repertory (f
, face
, font_def
, fontset
)
478 Lisp_Object font_def
;
482 struct font_info
*font_info
;
485 font_name
= choose_face_font (f
, face
->lface
, AREF (font_def
, 0), NULL
);
486 if (NATNUMP (AREF (font_def
, 1)))
487 charset
= XINT (AREF (font_def
, 1));
490 if (! (font_info
= fs_load_font (f
, font_name
, charset
)))
493 if (NILP (AREF (font_def
, 2))
494 && NILP (Fassq (make_number (font_info
->font_idx
),
495 FONTSET_REPERTORY (fontset
))))
497 /* We must look into the font to get the correct repertory as a
499 Lisp_Object repertory
;
501 repertory
= (*get_font_repertory_func
) (f
, font_info
);
502 FONTSET_REPERTORY (fontset
)
503 = Fcons (Fcons (make_number (font_info
->font_idx
), repertory
),
504 FONTSET_REPERTORY (fontset
));
507 return font_info
->font_idx
;
511 /* Return RFONT-DEF (vector) in the realized fontset FONTSET for the
512 character C. If the corresponding font is not yet opened, open it
513 (if FACE is not NULL) or return Qnil (if FACE is NULL).
514 If no proper font is found for C, return Qnil. */
517 fontset_font (fontset
, c
, face
, id
)
523 Lisp_Object base_fontset
, elt
, vec
;
526 FRAME_PTR f
= XFRAME (FONTSET_FRAME (fontset
));
528 base_fontset
= FONTSET_BASE (fontset
);
529 vec
= CHAR_TABLE_REF (fontset
, c
);
535 /* We have not yet decided a face for C. */
540 elt
= FONTSET_REF_AND_RANGE (base_fontset
, c
, from
, to
);
541 range
= Fcons (make_number (from
), make_number (to
));
544 /* Record that we have no font for characters of this
547 FONTSET_SET (fontset
, range
, vec
);
550 /* Build a vector [ -1 -1 nil NEW-ELT0 NEW-ELT1 NEW-ELT2 ... ],
551 where the first -1 is to force reordering of NEW-ELTn,
552 NEW-ETLn is [nil nil AREF (elt, n) nil]. */
553 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
555 for (i
= 0; i
< ASIZE (elt
); i
++)
559 tmp
= Fmake_vector (make_number (4), Qnil
);
560 ASET (tmp
, 2, AREF (elt
, i
));
561 ASET (vec
, 3 + i
, tmp
);
563 /* Then store it in the fontset. */
564 FONTSET_SET (fontset
, range
, vec
);
568 if (XINT (AREF (vec
, 0)) != charset_ordered_list_tick
)
569 /* The priority of charsets is changed after we selected a face
571 reorder_font_vector (vec
);
575 else if (id
== XFASTINT (AREF (vec
, 1)))
579 ASET (vec
, 1, make_number (id
));
580 for (i
= 3; i
< ASIZE (vec
); i
++)
581 if (id
== XFASTINT (AREF (AREF (AREF (vec
, i
), 2), 1)))
585 ASET (vec
, 2, AREF (vec
, i
));
595 /* Find the first available font in the vector of RFONT-DEF. */
596 for (; i
< ASIZE (vec
); i
++)
598 Lisp_Object font_def
;
603 /* ELT == [ FACE-ID FONT-INDEX FONT-DEF OPENED-FONT-NAME ] */
604 if (INTEGERP (AREF (elt
, 1)) && XINT (AREF (elt
, 1)) < 0)
605 /* We couldn't open this font last time. */
608 if (!face
&& NILP (AREF (elt
, 1)))
609 /* We have not yet opened the font. */
612 font_def
= AREF (elt
, 2);
613 /* FONT_DEF == [ FONT-SPEC ENCODING REPERTORY ] */
614 if (INTEGERP (AREF (font_def
, 2)))
616 /* The repertory is specified by charset ID. */
617 struct charset
*charset
618 = CHARSET_FROM_ID (XINT (AREF (font_def
, 2)));
620 if (! CHAR_CHARSET_P (c
, charset
))
621 /* This font can't display C. */
624 else if (CHAR_TABLE_P (AREF (font_def
, 2)))
626 /* The repertory is specified by a char table. */
627 if (NILP (CHAR_TABLE_REF (AREF (font_def
, 2), c
)))
628 /* This font can't display C. */
635 if (! INTEGERP (AREF (elt
, 1)))
637 /* We have not yet opened a font matching this spec.
638 Open the best matching font now and register the
640 struct font_info
*font_info
;
642 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
643 ASET (elt
, 1, make_number (font_idx
));
645 /* This means that we couldn't find a font matching
648 font_info
= (*get_font_info_func
) (f
, font_idx
);
649 ASET (elt
, 3, build_string (font_info
->full_name
));
652 slot
= Fassq (AREF (elt
, 1), FONTSET_REPERTORY (fontset
));
653 xassert (CONSP (slot
));
654 if (NILP (CHAR_TABLE_REF (XCDR (slot
), c
)))
655 /* This font can't display C. */
659 /* Now we have decided to use this font spec to display C. */
660 if (! INTEGERP (AREF (elt
, 1)))
662 /* But not yet opened the best matching font. */
663 struct font_info
*font_info
;
665 font_idx
= load_font_get_repertory (f
, face
, font_def
, fontset
);
666 ASET (elt
, 1, make_number (font_idx
));
668 /* Can't open it. Try the other one. */
670 font_info
= (*get_font_info_func
) (f
, font_idx
);
671 ASET (elt
, 3, build_string (font_info
->full_name
));
674 /* Now we have the opened font. */
679 if (! EQ (vec
, FONTSET_FALLBACK (fontset
)))
681 vec
= FONTSET_FALLBACK (fontset
);
686 elt
= FONTSET_FALLBACK (base_fontset
);
689 vec
= Fmake_vector (make_number (ASIZE (elt
) + 3), make_number (-1));
691 for (i
= 0; i
< ASIZE (elt
); i
++)
695 tmp
= Fmake_vector (make_number (4), Qnil
);
696 ASET (tmp
, 2, AREF (elt
, i
));
697 ASET (vec
, 3 + i
, tmp
);
699 FONTSET_FALLBACK (fontset
) = vec
;
702 /* Record that this fontset has no fallback fonts. */
703 FONTSET_FALLBACK (fontset
) = Qt
;
706 /* Try the default fontset. */
708 if (! EQ (base_fontset
, Vdefault_fontset
))
710 if (NILP (FONTSET_DEFAULT (fontset
)))
711 FONTSET_DEFAULT (fontset
)
712 = make_fontset (FONTSET_FRAME (fontset
), Qnil
, Vdefault_fontset
);
713 return fontset_font (FONTSET_DEFAULT (fontset
), c
, face
, id
);
719 /* Return a newly created fontset with NAME. If BASE is nil, make a
720 base fontset. Otherwise make a realized fontset whose base is
724 make_fontset (frame
, name
, base
)
725 Lisp_Object frame
, name
, base
;
728 int size
= ASIZE (Vfontset_table
);
729 int id
= next_fontset_id
;
731 /* Find a free slot in Vfontset_table. Usually, next_fontset_id is
732 the next available fontset ID. So it is expected that this loop
733 terminates quickly. In addition, as the last element of
734 Vfontset_table is always nil, we don't have to check the range of
736 while (!NILP (AREF (Vfontset_table
, id
))) id
++;
740 /* We must grow Vfontset_table. */
744 tem
= Fmake_vector (make_number (size
+ 32), Qnil
);
745 for (i
= 0; i
< size
; i
++)
746 AREF (tem
, i
) = AREF (Vfontset_table
, i
);
747 Vfontset_table
= tem
;
750 fontset
= Fmake_char_table (Qfontset
, Qnil
);
752 FONTSET_ID (fontset
) = make_number (id
);
755 FONTSET_NAME (fontset
) = name
;
759 FONTSET_NAME (fontset
) = Qnil
;
760 FONTSET_FRAME (fontset
) = frame
;
761 FONTSET_BASE (fontset
) = base
;
764 ASET (Vfontset_table
, id
, fontset
);
765 next_fontset_id
= id
+ 1;
771 /********** INTERFACES TO xfaces.c, xfns.c, and dispextern.h **********/
773 /* Return the name of the fontset who has ID. */
781 fontset
= FONTSET_FROM_ID (id
);
782 return FONTSET_NAME (fontset
);
786 /* Return the ASCII font name of the fontset who has ID. */
792 Lisp_Object fontset
, elt
;
794 fontset
= FONTSET_FROM_ID (id
);
795 elt
= FONTSET_ASCII (fontset
);
796 /* It is assured that ELT is always a string (i.e. fontname
802 /* Free fontset of FACE defined on frame F. Called from
803 free_realized_face. */
806 free_face_fontset (f
, face
)
812 fontset
= AREF (Vfontset_table
, face
->fontset
);
813 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
814 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
815 ASET (Vfontset_table
, face
->fontset
, Qnil
);
816 if (face
->fontset
< next_fontset_id
)
817 next_fontset_id
= face
->fontset
;
818 if (! NILP (FONTSET_DEFAULT (fontset
)))
820 int id
= XINT (FONTSET_ID (FONTSET_DEFAULT (fontset
)));
822 fontset
= AREF (Vfontset_table
, id
);
823 xassert (!NILP (fontset
) && ! BASE_FONTSET_P (fontset
));
824 xassert (f
== XFRAME (FONTSET_FRAME (fontset
)));
825 ASET (Vfontset_table
, id
, Qnil
);
826 if (id
< next_fontset_id
)
827 next_fontset_id
= face
->fontset
;
832 /* Return 1 iff FACE is suitable for displaying character C.
833 Otherwise return 0. Called from the macro FACE_SUITABLE_FOR_CHAR_P
834 when C is not an ASCII character. */
837 face_suitable_for_char_p (face
, c
)
841 Lisp_Object fontset
, rfont_def
;
843 fontset
= FONTSET_FROM_ID (face
->fontset
);
844 rfont_def
= fontset_font (fontset
, c
, NULL
, -1);
845 return (VECTORP (rfont_def
)
846 && INTEGERP (AREF (rfont_def
, 0))
847 && face
->id
== XINT (AREF (rfont_def
, 0)));
851 /* Return ID of face suitable for displaying character C on frame F.
852 FACE must be reazlied for ASCII characters in advance. Called from
853 the macro FACE_FOR_CHAR. */
856 face_for_char (f
, face
, c
, pos
, object
)
862 Lisp_Object fontset
, charset
, rfont_def
;
866 if (ASCII_CHAR_P (c
))
867 return face
->ascii_face
->id
;
869 xassert (fontset_id_valid_p (face
->fontset
));
870 fontset
= FONTSET_FROM_ID (face
->fontset
);
871 xassert (!BASE_FONTSET_P (fontset
));
876 charset
= Fget_char_property (make_number (pos
), Qcharset
, object
);
879 else if (CHARSETP (charset
))
880 id
= XINT (CHARSET_SYMBOL_ID (charset
));
882 rfont_def
= fontset_font (fontset
, c
, face
, id
);
883 if (VECTORP (rfont_def
))
885 if (NILP (AREF (rfont_def
, 0)))
887 /* We have not yet made a realized face that uses this font. */
888 int font_idx
= XINT (AREF (rfont_def
, 1));
890 face_id
= lookup_non_ascii_face (f
, font_idx
, face
);
891 ASET (rfont_def
, 0, make_number (face_id
));
893 return XINT (AREF (rfont_def
, 0));
896 if (NILP (FONTSET_NOFONT_FACE (fontset
)))
898 face_id
= lookup_non_ascii_face (f
, -1, face
);
899 FONTSET_NOFONT_FACE (fontset
) = make_number (face_id
);
901 return XINT (FONTSET_NOFONT_FACE (fontset
));
905 /* Make a realized fontset for ASCII face FACE on frame F from the
906 base fontset BASE_FONTSET_ID. If BASE_FONTSET_ID is -1, use the
907 default fontset as the base. Value is the id of the new fontset.
908 Called from realize_x_face. */
911 make_fontset_for_ascii_face (f
, base_fontset_id
, face
)
916 Lisp_Object base_fontset
, fontset
, frame
;
918 XSETFRAME (frame
, f
);
919 if (base_fontset_id
>= 0)
921 base_fontset
= FONTSET_FROM_ID (base_fontset_id
);
922 if (!BASE_FONTSET_P (base_fontset
))
923 base_fontset
= FONTSET_BASE (base_fontset
);
924 xassert (BASE_FONTSET_P (base_fontset
));
925 if (! BASE_FONTSET_P (base_fontset
))
929 base_fontset
= Vdefault_fontset
;
931 fontset
= make_fontset (frame
, Qnil
, base_fontset
);
933 Lisp_Object elt
, rfont_def
;
935 elt
= FONTSET_REF (base_fontset
, 0);
936 xassert (VECTORP (elt
) && ASIZE (elt
) > 0);
937 rfont_def
= Fmake_vector (make_number (4), Qnil
);
938 ASET (rfont_def
, 0, make_number (face
->id
));
939 ASET (rfont_def
, 1, make_number (face
->font_info_id
));
940 ASET (rfont_def
, 2, AREF (elt
, 0));
941 ASET (rfont_def
, 3, build_string (face
->font_name
));
942 elt
= Fmake_vector (make_number (4), Qnil
);
943 ASET (elt
, 0, make_number (charset_ordered_list_tick
));
944 ASET (elt
, 1, make_number (charset_ascii
));
945 ASET (elt
, 2, rfont_def
);
946 ASET (elt
, 3, rfont_def
);
947 char_table_set_range (fontset
, 0, 127, elt
);
949 return XINT (FONTSET_ID (fontset
));
953 #if defined(WINDOWSNT) && defined (_MSC_VER)
954 #pragma optimize("", off)
957 /* Load a font named FONTNAME on frame F. Return a pointer to the
958 struct font_info of the loaded font. If loading fails, return
959 NULL. CHARSET is an ID of charset to encode characters for this
960 font. If it is -1, find one from Vfont_encoding_alist. */
963 fs_load_font (f
, fontname
, charset
)
968 struct font_info
*fontp
;
971 /* No way to get fontname. */
974 fontp
= (*load_font_func
) (f
, fontname
, 0);
975 if (! fontp
|| fontp
->charset
>= 0)
978 fontname
= fontp
->full_name
;
982 Lisp_Object charset_symbol
;
984 charset_symbol
= find_font_encoding (fontname
);
985 if (CONSP (charset_symbol
))
986 charset_symbol
= XCAR (charset_symbol
);
987 charset
= XINT (CHARSET_SYMBOL_ID (charset_symbol
));
989 fontp
->charset
= charset
;
990 fontp
->vertical_centering
= 0;
991 fontp
->font_encoder
= NULL
;
993 if (charset
!= charset_ascii
)
995 fontp
->vertical_centering
996 = (STRINGP (Vvertical_centering_font_regexp
)
997 && (fast_c_string_match_ignore_case
998 (Vvertical_centering_font_regexp
, fontname
) >= 0));
1000 if (find_ccl_program_func
)
1001 (*find_ccl_program_func
) (fontp
);
1007 #if defined(WINDOWSNT) && defined (_MSC_VER)
1008 #pragma optimize("", on)
1012 /* Return ENCODING or a cons of ENCODING and REPERTORY of the font
1013 FONTNAME. ENCODING is a charset symbol that specifies the encoding
1014 of the font. REPERTORY is a charset symbol or nil. */
1018 find_font_encoding (fontname
)
1021 Lisp_Object tail
, elt
;
1023 for (tail
= Vfont_encoding_alist
; CONSP (tail
); tail
= XCDR (tail
))
1027 && STRINGP (XCAR (elt
))
1028 && fast_c_string_match_ignore_case (XCAR (elt
), fontname
) >= 0
1029 && (SYMBOLP (XCDR (elt
))
1030 ? CHARSETP (XCDR (elt
))
1031 : CONSP (XCDR (elt
)) && CHARSETP (XCAR (XCDR (elt
)))))
1032 return (XCDR (elt
));
1034 /* We don't know the encoding of this font. */
1039 /* Cache data used by fontset_pattern_regexp. The car part is a
1040 pattern string containing at least one wild card, the cdr part is
1041 the corresponding regular expression. */
1042 static Lisp_Object Vcached_fontset_data
;
1044 #define CACHED_FONTSET_NAME (SDATA (XCAR (Vcached_fontset_data)))
1045 #define CACHED_FONTSET_REGEX (XCDR (Vcached_fontset_data))
1047 /* If fontset name PATTERN contains any wild card, return regular
1048 expression corresponding to PATTERN. */
1051 fontset_pattern_regexp (pattern
)
1052 Lisp_Object pattern
;
1054 if (!index (SDATA (pattern
), '*')
1055 && !index (SDATA (pattern
), '?'))
1056 /* PATTERN does not contain any wild cards. */
1059 if (!CONSP (Vcached_fontset_data
)
1060 || strcmp (SDATA (pattern
), CACHED_FONTSET_NAME
))
1062 /* We must at first update the cached data. */
1063 char *regex
= (char *) alloca (SCHARS (pattern
) * 2 + 3);
1064 char *p0
, *p1
= regex
;
1066 /* Convert "*" to ".*", "?" to ".". */
1068 for (p0
= (char *) SDATA (pattern
); *p0
; p0
++)
1075 else if (*p0
== '?')
1083 Vcached_fontset_data
= Fcons (build_string (SDATA (pattern
)),
1084 build_string (regex
));
1087 return CACHED_FONTSET_REGEX
;
1090 /* Return ID of the base fontset named NAME. If there's no such
1091 fontset, return -1. */
1094 fs_query_fontset (name
, regexpp
)
1101 name
= Fdowncase (name
);
1104 tem
= Frassoc (name
, Vfontset_alias_alist
);
1106 tem
= Fassoc (name
, Vfontset_alias_alist
);
1107 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1111 tem
= fontset_pattern_regexp (name
);
1120 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1122 Lisp_Object fontset
;
1123 unsigned char *this_name
;
1125 fontset
= FONTSET_FROM_ID (i
);
1127 || !BASE_FONTSET_P (fontset
))
1130 this_name
= SDATA (FONTSET_NAME (fontset
));
1132 ? fast_c_string_match_ignore_case (name
, this_name
) >= 0
1133 : !strcmp (SDATA (name
), this_name
))
1140 DEFUN ("query-fontset", Fquery_fontset
, Squery_fontset
, 1, 2, 0,
1141 doc
: /* Return the name of a fontset that matches PATTERN.
1142 The value is nil if there is no matching fontset.
1143 PATTERN can contain `*' or `?' as a wildcard
1144 just as X font name matching algorithm allows.
1145 If REGEXPP is non-nil, PATTERN is a regular expression. */)
1147 Lisp_Object pattern
, regexpp
;
1149 Lisp_Object fontset
;
1152 (*check_window_system_func
) ();
1154 CHECK_STRING (pattern
);
1156 if (SCHARS (pattern
) == 0)
1159 id
= fs_query_fontset (pattern
, !NILP (regexpp
));
1163 fontset
= FONTSET_FROM_ID (id
);
1164 return FONTSET_NAME (fontset
);
1167 /* Return a list of base fontset names matching PATTERN on frame F. */
1170 list_fontsets (f
, pattern
, size
)
1172 Lisp_Object pattern
;
1175 Lisp_Object frame
, regexp
, val
;
1178 XSETFRAME (frame
, f
);
1180 regexp
= fontset_pattern_regexp (pattern
);
1183 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1185 Lisp_Object fontset
;
1186 unsigned char *name
;
1188 fontset
= FONTSET_FROM_ID (id
);
1190 || !BASE_FONTSET_P (fontset
)
1191 || !EQ (frame
, FONTSET_FRAME (fontset
)))
1193 name
= SDATA (FONTSET_NAME (fontset
));
1195 if (STRINGP (regexp
)
1196 ? (fast_c_string_match_ignore_case (regexp
, name
) < 0)
1197 : strcmp (SDATA (pattern
), name
))
1200 val
= Fcons (Fcopy_sequence (FONTSET_NAME (fontset
)), val
);
1207 /* Free all realized fontsets whose base fontset is BASE. */
1210 free_realized_fontsets (base
)
1216 /* For the moment, this doesn't work because free_realized_face
1217 doesn't remove FACE from a cache. Until we find a solution, we
1218 suppress this code, and simply use Fclear_face_cache even though
1219 that is not efficient. */
1221 for (id
= 0; id
< ASIZE (Vfontset_table
); id
++)
1223 Lisp_Object
this = AREF (Vfontset_table
, id
);
1225 if (EQ (FONTSET_BASE (this), base
))
1229 for (tail
= FONTSET_FACE_ALIST (this); CONSP (tail
);
1232 FRAME_PTR f
= XFRAME (FONTSET_FRAME (this));
1233 int face_id
= XINT (XCDR (XCAR (tail
)));
1234 struct face
*face
= FACE_FROM_ID (f
, face_id
);
1236 /* Face THIS itself is also freed by the following call. */
1237 free_realized_face (f
, face
);
1243 Fclear_face_cache (Qt
);
1248 /* Check validity of NAME as a fontset name and return the
1249 corresponding fontset. If not valid, signal an error.
1250 If NAME is t, return Vdefault_fontset. */
1253 check_fontset_name (name
)
1259 return Vdefault_fontset
;
1261 CHECK_STRING (name
);
1262 id
= fs_query_fontset (name
, 0);
1264 error ("Fontset `%s' does not exist", SDATA (name
));
1265 return FONTSET_FROM_ID (id
);
1269 accumulate_script_ranges (arg
, range
, val
)
1270 Lisp_Object arg
, range
, val
;
1272 if (EQ (XCAR (arg
), val
))
1275 XSETCDR (arg
, Fcons (Fcons (XCAR (range
), XCDR (range
)), XCDR (arg
)));
1277 XSETCDR (arg
, Fcons (Fcons (range
, range
), XCDR (arg
)));
1282 /* Return an ASCII font name generated from fontset name NAME and
1283 ASCII font specification ASCII_SPEC. NAME is a string conforming
1284 to XLFD. ASCII_SPEC is a vector:
1285 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
1287 static INLINE Lisp_Object
1288 generate_ascii_font_name (name
, ascii_spec
)
1289 Lisp_Object name
, ascii_spec
;
1294 vec
= split_font_name_into_vector (name
);
1295 for (i
= FONT_SPEC_FAMILY_INDEX
; i
<= FONT_SPEC_ADSTYLE_INDEX
; i
++)
1296 if (! NILP (AREF (ascii_spec
, i
)))
1297 ASET (vec
, 1 + i
, AREF (ascii_spec
, i
));
1298 if (! NILP (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
)))
1299 ASET (vec
, 12, AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
1300 return build_font_name_from_vector (vec
);
1304 set_fontset_font (arg
, range
)
1305 Lisp_Object arg
, range
;
1307 Lisp_Object fontset
, font_def
, add
;
1309 fontset
= XCAR (arg
);
1310 font_def
= XCAR (XCDR (arg
));
1311 add
= XCAR (XCDR (XCDR (arg
)));
1312 FONTSET_ADD (fontset
, range
, font_def
, add
);
1313 free_realized_fontsets (fontset
);
1317 DEFUN ("set-fontset-font", Fset_fontset_font
, Sset_fontset_font
, 3, 5, 0,
1319 Modify fontset NAME to use FONT-SPEC for TARGET characters.
1321 TARGET may be a cons; (FROM . TO), where FROM and TO are characters.
1322 In that case, use FONT-SPEC for all characters in the range FROM and
1325 TARGET may be a script name symbol. In that case, use FONT-SPEC for
1326 all characters that belong to the script.
1328 TARGET may be a charset. In that case, use FONT-SPEC for all
1329 characters in the charset.
1331 TARGET may be nil. In that case, use FONT-SPEC for any characters for
1332 that no FONT-SPEC is specified.
1335 * A vector [ FAMILY WEIGHT SLANT WIDTH ADSTYLE REGISTRY ].
1336 See the documentation of `set-face-attribute' for the detail of
1337 these vector elements;
1338 * A cons (FAMILY . REGISTRY), where FAMILY is a font family name and
1339 REGISTRY is a font registry name;
1340 * A font name string.
1342 Optional 4th argument FRAME, if non-nil, is a frame. This argument is
1343 kept for backward compatibility and has no meaning.
1345 Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC
1346 to the font specifications for TARGET previously set. If it is
1347 `prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is
1348 appended. By default, FONT-SPEC overrides the previous settings. */)
1349 (name
, target
, font_spec
, frame
, add
)
1350 Lisp_Object name
, target
, font_spec
, frame
, add
;
1352 Lisp_Object fontset
;
1353 Lisp_Object font_def
, registry
;
1354 Lisp_Object encoding
, repertory
;
1355 Lisp_Object range_list
;
1357 fontset
= check_fontset_name (name
);
1359 /* The arg FRAME is kept for backward compatibility. We only check
1362 CHECK_LIVE_FRAME (frame
);
1364 if (VECTORP (font_spec
))
1368 if (ASIZE (font_spec
) != FONT_SPEC_MAX_INDEX
)
1369 args_out_of_range (make_number (FONT_SPEC_MAX_INDEX
),
1370 make_number (ASIZE (font_spec
)));
1372 font_spec
= Fcopy_sequence (font_spec
);
1373 for (j
= 0; j
< FONT_SPEC_MAX_INDEX
- 1; j
++)
1374 if (! NILP (AREF (font_spec
, j
)))
1376 CHECK_STRING (AREF (font_spec
, j
));
1377 ASET (font_spec
, j
, Fdowncase (AREF (font_spec
, j
)));
1379 /* REGISTRY should not be omitted. */
1380 CHECK_STRING (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1381 registry
= Fdowncase (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
));
1382 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1385 else if (CONSP (font_spec
))
1389 family
= XCAR (font_spec
);
1390 registry
= XCDR (font_spec
);
1392 if (! NILP (family
))
1394 CHECK_STRING (family
);
1395 family
= Fdowncase (family
);
1397 CHECK_STRING (registry
);
1398 registry
= Fdowncase (registry
);
1399 font_spec
= Fmake_vector (make_number (FONT_SPEC_MAX_INDEX
), Qnil
);
1400 ASET (font_spec
, FONT_SPEC_FAMILY_INDEX
, family
);
1401 ASET (font_spec
, FONT_SPEC_REGISTRY_INDEX
, registry
);
1405 CHECK_STRING (font_spec
);
1406 font_spec
= Fdowncase (font_spec
);
1409 if (STRINGP (font_spec
))
1410 encoding
= find_font_encoding ((char *) SDATA (font_spec
));
1412 encoding
= find_font_encoding ((char *) SDATA (registry
));
1413 if (NILP (encoding
))
1414 /* We don't know how to use this font. */
1416 if (SYMBOLP (encoding
))
1418 CHECK_CHARSET (encoding
);
1419 encoding
= repertory
= CHARSET_SYMBOL_ID (encoding
);
1423 repertory
= XCDR (encoding
);
1424 encoding
= XCAR (encoding
);
1425 CHECK_CHARSET (encoding
);
1426 encoding
= CHARSET_SYMBOL_ID (encoding
);
1427 if (! NILP (repertory
) && SYMBOLP (repertory
))
1429 CHECK_CHARSET (repertory
);
1430 repertory
= CHARSET_SYMBOL_ID (repertory
);
1433 font_def
= Fmake_vector (make_number (3), font_spec
);
1434 ASET (font_def
, 1, encoding
);
1435 ASET (font_def
, 2, repertory
);
1437 if (CHARACTERP (target
))
1438 range_list
= Fcons (Fcons (target
, target
), Qnil
);
1439 else if (CONSP (target
))
1441 Lisp_Object from
, to
;
1443 from
= Fcar (target
);
1445 CHECK_CHARACTER (from
);
1446 CHECK_CHARACTER (to
);
1447 range_list
= Fcons (target
, Qnil
);
1449 else if (SYMBOLP (target
) && !NILP (target
))
1451 Lisp_Object script_list
;
1455 script_list
= XCHAR_TABLE (Vchar_script_table
)->extras
[0];
1456 if (! NILP (Fmemq (target
, script_list
)))
1458 val
= Fcons (target
, Qnil
);
1459 map_char_table (accumulate_script_ranges
, Qnil
, Vchar_script_table
,
1461 range_list
= XCDR (val
);
1463 else if (CHARSETP (target
))
1465 struct charset
*charset
;
1467 CHECK_CHARSET_GET_CHARSET (target
, charset
);
1468 if (EQ (target
, Qascii
))
1470 if (VECTORP (font_spec
))
1471 font_spec
= generate_ascii_font_name (FONTSET_NAME (fontset
),
1473 FONTSET_ASCII (fontset
) = font_spec
;
1474 range_list
= Fcons (Fcons (make_number (0), make_number (127)),
1479 map_charset_chars (set_fontset_font
, Qnil
,
1480 list3 (fontset
, font_def
, add
), charset
,
1481 CHARSET_MIN_CODE (charset
),
1482 CHARSET_MAX_CODE (charset
));
1487 if (NILP (range_list
))
1488 error ("Invalid script or charset name: %s",
1489 SDATA (SYMBOL_NAME (target
)));
1491 else if (NILP (target
))
1492 range_list
= Fcons (Qnil
, Qnil
);
1494 error ("Invalid target for setting a font");
1496 for (; CONSP (range_list
); range_list
= XCDR (range_list
))
1497 FONTSET_ADD (fontset
, XCAR (range_list
), font_def
, add
);
1499 /* Free all realized fontsets whose base is FONTSET. This way, the
1500 specified character(s) are surely redisplayed by a correct
1502 free_realized_fontsets (fontset
);
1508 DEFUN ("new-fontset", Fnew_fontset
, Snew_fontset
, 2, 2, 0,
1509 doc
: /* Create a new fontset NAME from font information in FONTLIST.
1511 FONTLIST is an alist of scripts vs the corresponding font specification list.
1512 Each element of FONTLIST has the form (SCRIPT FONT-SPEC ...), where a
1513 character of SCRIPT is displayed by a font that matches one of
1516 SCRIPT is a symbol that appears in the first extra slot of the
1517 char-table `char-script-table'.
1519 FONT-SPEC is a vector, a cons, or a string. See the documentation of
1520 `set-fontset-font' for the meaning. */)
1522 Lisp_Object name
, fontlist
;
1524 Lisp_Object fontset
;
1528 CHECK_STRING (name
);
1529 CHECK_LIST (fontlist
);
1531 id
= fs_query_fontset (name
, 0);
1534 name
= Fdowncase (name
);
1535 val
= split_font_name_into_vector (name
);
1536 if (NILP (val
) || NILP (AREF (val
, 12)) || NILP (AREF (val
, 13)))
1537 error ("Fontset name must be in XLFD format");
1538 if (strcmp (SDATA (AREF (val
, 12)), "fontset"))
1539 error ("Registry field of fontset name must be \"fontset\"");
1540 Vfontset_alias_alist
1541 = Fcons (Fcons (name
,
1542 concat2 (concat2 (AREF (val
, 12), build_string ("-")),
1544 Vfontset_alias_alist
);
1545 ASET (val
, 12, build_string ("iso8859-1"));
1546 fontset
= make_fontset (Qnil
, name
, Qnil
);
1547 FONTSET_ASCII (fontset
) = build_font_name_from_vector (val
);
1551 fontset
= FONTSET_FROM_ID (id
);;
1552 free_realized_fontsets (fontset
);
1553 Fset_char_table_range (fontset
, Qt
, Qnil
);
1556 for (; ! NILP (fontlist
); fontlist
= Fcdr (fontlist
))
1558 Lisp_Object elt
, script
;
1560 elt
= Fcar (fontlist
);
1561 script
= Fcar (elt
);
1563 if (CONSP (elt
) && (NILP (XCDR (elt
)) || CONSP (XCDR (elt
))))
1564 for (; CONSP (elt
); elt
= XCDR (elt
))
1565 Fset_fontset_font (name
, script
, XCAR (elt
), Qnil
, Qappend
);
1567 Fset_fontset_font (name
, script
, elt
, Qnil
, Qappend
);
1573 /* Alist of automatically created fontsets. Each element is a cons
1574 (FONTNAME . FONTSET-ID). */
1575 static Lisp_Object auto_fontset_alist
;
1578 new_fontset_from_font_name (Lisp_Object fontname
)
1585 fontname
= Fdowncase (fontname
);
1586 val
= Fassoc (fontname
, auto_fontset_alist
);
1588 return XINT (XCDR (val
));
1590 vec
= split_font_name_into_vector (fontname
);
1592 vec
= Fmake_vector (make_number (14), build_string (""));
1593 ASET (vec
, 12, build_string ("fontset"));
1594 if (NILP (auto_fontset_alist
))
1596 ASET (vec
, 13, build_string ("startup"));
1597 name
= build_font_name_from_vector (vec
);
1602 int len
= XINT (Flength (auto_fontset_alist
));
1604 sprintf (temp
, "auto%d", len
);
1605 ASET (vec
, 13, build_string (temp
));
1606 name
= build_font_name_from_vector (vec
);
1608 name
= Fnew_fontset (name
, Fcons (Fcons (Fcons (make_number (0),
1609 make_number (MAX_CHAR
)),
1610 Fcons (fontname
, Qnil
)),
1612 id
= fs_query_fontset (name
, 0);
1614 = Fcons (Fcons (fontname
, make_number (id
)), auto_fontset_alist
);
1619 DEFUN ("font-info", Ffont_info
, Sfont_info
, 1, 2, 0,
1620 doc
: /* Return information about a font named NAME on frame FRAME.
1621 If FRAME is omitted or nil, use the selected frame.
1622 The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,
1623 HEIGHT, BASELINE-OFFSET, RELATIVE-COMPOSE, and DEFAULT-ASCENT,
1625 OPENED-NAME is the name used for opening the font,
1626 FULL-NAME is the full name of the font,
1627 SIZE is the maximum bound width of the font,
1628 HEIGHT is the height of the font,
1629 BASELINE-OFFSET is the upward offset pixels from ASCII baseline,
1630 RELATIVE-COMPOSE and DEFAULT-ASCENT are the numbers controlling
1631 how to compose characters.
1632 If the named font is not yet loaded, return nil. */)
1634 Lisp_Object name
, frame
;
1637 struct font_info
*fontp
;
1640 (*check_window_system_func
) ();
1642 CHECK_STRING (name
);
1643 name
= Fdowncase (name
);
1645 frame
= selected_frame
;
1646 CHECK_LIVE_FRAME (frame
);
1649 if (!query_font_func
)
1650 error ("Font query function is not supported");
1652 fontp
= (*query_font_func
) (f
, SDATA (name
));
1656 info
= Fmake_vector (make_number (7), Qnil
);
1658 XVECTOR (info
)->contents
[0] = build_string (fontp
->name
);
1659 XVECTOR (info
)->contents
[1] = build_string (fontp
->full_name
);
1660 XVECTOR (info
)->contents
[2] = make_number (fontp
->size
);
1661 XVECTOR (info
)->contents
[3] = make_number (fontp
->height
);
1662 XVECTOR (info
)->contents
[4] = make_number (fontp
->baseline_offset
);
1663 XVECTOR (info
)->contents
[5] = make_number (fontp
->relative_compose
);
1664 XVECTOR (info
)->contents
[6] = make_number (fontp
->default_ascent
);
1670 /* Return the font name for the character at POSITION in the current
1671 buffer. This is computed from all the text properties and overlays
1672 that apply to POSITION. It returns nil in the following cases:
1674 (1) The window system doesn't have a font for the character (thus
1675 it is displayed by an empty box).
1677 (2) The character code is invalid.
1679 (3) The current buffer is not displayed in any window.
1681 In addition, the returned font name may not take into account of
1682 such redisplay engine hooks as what used in jit-lock-mode if
1683 POSITION is currently not visible. */
1686 DEFUN ("internal-char-font", Finternal_char_font
, Sinternal_char_font
, 1, 1, 0,
1687 doc
: /* For internal use only. */)
1689 Lisp_Object position
;
1691 int pos
, pos_byte
, dummy
;
1698 Lisp_Object charset
, rfont_def
;
1701 CHECK_NUMBER_COERCE_MARKER (position
);
1702 pos
= XINT (position
);
1703 if (pos
< BEGV
|| pos
>= ZV
)
1704 args_out_of_range_3 (position
, make_number (BEGV
), make_number (ZV
));
1705 pos_byte
= CHAR_TO_BYTE (pos
);
1706 c
= FETCH_CHAR (pos_byte
);
1707 window
= Fget_buffer_window (Fcurrent_buffer (), Qnil
);
1710 w
= XWINDOW (window
);
1711 f
= XFRAME (w
->frame
);
1712 face_id
= face_at_buffer_position (w
, pos
, -1, -1, &dummy
, pos
+ 100, 0);
1713 face
= FACE_FROM_ID (f
, face_id
);
1714 charset
= Fget_char_property (position
, Qcharset
, Qnil
);
1715 if (CHARSETP (charset
))
1716 charset_id
= XINT (CHARSET_SYMBOL_ID (charset
));
1719 rfont_def
= fontset_font (FONTSET_FROM_ID (face
->fontset
),
1720 c
, face
, charset_id
);
1721 return (VECTORP (rfont_def
) && STRINGP (AREF (rfont_def
, 3))
1722 ? AREF (rfont_def
, 3)
1727 DEFUN ("fontset-info", Ffontset_info
, Sfontset_info
, 1, 2, 0,
1728 doc
: /* Return information about a fontset FONTSET on frame FRAME.
1729 The value is a char-table of which elements has this form.
1731 ((FONT-PATTERN OPENED-FONT ...) ...)
1733 FONT-PATTERN is a vector:
1735 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
1737 or a string of font name pattern.
1739 OPENED-FONT is a name of a font actually opened.
1741 The char-table has one extra slot. The value is a char-table
1742 containing the information about the derived fonts from the default
1743 fontset. The format is the same as abobe. */)
1745 Lisp_Object fontset
, frame
;
1748 Lisp_Object
*realized
[2], fontsets
[2], tables
[2];
1749 Lisp_Object val
, elt
;
1752 (*check_window_system_func
) ();
1754 fontset
= check_fontset_name (fontset
);
1757 frame
= selected_frame
;
1758 CHECK_LIVE_FRAME (frame
);
1761 /* Recode fontsets realized on FRAME from the base fontset FONTSET
1762 in the table `realized'. */
1763 realized
[0] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1764 * ASIZE (Vfontset_table
));
1765 for (i
= j
= 0; i
< ASIZE (Vfontset_table
); i
++)
1767 elt
= FONTSET_FROM_ID (i
);
1769 && EQ (FONTSET_BASE (elt
), fontset
)
1770 && EQ (FONTSET_FRAME (elt
), frame
))
1771 realized
[0][j
++] = elt
;
1773 realized
[0][j
] = Qnil
;
1775 realized
[1] = (Lisp_Object
*) alloca (sizeof (Lisp_Object
)
1776 * ASIZE (Vfontset_table
));
1777 for (i
= j
= 0; ! NILP (realized
[0][i
]); i
++)
1779 elt
= FONTSET_DEFAULT (realized
[0][i
]);
1781 realized
[1][j
++] = elt
;
1783 realized
[1][j
] = Qnil
;
1785 tables
[0] = Fmake_char_table (Qfontset_info
, Qnil
);
1786 tables
[1] = Fmake_char_table (Qnil
, Qnil
);
1787 XCHAR_TABLE (tables
[0])->extras
[0] = tables
[1];
1788 fontsets
[0] = fontset
;
1789 fontsets
[1] = Vdefault_fontset
;
1791 /* Accumulate information of the fontset in TABLE. The format of
1792 each element is ((FONT-SPEC OPENED-FONT ...) ...). */
1793 for (k
= 0; k
<= 1; k
++)
1795 for (c
= 0; c
<= MAX_CHAR
; )
1799 if (c
<= MAX_5_BYTE_CHAR
)
1801 val
= char_table_ref_and_range (fontsets
[k
], c
, &from
, &to
);
1802 if (to
> MAX_5_BYTE_CHAR
)
1803 to
= MAX_5_BYTE_CHAR
;
1807 val
= FONTSET_FALLBACK (fontsets
[k
]);
1814 /* At first, set ALIST to ((FONT-SPEC) ...). */
1815 for (alist
= Qnil
, i
= 0; i
< ASIZE (val
); i
++)
1816 alist
= Fcons (Fcons (AREF (AREF (val
, i
), 0), Qnil
), alist
);
1817 alist
= Fnreverse (alist
);
1819 /* Then store opend font names to cdr of each elements. */
1820 for (i
= 0; ! NILP (realized
[k
][i
]); i
++)
1822 if (c
<= MAX_5_BYTE_CHAR
)
1823 val
= FONTSET_REF (realized
[k
][i
], c
);
1825 val
= FONTSET_FALLBACK (realized
[k
][i
]);
1826 if (! VECTORP (val
))
1828 /* VAL is [int int ?
1829 [FACE-ID FONT-INDEX FONT-DEF FONT-NAME] ...].
1830 If a font of an element is already opened,
1831 FONT-NAME is the name of a opened font. */
1832 for (j
= 3; j
< ASIZE (val
); j
++)
1833 if (STRINGP (AREF (AREF (val
, j
), 3)))
1835 Lisp_Object font_idx
;
1837 font_idx
= AREF (AREF (val
, j
), 1);
1838 elt
= Fassq (AREF (AREF (AREF (val
, j
), 2), 0), alist
);
1840 && NILP (Fmemq (font_idx
, XCDR(elt
))))
1841 nconc2 (elt
, Fcons (font_idx
, Qnil
));
1844 for (val
= alist
; CONSP (val
); val
= XCDR (val
))
1845 for (elt
= XCDR (XCAR (val
)); CONSP (elt
); elt
= XCDR (elt
))
1847 struct font_info
*font_info
1848 = (*get_font_info_func
) (f
, XINT (XCAR (elt
)));
1849 XSETCAR (elt
, build_string (font_info
->full_name
));
1852 /* Store ALIST in TBL for characters C..TO. */
1853 if (c
<= MAX_5_BYTE_CHAR
)
1854 char_table_set_range (tables
[k
], c
, to
, alist
);
1856 XCHAR_TABLE (tables
[k
])->defalt
= alist
;
1866 DEFUN ("fontset-font", Ffontset_font
, Sfontset_font
, 2, 2, 0,
1867 doc
: /* Return a font name pattern for character CH in fontset NAME.
1868 If NAME is t, find a font name pattern in the default fontset. */)
1870 Lisp_Object name
, ch
;
1873 Lisp_Object fontset
, elt
;
1875 fontset
= check_fontset_name (name
);
1877 CHECK_CHARACTER (ch
);
1879 elt
= FONTSET_REF (fontset
, c
);
1880 return Fcopy_sequence (elt
);
1883 DEFUN ("fontset-list", Ffontset_list
, Sfontset_list
, 0, 0, 0,
1884 doc
: /* Return a list of all defined fontset names. */)
1887 Lisp_Object fontset
, list
;
1891 for (i
= 0; i
< ASIZE (Vfontset_table
); i
++)
1893 fontset
= FONTSET_FROM_ID (i
);
1895 && BASE_FONTSET_P (fontset
))
1896 list
= Fcons (FONTSET_NAME (fontset
), list
);
1903 #ifdef FONTSET_DEBUG
1906 dump_fontset (fontset
)
1907 Lisp_Object fontset
;
1911 vec
= Fmake_vector (make_number (3), Qnil
);
1912 ASET (vec
, 0, FONTSET_ID (fontset
));
1914 if (BASE_FONTSET_P (fontset
))
1916 ASET (vec
, 1, FONTSET_NAME (fontset
));
1922 frame
= FONTSET_FRAME (fontset
);
1925 FRAME_PTR f
= XFRAME (frame
);
1927 if (FRAME_LIVE_P (f
))
1928 ASET (vec
, 1, f
->name
);
1932 if (!NILP (FONTSET_DEFAULT (fontset
)))
1933 ASET (vec
, 2, FONTSET_ID (FONTSET_DEFAULT (fontset
)));
1938 DEFUN ("fontset-list-all", Ffontset_list_all
, Sfontset_list_all
, 0, 0, 0,
1939 doc
: /* Return a brief summary of all fontsets for debug use. */)
1945 for (i
= 0, val
= Qnil
; i
< ASIZE (Vfontset_table
); i
++)
1946 if (! NILP (AREF (Vfontset_table
, i
)))
1947 val
= Fcons (dump_fontset (AREF (Vfontset_table
, i
)), val
);
1948 return (Fnreverse (val
));
1950 #endif /* FONTSET_DEBUG */
1955 if (!load_font_func
)
1956 /* Window system initializer should have set proper functions. */
1959 DEFSYM (Qfontset
, "fontset");
1960 Fput (Qfontset
, Qchar_table_extra_slots
, make_number (9));
1961 DEFSYM (Qfontset_info
, "fontset-info");
1962 Fput (Qfontset_info
, Qchar_table_extra_slots
, make_number (1));
1964 DEFSYM (Qprepend
, "prepend");
1965 DEFSYM (Qappend
, "append");
1967 Vcached_fontset_data
= Qnil
;
1968 staticpro (&Vcached_fontset_data
);
1970 Vfontset_table
= Fmake_vector (make_number (32), Qnil
);
1971 staticpro (&Vfontset_table
);
1973 Vdefault_fontset
= Fmake_char_table (Qfontset
, Qnil
);
1974 staticpro (&Vdefault_fontset
);
1975 FONTSET_ID (Vdefault_fontset
) = make_number (0);
1976 FONTSET_NAME (Vdefault_fontset
)
1977 = build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default");
1979 Lisp_Object default_ascii_font
;
1981 #if defined (macintosh)
1983 = build_string ("-apple-monaco-medium-r-*--*-120-*-*-*-*-mac-roman");
1984 #elif defined (WINDOWSNT)
1986 = build_string ("-*-courier new-normal-r-*-*-*-100-*-*-*-*-iso8859-1");
1989 = build_string ("-adobe-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1");
1991 FONTSET_ASCII (Vdefault_fontset
) = default_ascii_font
;
1993 AREF (Vfontset_table
, 0) = Vdefault_fontset
;
1994 next_fontset_id
= 1;
1996 auto_fontset_alist
= Qnil
;
1997 staticpro (&auto_fontset_alist
);
1999 DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist
,
2001 Alist of fontname patterns vs the corresponding encoding and repertory info.
2002 Each element looks like (REGEXP . (ENCODING . REPERTORY)),
2003 where ENCODING is a charset or a char-table,
2004 and REPERTORY is a charset, a char-table, or nil.
2006 ENCODING is for converting a character to a glyph code of the font.
2007 If ENCODING is a charset, encoding a character by the charset gives
2008 the corresponding glyph code. If ENCODING is a char-table, looking up
2009 the table by a character gives the corresponding glyph code.
2011 REPERTORY specifies a repertory of characters supported by the font.
2012 If REPERTORY is a charset, all characters beloging to the charset are
2013 supported. If REPERTORY is a char-table, all characters who have a
2014 non-nil value in the table are supported. It REPERTORY is nil, Emacs
2015 gets the repertory information by an opened font and ENCODING. */);
2016 Vfont_encoding_alist
= Qnil
;
2018 DEFVAR_LISP ("use-default-ascent", &Vuse_default_ascent
,
2020 Char table of characters whose ascent values should be ignored.
2021 If an entry for a character is non-nil, the ascent value of the glyph
2022 is assumed to be what specified by _MULE_DEFAULT_ASCENT property of a font.
2024 This affects how a composite character which contains
2025 such a character is displayed on screen. */);
2026 Vuse_default_ascent
= Qnil
;
2028 DEFVAR_LISP ("ignore-relative-composition", &Vignore_relative_composition
,
2030 Char table of characters which is not composed relatively.
2031 If an entry for a character is non-nil, a composition sequence
2032 which contains that character is displayed so that
2033 the glyph of that character is put without considering
2034 an ascent and descent value of a previous character. */);
2035 Vignore_relative_composition
= Qnil
;
2037 DEFVAR_LISP ("alternate-fontname-alist", &Valternate_fontname_alist
,
2038 doc
: /* Alist of fontname vs list of the alternate fontnames.
2039 When a specified font name is not found, the corresponding
2040 alternate fontnames (if any) are tried instead. */);
2041 Valternate_fontname_alist
= Qnil
;
2043 DEFVAR_LISP ("fontset-alias-alist", &Vfontset_alias_alist
,
2044 doc
: /* Alist of fontset names vs the aliases. */);
2045 Vfontset_alias_alist
= Fcons (Fcons (FONTSET_NAME (Vdefault_fontset
),
2046 build_string ("fontset-default")),
2049 DEFVAR_LISP ("vertical-centering-font-regexp",
2050 &Vvertical_centering_font_regexp
,
2051 doc
: /* *Regexp matching font names that require vertical centering on display.
2052 When a character is displayed with such fonts, the character is displayed
2053 at the vertical center of lines. */);
2054 Vvertical_centering_font_regexp
= Qnil
;
2056 defsubr (&Squery_fontset
);
2057 defsubr (&Snew_fontset
);
2058 defsubr (&Sset_fontset_font
);
2059 defsubr (&Sfont_info
);
2060 defsubr (&Sinternal_char_font
);
2061 defsubr (&Sfontset_info
);
2062 defsubr (&Sfontset_font
);
2063 defsubr (&Sfontset_list
);
2064 #ifdef FONTSET_DEBUG
2065 defsubr (&Sfontset_list_all
);