1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
200 #include "keyboard.h"
203 #ifdef HAVE_WINDOW_SYSTEM
205 #endif /* HAVE_WINDOW_SYSTEM */
207 #ifdef HAVE_X_WINDOWS
211 #include <Xm/XmStrDefs.h>
212 #endif /* USE_MOTIF */
213 #endif /* HAVE_X_WINDOWS */
222 /* Redefine X specifics to W32 equivalents to avoid cluttering the
223 code with #ifdef blocks. */
224 #undef FRAME_X_DISPLAY_INFO
225 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
226 #define x_display_info w32_display_info
227 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
228 #define check_x check_w32
229 #define x_list_fonts w32_list_fonts
230 #define GCGraphicsExposures 0
231 /* For historic reasons, FONT_WIDTH refers to average width on W32,
232 not maximum as on X. Redefine here. */
234 #define FONT_WIDTH FONT_MAX_WIDTH
235 #endif /* WINDOWSNT */
239 #define x_display_info mac_display_info
240 #define check_x check_mac
244 #include "dispextern.h"
245 #include "blockinput.h"
247 #include "intervals.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
256 #ifdef XOS_NEEDS_TIME_H
262 #else /* not XOS_NEEDS_TIME_H */
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
271 #define abs(X) ((X) < 0 ? -(X) : (X))
273 /* Number of pt per inch (from the TeXbook). */
275 #define PT_PER_INCH 72.27
277 /* Non-zero if face attribute ATTR is unspecified. */
279 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
281 /* Value is the number of elements of VECTOR. */
283 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
285 /* Make a copy of string S on the stack using alloca. Value is a pointer
288 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
290 /* Make a copy of the contents of Lisp string S on the stack using
291 alloca. Value is a pointer to the copy. */
293 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
295 /* Size of hash table of realized faces in face caches (should be a
298 #define FACE_CACHE_BUCKETS_SIZE 1001
300 /* Keyword symbols used for face attribute names. */
302 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
303 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
304 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
305 Lisp_Object QCreverse_video
;
306 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
308 /* Symbols used for attribute values. */
310 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
311 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
312 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
313 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
314 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
315 Lisp_Object Qultra_expanded
;
316 Lisp_Object Qreleased_button
, Qpressed_button
;
317 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
318 Lisp_Object Qunspecified
;
320 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
322 /* The name of the function to call when the background of the frame
323 has changed, frame_update_face_colors. */
325 Lisp_Object Qframe_update_face_colors
;
327 /* Names of basic faces. */
329 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
330 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
331 Lisp_Object Qmode_line_inactive
;
332 extern Lisp_Object Qmode_line
;
334 /* The symbol `face-alias'. A symbols having that property is an
335 alias for another face. Value of the property is the name of
338 Lisp_Object Qface_alias
;
340 /* Names of frame parameters related to faces. */
342 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
343 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
345 /* Default stipple pattern used on monochrome displays. This stipple
346 pattern is used on monochrome displays instead of shades of gray
347 for a face background color. See `set-face-stipple' for possible
348 values for this variable. */
350 Lisp_Object Vface_default_stipple
;
352 /* Alist of alternative font families. Each element is of the form
353 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
354 try FAMILY1, then FAMILY2, ... */
356 Lisp_Object Vface_alternative_font_family_alist
;
358 /* Alist of alternative font registries. Each element is of the form
359 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
360 loaded, try REGISTRY1, then REGISTRY2, ... */
362 Lisp_Object Vface_alternative_font_registry_alist
;
364 /* Allowed scalable fonts. A value of nil means don't allow any
365 scalable fonts. A value of t means allow the use of any scalable
366 font. Otherwise, value must be a list of regular expressions. A
367 font may be scaled if its name matches a regular expression in the
370 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
372 /* List of regular expressions that matches names of fonts to ignore. */
374 Lisp_Object Vface_ignored_fonts
;
376 /* Maximum number of fonts to consider in font_list. If not an
377 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
379 Lisp_Object Vfont_list_limit
;
380 #define DEFAULT_FONT_LIST_LIMIT 100
382 /* The symbols `foreground-color' and `background-color' which can be
383 used as part of a `face' property. This is for compatibility with
386 Lisp_Object Qforeground_color
, Qbackground_color
;
388 /* The symbols `face' and `mouse-face' used as text properties. */
391 extern Lisp_Object Qmouse_face
;
393 /* Error symbol for wrong_type_argument in load_pixmap. */
395 Lisp_Object Qbitmap_spec_p
;
397 /* Alist of global face definitions. Each element is of the form
398 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
399 is a Lisp vector of face attributes. These faces are used
400 to initialize faces for new frames. */
402 Lisp_Object Vface_new_frame_defaults
;
404 /* The next ID to assign to Lisp faces. */
406 static int next_lface_id
;
408 /* A vector mapping Lisp face Id's to face names. */
410 static Lisp_Object
*lface_id_to_name
;
411 static int lface_id_to_name_size
;
413 /* TTY color-related functions (defined in tty-colors.el). */
415 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
417 /* The name of the function used to compute colors on TTYs. */
419 Lisp_Object Qtty_color_alist
;
421 /* An alist of defined terminal colors and their RGB values. */
423 Lisp_Object Vtty_defined_color_alist
;
425 /* Counter for calls to clear_face_cache. If this counter reaches
426 CLEAR_FONT_TABLE_COUNT, and a frame has more than
427 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
429 static int clear_font_table_count
;
430 #define CLEAR_FONT_TABLE_COUNT 100
431 #define CLEAR_FONT_TABLE_NFONTS 10
433 /* Non-zero means face attributes have been changed since the last
434 redisplay. Used in redisplay_internal. */
436 int face_change_count
;
438 /* Non-zero means don't display bold text if a face's foreground
439 and background colors are the inverse of the default colors of the
440 display. This is a kluge to suppress `bold black' foreground text
441 which is hard to read on an LCD monitor. */
443 int tty_suppress_bold_inverse_default_colors_p
;
445 /* A list of the form `((x . y))' used to avoid consing in
446 Finternal_set_lisp_face_attribute. */
448 static Lisp_Object Vparam_value_alist
;
450 /* The total number of colors currently allocated. */
453 static int ncolors_allocated
;
454 static int npixmaps_allocated
;
458 /* Non-zero means the definition of the `menu' face for new frames has
461 int menu_face_changed_default
;
464 /* Function prototypes. */
469 static void map_tty_color
P_ ((struct frame
*, struct face
*,
470 enum lface_attribute_index
, int *));
471 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
472 static int may_use_scalable_font_p
P_ ((const char *));
473 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
474 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
476 static int x_face_list_fonts
P_ ((struct frame
*, char *,
477 struct font_name
**, int, int));
478 static int font_scalable_p
P_ ((struct font_name
*));
479 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
480 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
481 static unsigned char *xstrlwr
P_ ((unsigned char *));
482 static void signal_error
P_ ((char *, Lisp_Object
));
483 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
484 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
485 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
486 static void free_face_colors
P_ ((struct frame
*, struct face
*));
487 static int face_color_gray_p
P_ ((struct frame
*, char *));
488 static char *build_font_name
P_ ((struct font_name
*));
489 static void free_font_names
P_ ((struct font_name
*, int));
490 static int sorted_font_list
P_ ((struct frame
*, char *,
491 int (*cmpfn
) P_ ((const void *, const void *)),
492 struct font_name
**));
493 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
494 Lisp_Object
, struct font_name
**));
495 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
496 Lisp_Object
, struct font_name
**));
497 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
498 Lisp_Object
, Lisp_Object
, struct font_name
**,
500 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
501 Lisp_Object
, struct font_name
**));
502 static int cmp_font_names
P_ ((const void *, const void *));
503 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
504 struct face
*, int));
505 static struct face
*realize_x_face
P_ ((struct face_cache
*,
506 Lisp_Object
*, int, struct face
*));
507 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
508 Lisp_Object
*, int));
509 static int realize_basic_faces
P_ ((struct frame
*));
510 static int realize_default_face
P_ ((struct frame
*));
511 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
512 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
513 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
514 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
515 static unsigned lface_hash
P_ ((Lisp_Object
*));
516 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
517 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
518 static void free_realized_face
P_ ((struct frame
*, struct face
*));
519 static void clear_face_gcs
P_ ((struct face_cache
*));
520 static void free_face_cache
P_ ((struct face_cache
*));
521 static int face_numeric_weight
P_ ((Lisp_Object
));
522 static int face_numeric_slant
P_ ((Lisp_Object
));
523 static int face_numeric_swidth
P_ ((Lisp_Object
));
524 static int face_fontset
P_ ((Lisp_Object
*));
525 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int, int*));
526 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
527 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
528 Lisp_Object
*, Lisp_Object
));
529 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
531 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
532 Lisp_Object
, int, int));
533 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
534 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
535 static void free_realized_faces
P_ ((struct face_cache
*));
536 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
537 struct font_name
*, int, int, int *));
538 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
539 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
540 static int xlfd_numeric_slant
P_ ((struct font_name
*));
541 static int xlfd_numeric_weight
P_ ((struct font_name
*));
542 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
543 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
544 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
545 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
546 static int xlfd_fixed_p
P_ ((struct font_name
*));
547 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
549 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
550 struct font_name
*, int,
552 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
553 struct font_name
*, int));
555 #ifdef HAVE_WINDOW_SYSTEM
557 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
558 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
559 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
560 int (*cmpfn
) P_ ((const void *, const void *))));
561 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
562 static void x_free_gc
P_ ((struct frame
*, GC
));
563 static void clear_font_table
P_ ((struct x_display_info
*));
566 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
567 #endif /* WINDOWSNT */
570 static void x_update_menu_appearance
P_ ((struct frame
*));
572 extern void free_frame_menubar
P_ ((struct frame
*));
573 #endif /* USE_X_TOOLKIT */
575 #endif /* HAVE_WINDOW_SYSTEM */
578 /***********************************************************************
580 ***********************************************************************/
582 #ifdef HAVE_X_WINDOWS
584 #ifdef DEBUG_X_COLORS
586 /* The following is a poor mans infrastructure for debugging X color
587 allocation problems on displays with PseudoColor-8. Some X servers
588 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
589 color reference counts completely so that they don't signal an
590 error when a color is freed whose reference count is already 0.
591 Other X servers do. To help me debug this, the following code
592 implements a simple reference counting schema of its own, for a
593 single display/screen. --gerd. */
595 /* Reference counts for pixel colors. */
597 int color_count
[256];
599 /* Register color PIXEL as allocated. */
602 register_color (pixel
)
605 xassert (pixel
< 256);
606 ++color_count
[pixel
];
610 /* Register color PIXEL as deallocated. */
613 unregister_color (pixel
)
616 xassert (pixel
< 256);
617 if (color_count
[pixel
] > 0)
618 --color_count
[pixel
];
624 /* Register N colors from PIXELS as deallocated. */
627 unregister_colors (pixels
, n
)
628 unsigned long *pixels
;
632 for (i
= 0; i
< n
; ++i
)
633 unregister_color (pixels
[i
]);
637 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
638 doc
: /* Dump currently allocated colors to stderr. */)
643 fputc ('\n', stderr
);
645 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
648 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
651 fputc ('\n', stderr
);
653 fputc ('\t', stderr
);
657 fputc ('\n', stderr
);
661 #endif /* DEBUG_X_COLORS */
664 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
665 color values. Interrupt input must be blocked when this function
669 x_free_colors (f
, pixels
, npixels
)
671 unsigned long *pixels
;
674 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
676 /* If display has an immutable color map, freeing colors is not
677 necessary and some servers don't allow it. So don't do it. */
678 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
680 #ifdef DEBUG_X_COLORS
681 unregister_colors (pixels
, npixels
);
683 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
689 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
690 color values. Interrupt input must be blocked when this function
694 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
698 unsigned long *pixels
;
701 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
702 int class = dpyinfo
->visual
->class;
704 /* If display has an immutable color map, freeing colors is not
705 necessary and some servers don't allow it. So don't do it. */
706 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
708 #ifdef DEBUG_X_COLORS
709 unregister_colors (pixels
, npixels
);
711 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
716 /* Create and return a GC for use on frame F. GC values and mask
717 are given by XGCV and MASK. */
720 x_create_gc (f
, mask
, xgcv
)
727 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
734 /* Free GC which was used on frame F. */
742 xassert (--ngcs
>= 0);
743 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
747 #endif /* HAVE_X_WINDOWS */
750 /* W32 emulation of GCs */
753 x_create_gc (f
, mask
, xgcv
)
760 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
767 /* Free GC which was used on frame F. */
775 xassert (--ngcs
>= 0);
780 #endif /* WINDOWSNT */
783 /* Mac OS emulation of GCs */
785 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
788 x_create_gc (f
, mask
, xgcv
)
794 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
803 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
808 /* Like stricmp. Used to compare parts of font names which are in
813 const unsigned char *s1
, *s2
;
817 unsigned char c1
= tolower (*s1
);
818 unsigned char c2
= tolower (*s2
);
820 return c1
< c2
? -1 : 1;
825 return *s2
== 0 ? 0 : -1;
830 /* Like strlwr, which might not always be available. */
832 static unsigned char *
836 unsigned char *p
= s
;
845 /* Signal `error' with message S, and additional argument ARG. */
848 signal_error (s
, arg
)
852 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
856 /* If FRAME is nil, return a pointer to the selected frame.
857 Otherwise, check that FRAME is a live frame, and return a pointer
858 to it. NPARAM is the parameter number of FRAME, for
859 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
860 Lisp function definitions. */
862 static INLINE
struct frame
*
863 frame_or_selected_frame (frame
, nparam
)
868 frame
= selected_frame
;
870 CHECK_LIVE_FRAME (frame
);
871 return XFRAME (frame
);
875 /***********************************************************************
877 ***********************************************************************/
879 /* Initialize face cache and basic faces for frame F. */
885 /* Make a face cache, if F doesn't have one. */
886 if (FRAME_FACE_CACHE (f
) == NULL
)
887 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
889 #ifdef HAVE_WINDOW_SYSTEM
890 /* Make the image cache. */
891 if (FRAME_WINDOW_P (f
))
893 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
894 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
895 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
897 #endif /* HAVE_WINDOW_SYSTEM */
899 /* Realize basic faces. Must have enough information in frame
900 parameters to realize basic faces at this point. */
901 #ifdef HAVE_X_WINDOWS
902 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
905 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
908 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
910 if (!realize_basic_faces (f
))
915 /* Free face cache of frame F. Called from Fdelete_frame. */
921 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
925 free_face_cache (face_cache
);
926 FRAME_FACE_CACHE (f
) = NULL
;
929 #ifdef HAVE_WINDOW_SYSTEM
930 if (FRAME_WINDOW_P (f
))
932 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
935 --image_cache
->refcount
;
936 if (image_cache
->refcount
== 0)
937 free_image_cache (f
);
940 #endif /* HAVE_WINDOW_SYSTEM */
944 /* Clear face caches, and recompute basic faces for frame F. Call
945 this after changing frame parameters on which those faces depend,
946 or when realized faces have been freed due to changing attributes
950 recompute_basic_faces (f
)
953 if (FRAME_FACE_CACHE (f
))
955 clear_face_cache (0);
956 if (!realize_basic_faces (f
))
962 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
963 try to free unused fonts, too. */
966 clear_face_cache (clear_fonts_p
)
969 #ifdef HAVE_WINDOW_SYSTEM
970 Lisp_Object tail
, frame
;
974 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
976 struct x_display_info
*dpyinfo
;
978 /* Fonts are common for frames on one display, i.e. on
980 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
981 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
982 clear_font_table (dpyinfo
);
984 /* From time to time see if we can unload some fonts. This also
985 frees all realized faces on all frames. Fonts needed by
986 faces will be loaded again when faces are realized again. */
987 clear_font_table_count
= 0;
989 FOR_EACH_FRAME (tail
, frame
)
991 struct frame
*f
= XFRAME (frame
);
992 if (FRAME_WINDOW_P (f
)
993 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
994 free_all_realized_faces (frame
);
999 /* Clear GCs of realized faces. */
1000 FOR_EACH_FRAME (tail
, frame
)
1003 if (FRAME_WINDOW_P (f
))
1005 clear_face_gcs (FRAME_FACE_CACHE (f
));
1006 clear_image_cache (f
, 0);
1010 #endif /* HAVE_WINDOW_SYSTEM */
1014 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1015 doc
: /* Clear face caches on all frames.
1016 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1018 Lisp_Object thoroughly
;
1020 clear_face_cache (!NILP (thoroughly
));
1021 ++face_change_count
;
1022 ++windows_or_buffers_changed
;
1028 #ifdef HAVE_WINDOW_SYSTEM
1031 /* Remove fonts from the font table of DPYINFO except for the default
1032 ASCII fonts of frames on that display. Called from clear_face_cache
1033 from time to time. */
1036 clear_font_table (dpyinfo
)
1037 struct x_display_info
*dpyinfo
;
1041 /* Free those fonts that are not used by frames on DPYINFO. */
1042 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1044 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1045 Lisp_Object tail
, frame
;
1047 /* Check if slot is already free. */
1048 if (font_info
->name
== NULL
)
1051 /* Don't free a default font of some frame. */
1052 FOR_EACH_FRAME (tail
, frame
)
1054 struct frame
*f
= XFRAME (frame
);
1055 if (FRAME_WINDOW_P (f
)
1056 && font_info
->font
== FRAME_FONT (f
))
1064 if (font_info
->full_name
!= font_info
->name
)
1065 xfree (font_info
->full_name
);
1066 xfree (font_info
->name
);
1068 /* Free the font. */
1070 #ifdef HAVE_X_WINDOWS
1071 XFreeFont (dpyinfo
->display
, font_info
->font
);
1074 w32_unload_font (dpyinfo
, font_info
->font
);
1078 /* Mark font table slot free. */
1079 font_info
->font
= NULL
;
1080 font_info
->name
= font_info
->full_name
= NULL
;
1084 #endif /* HAVE_WINDOW_SYSTEM */
1088 /***********************************************************************
1090 ***********************************************************************/
1092 #ifdef HAVE_WINDOW_SYSTEM
1094 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1095 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1096 A bitmap specification is either a string, a file name, or a list
1097 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1098 HEIGHT is its height, and DATA is a string containing the bits of
1099 the pixmap. Bits are stored row by row, each row occupies
1100 \(WIDTH + 7)/8 bytes. */)
1106 if (STRINGP (object
))
1107 /* If OBJECT is a string, it's a file name. */
1109 else if (CONSP (object
))
1111 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1112 HEIGHT must be integers > 0, and DATA must be string large
1113 enough to hold a bitmap of the specified size. */
1114 Lisp_Object width
, height
, data
;
1116 height
= width
= data
= Qnil
;
1120 width
= XCAR (object
);
1121 object
= XCDR (object
);
1124 height
= XCAR (object
);
1125 object
= XCDR (object
);
1127 data
= XCAR (object
);
1131 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1133 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1135 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1140 return pixmap_p
? Qt
: Qnil
;
1144 /* Load a bitmap according to NAME (which is either a file name or a
1145 pixmap spec) for use on frame F. Value is the bitmap_id (see
1146 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1147 bitmap cannot be loaded, display a message saying so, and return
1148 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1149 if these pointers are not null. */
1152 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1155 unsigned int *w_ptr
, *h_ptr
;
1163 tem
= Fbitmap_spec_p (name
);
1165 wrong_type_argument (Qbitmap_spec_p
, name
);
1170 /* Decode a bitmap spec into a bitmap. */
1175 w
= XINT (Fcar (name
));
1176 h
= XINT (Fcar (Fcdr (name
)));
1177 bits
= Fcar (Fcdr (Fcdr (name
)));
1179 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1184 /* It must be a string -- a file name. */
1185 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1191 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1202 ++npixmaps_allocated
;
1205 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1208 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1214 #endif /* HAVE_WINDOW_SYSTEM */
1218 /***********************************************************************
1220 ***********************************************************************/
1222 #ifdef HAVE_WINDOW_SYSTEM
1224 /* Update the line_height of frame F. Return non-zero if line height
1228 frame_update_line_height (f
)
1231 int line_height
, changed_p
;
1233 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1234 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1235 FRAME_LINE_HEIGHT (f
) = line_height
;
1239 #endif /* HAVE_WINDOW_SYSTEM */
1242 /***********************************************************************
1244 ***********************************************************************/
1246 #ifdef HAVE_WINDOW_SYSTEM
1248 /* Load font of face FACE which is used on frame F to display
1249 character C. The name of the font to load is determined by lface
1250 and fontset of FACE. */
1253 load_face_font (f
, face
, c
)
1258 struct font_info
*font_info
= NULL
;
1260 int needs_overstrike
;
1262 face
->font_info_id
= -1;
1265 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
,
1271 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1276 face
->font_info_id
= font_info
->font_idx
;
1277 face
->font
= font_info
->font
;
1278 face
->font_name
= font_info
->full_name
;
1279 face
->overstrike
= needs_overstrike
;
1282 x_free_gc (f
, face
->gc
);
1287 add_to_log ("Unable to load font %s",
1288 build_string (font_name
), Qnil
);
1292 #endif /* HAVE_WINDOW_SYSTEM */
1296 /***********************************************************************
1298 ***********************************************************************/
1300 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1301 RGB_LIST should contain (at least) 3 lisp integers.
1302 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1305 parse_rgb_list (rgb_list
, color
)
1306 Lisp_Object rgb_list
;
1309 #define PARSE_RGB_LIST_FIELD(field) \
1310 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1312 color->field = XINT (XCAR (rgb_list)); \
1313 rgb_list = XCDR (rgb_list); \
1318 PARSE_RGB_LIST_FIELD (red
);
1319 PARSE_RGB_LIST_FIELD (green
);
1320 PARSE_RGB_LIST_FIELD (blue
);
1326 /* Lookup on frame F the color described by the lisp string COLOR.
1327 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1328 non-zero, then the `standard' definition of the same color is
1332 tty_lookup_color (f
, color
, tty_color
, std_color
)
1335 XColor
*tty_color
, *std_color
;
1337 Lisp_Object frame
, color_desc
;
1339 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1342 XSETFRAME (frame
, f
);
1344 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1345 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1349 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1352 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1354 rgb
= XCDR (XCDR (color_desc
));
1355 if (! parse_rgb_list (rgb
, tty_color
))
1358 /* Should we fill in STD_COLOR too? */
1361 /* Default STD_COLOR to the same as TTY_COLOR. */
1362 *std_color
= *tty_color
;
1364 /* Do a quick check to see if the returned descriptor is
1365 actually _exactly_ equal to COLOR, otherwise we have to
1366 lookup STD_COLOR separately. If it's impossible to lookup
1367 a standard color, we just give up and use TTY_COLOR. */
1368 if ((!STRINGP (XCAR (color_desc
))
1369 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1370 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1372 /* Look up STD_COLOR separately. */
1373 rgb
= call1 (Qtty_color_standard_values
, color
);
1374 if (! parse_rgb_list (rgb
, std_color
))
1381 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1382 /* We were called early during startup, and the colors are not
1383 yet set up in tty-defined-color-alist. Don't return a failure
1384 indication, since this produces the annoying "Unable to
1385 load color" messages in the *Messages* buffer. */
1388 /* tty-color-desc seems to have returned a bad value. */
1392 /* A version of defined_color for non-X frames. */
1395 tty_defined_color (f
, color_name
, color_def
, alloc
)
1404 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1406 color_def
->blue
= 0;
1407 color_def
->green
= 0;
1410 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, 0);
1412 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1414 if (strcmp (color_name
, "unspecified-fg") == 0)
1415 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1416 else if (strcmp (color_name
, "unspecified-bg") == 0)
1417 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1420 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1427 /* Decide if color named COLOR_NAME is valid for the display
1428 associated with the frame F; if so, return the rgb values in
1429 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1431 This does the right thing for any type of frame. */
1434 defined_color (f
, color_name
, color_def
, alloc
)
1440 if (!FRAME_WINDOW_P (f
))
1441 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1442 #ifdef HAVE_X_WINDOWS
1443 else if (FRAME_X_P (f
))
1444 return x_defined_color (f
, color_name
, color_def
, alloc
);
1447 else if (FRAME_W32_P (f
))
1448 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1451 else if (FRAME_MAC_P (f
))
1452 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1459 /* Given the index IDX of a tty color on frame F, return its name, a
1463 tty_color_name (f
, idx
)
1467 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1470 Lisp_Object coldesc
;
1472 XSETFRAME (frame
, f
);
1473 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1475 if (!NILP (coldesc
))
1476 return XCAR (coldesc
);
1479 /* We can have an MSDOG frame under -nw for a short window of
1480 opportunity before internal_terminal_init is called. DTRT. */
1481 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1482 return msdos_stdcolor_name (idx
);
1485 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1486 return build_string (unspecified_fg
);
1487 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1488 return build_string (unspecified_bg
);
1491 return vga_stdcolor_name (idx
);
1494 return Qunspecified
;
1498 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1499 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1502 face_color_gray_p (f
, color_name
)
1509 if (defined_color (f
, color_name
, &color
, 0))
1510 gray_p
= ((abs (color
.red
- color
.green
)
1511 < max (color
.red
, color
.green
) / 20)
1512 && (abs (color
.green
- color
.blue
)
1513 < max (color
.green
, color
.blue
) / 20)
1514 && (abs (color
.blue
- color
.red
)
1515 < max (color
.blue
, color
.red
) / 20));
1523 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1524 BACKGROUND_P non-zero means the color will be used as background
1528 face_color_supported_p (f
, color_name
, background_p
)
1536 XSETFRAME (frame
, f
);
1537 return (FRAME_WINDOW_P (f
)
1538 ? (!NILP (Fxw_display_color_p (frame
))
1539 || xstricmp (color_name
, "black") == 0
1540 || xstricmp (color_name
, "white") == 0
1542 && face_color_gray_p (f
, color_name
))
1543 || (!NILP (Fx_display_grayscale_p (frame
))
1544 && face_color_gray_p (f
, color_name
)))
1545 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1549 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1550 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1551 FRAME specifies the frame and thus the display for interpreting COLOR.
1552 If FRAME is nil or omitted, use the selected frame. */)
1554 Lisp_Object color
, frame
;
1558 CHECK_FRAME (frame
);
1559 CHECK_STRING (color
);
1561 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1565 DEFUN ("color-supported-p", Fcolor_supported_p
,
1566 Scolor_supported_p
, 1, 3, 0,
1567 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1568 BACKGROUND-P non-nil means COLOR is used as a background.
1569 If FRAME is nil or omitted, use the selected frame.
1570 COLOR must be a valid color name. */)
1571 (color
, frame
, background_p
)
1572 Lisp_Object frame
, color
, background_p
;
1576 CHECK_FRAME (frame
);
1577 CHECK_STRING (color
);
1579 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1585 /* Load color with name NAME for use by face FACE on frame F.
1586 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1587 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1588 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1589 pixel color. If color cannot be loaded, display a message, and
1590 return the foreground, background or underline color of F, but
1591 record that fact in flags of the face so that we don't try to free
1595 load_color (f
, face
, name
, target_index
)
1599 enum lface_attribute_index target_index
;
1603 xassert (STRINGP (name
));
1604 xassert (target_index
== LFACE_FOREGROUND_INDEX
1605 || target_index
== LFACE_BACKGROUND_INDEX
1606 || target_index
== LFACE_UNDERLINE_INDEX
1607 || target_index
== LFACE_OVERLINE_INDEX
1608 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1609 || target_index
== LFACE_BOX_INDEX
);
1611 /* if the color map is full, defined_color will return a best match
1612 to the values in an existing cell. */
1613 if (!defined_color (f
, SDATA (name
), &color
, 1))
1615 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1617 switch (target_index
)
1619 case LFACE_FOREGROUND_INDEX
:
1620 face
->foreground_defaulted_p
= 1;
1621 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1624 case LFACE_BACKGROUND_INDEX
:
1625 face
->background_defaulted_p
= 1;
1626 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1629 case LFACE_UNDERLINE_INDEX
:
1630 face
->underline_defaulted_p
= 1;
1631 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1634 case LFACE_OVERLINE_INDEX
:
1635 face
->overline_color_defaulted_p
= 1;
1636 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1639 case LFACE_STRIKE_THROUGH_INDEX
:
1640 face
->strike_through_color_defaulted_p
= 1;
1641 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1644 case LFACE_BOX_INDEX
:
1645 face
->box_color_defaulted_p
= 1;
1646 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1655 ++ncolors_allocated
;
1662 #ifdef HAVE_WINDOW_SYSTEM
1664 /* Load colors for face FACE which is used on frame F. Colors are
1665 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1666 of ATTRS. If the background color specified is not supported on F,
1667 try to emulate gray colors with a stipple from Vface_default_stipple. */
1670 load_face_colors (f
, face
, attrs
)
1677 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1678 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1680 /* Swap colors if face is inverse-video. */
1681 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1689 /* Check for support for foreground, not for background because
1690 face_color_supported_p is smart enough to know that grays are
1691 "supported" as background because we are supposed to use stipple
1693 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1694 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1696 x_destroy_bitmap (f
, face
->stipple
);
1697 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1698 &face
->pixmap_w
, &face
->pixmap_h
);
1701 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1702 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1706 /* Free color PIXEL on frame F. */
1709 unload_color (f
, pixel
)
1711 unsigned long pixel
;
1713 #ifdef HAVE_X_WINDOWS
1717 x_free_colors (f
, &pixel
, 1);
1724 /* Free colors allocated for FACE. */
1727 free_face_colors (f
, face
)
1731 #ifdef HAVE_X_WINDOWS
1732 if (face
->colors_copied_bitwise_p
)
1737 if (!face
->foreground_defaulted_p
)
1739 x_free_colors (f
, &face
->foreground
, 1);
1740 IF_DEBUG (--ncolors_allocated
);
1743 if (!face
->background_defaulted_p
)
1745 x_free_colors (f
, &face
->background
, 1);
1746 IF_DEBUG (--ncolors_allocated
);
1749 if (face
->underline_p
1750 && !face
->underline_defaulted_p
)
1752 x_free_colors (f
, &face
->underline_color
, 1);
1753 IF_DEBUG (--ncolors_allocated
);
1756 if (face
->overline_p
1757 && !face
->overline_color_defaulted_p
)
1759 x_free_colors (f
, &face
->overline_color
, 1);
1760 IF_DEBUG (--ncolors_allocated
);
1763 if (face
->strike_through_p
1764 && !face
->strike_through_color_defaulted_p
)
1766 x_free_colors (f
, &face
->strike_through_color
, 1);
1767 IF_DEBUG (--ncolors_allocated
);
1770 if (face
->box
!= FACE_NO_BOX
1771 && !face
->box_color_defaulted_p
)
1773 x_free_colors (f
, &face
->box_color
, 1);
1774 IF_DEBUG (--ncolors_allocated
);
1778 #endif /* HAVE_X_WINDOWS */
1781 #endif /* HAVE_WINDOW_SYSTEM */
1785 /***********************************************************************
1787 ***********************************************************************/
1789 /* An enumerator for each field of an XLFD font name. */
1810 /* An enumerator for each possible slant value of a font. Taken from
1811 the XLFD specification. */
1819 XLFD_SLANT_REVERSE_ITALIC
,
1820 XLFD_SLANT_REVERSE_OBLIQUE
,
1824 /* Relative font weight according to XLFD documentation. */
1828 XLFD_WEIGHT_UNKNOWN
,
1829 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1830 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1831 XLFD_WEIGHT_LIGHT
, /* 30 */
1832 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1833 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1834 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1835 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1836 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1837 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1840 /* Relative proportionate width. */
1844 XLFD_SWIDTH_UNKNOWN
,
1845 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1846 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1847 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1848 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1849 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1850 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1851 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1852 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1853 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1856 /* Structure used for tables mapping XLFD weight, slant, and width
1857 names to numeric and symbolic values. */
1863 Lisp_Object
*symbol
;
1866 /* Table of XLFD slant names and their numeric and symbolic
1867 representations. This table must be sorted by slant names in
1870 static struct table_entry slant_table
[] =
1872 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1873 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1874 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1875 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1876 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1877 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1880 /* Table of XLFD weight names. This table must be sorted by weight
1881 names in ascending order. */
1883 static struct table_entry weight_table
[] =
1885 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1886 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1887 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1888 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1889 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1890 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1891 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1892 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1893 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1894 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1895 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1896 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1897 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1898 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1899 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1900 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1903 /* Table of XLFD width names. This table must be sorted by width
1904 names in ascending order. */
1906 static struct table_entry swidth_table
[] =
1908 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1909 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1910 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1911 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1912 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1913 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1914 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1915 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1916 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1917 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1918 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1919 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1920 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1921 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1922 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1925 /* Structure used to hold the result of splitting font names in XLFD
1926 format into their fields. */
1930 /* The original name which is modified destructively by
1931 split_font_name. The pointer is kept here to be able to free it
1932 if it was allocated from the heap. */
1935 /* Font name fields. Each vector element points into `name' above.
1936 Fields are NUL-terminated. */
1937 char *fields
[XLFD_LAST
];
1939 /* Numeric values for those fields that interest us. See
1940 split_font_name for which these are. */
1941 int numeric
[XLFD_LAST
];
1943 /* Lower value mean higher priority. */
1944 int registry_priority
;
1947 /* The frame in effect when sorting font names. Set temporarily in
1948 sort_fonts so that it is available in font comparison functions. */
1950 static struct frame
*font_frame
;
1952 /* Order by which font selection chooses fonts. The default values
1953 mean `first, find a best match for the font width, then for the
1954 font height, then for weight, then for slant.' This variable can be
1955 set via set-face-font-sort-order. */
1958 static int font_sort_order
[4] = {
1959 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1962 static int font_sort_order
[4];
1965 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1966 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1967 is a pointer to the matching table entry or null if no table entry
1970 static struct table_entry
*
1971 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1972 struct table_entry
*table
;
1974 struct font_name
*font
;
1977 /* Function split_font_name converts fields to lower-case, so there
1978 is no need to use xstrlwr or xstricmp here. */
1979 char *s
= font
->fields
[field_index
];
1980 int low
, mid
, high
, cmp
;
1987 mid
= (low
+ high
) / 2;
1988 cmp
= strcmp (table
[mid
].name
, s
);
2002 /* Return a numeric representation for font name field
2003 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2004 has DIM entries. Value is the numeric value found or DFLT if no
2005 table entry matches. This function is used to translate weight,
2006 slant, and swidth names of XLFD font names to numeric values. */
2009 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
2010 struct table_entry
*table
;
2012 struct font_name
*font
;
2016 struct table_entry
*p
;
2017 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2018 return p
? p
->numeric
: dflt
;
2022 /* Return a symbolic representation for font name field
2023 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2024 has DIM entries. Value is the symbolic value found or DFLT if no
2025 table entry matches. This function is used to translate weight,
2026 slant, and swidth names of XLFD font names to symbols. */
2028 static INLINE Lisp_Object
2029 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2030 struct table_entry
*table
;
2032 struct font_name
*font
;
2036 struct table_entry
*p
;
2037 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2038 return p
? *p
->symbol
: dflt
;
2042 /* Return a numeric value for the slant of the font given by FONT. */
2045 xlfd_numeric_slant (font
)
2046 struct font_name
*font
;
2048 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2049 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2053 /* Return a symbol representing the weight of the font given by FONT. */
2055 static INLINE Lisp_Object
2056 xlfd_symbolic_slant (font
)
2057 struct font_name
*font
;
2059 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2060 font
, XLFD_SLANT
, Qnormal
);
2064 /* Return a numeric value for the weight of the font given by FONT. */
2067 xlfd_numeric_weight (font
)
2068 struct font_name
*font
;
2070 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2071 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2075 /* Return a symbol representing the slant of the font given by FONT. */
2077 static INLINE Lisp_Object
2078 xlfd_symbolic_weight (font
)
2079 struct font_name
*font
;
2081 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2082 font
, XLFD_WEIGHT
, Qnormal
);
2086 /* Return a numeric value for the swidth of the font whose XLFD font
2087 name fields are found in FONT. */
2090 xlfd_numeric_swidth (font
)
2091 struct font_name
*font
;
2093 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2094 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2098 /* Return a symbolic value for the swidth of FONT. */
2100 static INLINE Lisp_Object
2101 xlfd_symbolic_swidth (font
)
2102 struct font_name
*font
;
2104 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2105 font
, XLFD_SWIDTH
, Qnormal
);
2109 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2110 entries. Value is a pointer to the matching table entry or null if
2111 no element of TABLE contains SYMBOL. */
2113 static struct table_entry
*
2114 face_value (table
, dim
, symbol
)
2115 struct table_entry
*table
;
2121 xassert (SYMBOLP (symbol
));
2123 for (i
= 0; i
< dim
; ++i
)
2124 if (EQ (*table
[i
].symbol
, symbol
))
2127 return i
< dim
? table
+ i
: NULL
;
2131 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2132 entries. Value is -1 if SYMBOL is not found in TABLE. */
2135 face_numeric_value (table
, dim
, symbol
)
2136 struct table_entry
*table
;
2140 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2141 return p
? p
->numeric
: -1;
2145 /* Return a numeric value representing the weight specified by Lisp
2146 symbol WEIGHT. Value is one of the enumerators of enum
2150 face_numeric_weight (weight
)
2153 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2157 /* Return a numeric value representing the slant specified by Lisp
2158 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2161 face_numeric_slant (slant
)
2164 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2168 /* Return a numeric value representing the swidth specified by Lisp
2169 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2172 face_numeric_swidth (width
)
2175 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2179 #ifdef HAVE_WINDOW_SYSTEM
2181 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2185 struct font_name
*font
;
2187 /* Function split_font_name converts fields to lower-case, so there
2188 is no need to use tolower here. */
2189 return *font
->fields
[XLFD_SPACING
] != 'p';
2193 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2195 The actual height of the font when displayed on F depends on the
2196 resolution of both the font and frame. For example, a 10pt font
2197 designed for a 100dpi display will display larger than 10pt on a
2198 75dpi display. (It's not unusual to use fonts not designed for the
2199 display one is using. For example, some intlfonts are available in
2200 72dpi versions, only.)
2202 Value is the real point size of FONT on frame F, or 0 if it cannot
2206 xlfd_point_size (f
, font
)
2208 struct font_name
*font
;
2210 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2211 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2215 if (*pixel_field
== '[')
2217 /* The pixel size field is `[A B C D]' which specifies
2218 a transformation matrix.
2224 by which all glyphs of the font are transformed. The spec
2225 says that s scalar value N for the pixel size is equivalent
2226 to A = N * resx/resy, B = C = 0, D = N. */
2227 char *start
= pixel_field
+ 1, *end
;
2231 for (i
= 0; i
< 4; ++i
)
2233 matrix
[i
] = strtod (start
, &end
);
2240 pixel
= atoi (pixel_field
);
2245 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2251 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2252 of frame F. This function is used to guess a point size of font
2253 when only the pixel height of the font is available. */
2256 pixel_point_size (f
, pixel
)
2260 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2264 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2265 point size of one dot. */
2266 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2267 int_pt
= real_pt
+ 0.5;
2273 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2274 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2275 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2276 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2277 zero if the font name doesn't have the format we expect. The
2278 expected format is a font name that starts with a `-' and has
2279 XLFD_LAST fields separated by `-'. */
2282 split_font_name (f
, font
, numeric_p
)
2284 struct font_name
*font
;
2290 if (*font
->name
== '-')
2292 char *p
= xstrlwr (font
->name
) + 1;
2294 while (i
< XLFD_LAST
)
2296 font
->fields
[i
] = p
;
2299 /* Pixel and point size may be of the form `[....]'. For
2300 BNF, see XLFD spec, chapter 4. Negative values are
2301 indicated by tilde characters which we replace with
2302 `-' characters, here. */
2304 && (i
- 1 == XLFD_PIXEL_SIZE
2305 || i
- 1 == XLFD_POINT_SIZE
))
2310 for (++p
; *p
&& *p
!= ']'; ++p
)
2314 /* Check that the matrix contains 4 floating point
2316 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2319 if (strtod (start
, &end
) == 0 && start
== end
)
2326 while (*p
&& *p
!= '-')
2336 success_p
= i
== XLFD_LAST
;
2338 /* If requested, and font name was in the expected format,
2339 compute numeric values for some fields. */
2340 if (numeric_p
&& success_p
)
2342 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2343 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2344 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2345 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2346 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2347 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2350 /* Initialize it to zero. It will be overridden by font_list while
2351 trying alternate registries. */
2352 font
->registry_priority
= 0;
2358 /* Build an XLFD font name from font name fields in FONT. Value is a
2359 pointer to the font name, which is allocated via xmalloc. */
2362 build_font_name (font
)
2363 struct font_name
*font
;
2367 char *font_name
= (char *) xmalloc (size
);
2368 int total_length
= 0;
2370 for (i
= 0; i
< XLFD_LAST
; ++i
)
2372 /* Add 1 because of the leading `-'. */
2373 int len
= strlen (font
->fields
[i
]) + 1;
2375 /* Reallocate font_name if necessary. Add 1 for the final
2377 if (total_length
+ len
+ 1 >= size
)
2379 int new_size
= max (2 * size
, size
+ len
+ 1);
2380 int sz
= new_size
* sizeof *font_name
;
2381 font_name
= (char *) xrealloc (font_name
, sz
);
2385 font_name
[total_length
] = '-';
2386 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2387 total_length
+= len
;
2390 font_name
[total_length
] = 0;
2395 /* Free an array FONTS of N font_name structures. This frees FONTS
2396 itself and all `name' fields in its elements. */
2399 free_font_names (fonts
, n
)
2400 struct font_name
*fonts
;
2404 xfree (fonts
[--n
].name
);
2409 /* Sort vector FONTS of font_name structures which contains NFONTS
2410 elements using qsort and comparison function CMPFN. F is the frame
2411 on which the fonts will be used. The global variable font_frame
2412 is temporarily set to F to make it available in CMPFN. */
2415 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2417 struct font_name
*fonts
;
2419 int (*cmpfn
) P_ ((const void *, const void *));
2422 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2427 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2428 display in x_display_list. FONTS is a pointer to a vector of
2429 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2430 alternative patterns from Valternate_fontname_alist if no fonts are
2431 found matching PATTERN.
2433 For all fonts found, set FONTS[i].name to the name of the font,
2434 allocated via xmalloc, and split font names into fields. Ignore
2435 fonts that we can't parse. Value is the number of fonts found. */
2438 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2441 struct font_name
**pfonts
;
2442 int nfonts
, try_alternatives_p
;
2446 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2447 better to do it the other way around. */
2449 Lisp_Object lpattern
, tem
;
2450 struct font_name
*fonts
= 0;
2451 int num_fonts
= nfonts
;
2454 lpattern
= build_string (pattern
);
2456 /* Get the list of fonts matching PATTERN. */
2459 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2462 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2465 if (nfonts
< 0 && CONSP (lfonts
))
2466 num_fonts
= XFASTINT (Flength (lfonts
));
2468 /* Make a copy of the font names we got from X, and
2469 split them into fields. */
2471 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2473 Lisp_Object elt
, tail
;
2474 const char *name
= SDATA (XCAR (tem
));
2476 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2477 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2481 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2492 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2496 /* Make a copy of the font name. */
2497 fonts
[n
].name
= xstrdup (name
);
2499 if (split_font_name (f
, fonts
+ n
, 1))
2501 if (font_scalable_p (fonts
+ n
)
2502 && !may_use_scalable_font_p (name
))
2505 xfree (fonts
[n
].name
);
2511 xfree (fonts
[n
].name
);
2514 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2515 if (n
== 0 && try_alternatives_p
)
2517 Lisp_Object list
= Valternate_fontname_alist
;
2525 while (CONSP (list
))
2527 Lisp_Object entry
= XCAR (list
);
2529 && STRINGP (XCAR (entry
))
2530 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2537 Lisp_Object patterns
= XCAR (list
);
2540 while (CONSP (patterns
)
2541 /* If list is screwed up, give up. */
2542 && (name
= XCAR (patterns
),
2544 /* Ignore patterns equal to PATTERN because we tried that
2545 already with no success. */
2546 && (strcmp (SDATA (name
), pattern
) == 0
2547 || (n
= x_face_list_fonts (f
, SDATA (name
),
2550 patterns
= XCDR (patterns
);
2558 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2559 using comparison function CMPFN. Value is the number of fonts
2560 found. If value is non-zero, *FONTS is set to a vector of
2561 font_name structures allocated from the heap containing matching
2562 fonts. Each element of *FONTS contains a name member that is also
2563 allocated from the heap. Font names in these structures are split
2564 into fields. Use free_font_names to free such an array. */
2567 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2570 int (*cmpfn
) P_ ((const void *, const void *));
2571 struct font_name
**fonts
;
2575 /* Get the list of fonts matching pattern. 100 should suffice. */
2576 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2577 if (INTEGERP (Vfont_list_limit
))
2578 nfonts
= XINT (Vfont_list_limit
);
2581 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2583 /* Sort the resulting array and return it in *FONTS. If no
2584 fonts were found, make sure to set *FONTS to null. */
2586 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2597 /* Compare two font_name structures *A and *B. Value is analogous to
2598 strcmp. Sort order is given by the global variable
2599 font_sort_order. Font names are sorted so that, everything else
2600 being equal, fonts with a resolution closer to that of the frame on
2601 which they are used are listed first. The global variable
2602 font_frame is the frame on which we operate. */
2605 cmp_font_names (a
, b
)
2608 struct font_name
*x
= (struct font_name
*) a
;
2609 struct font_name
*y
= (struct font_name
*) b
;
2612 /* All strings have been converted to lower-case by split_font_name,
2613 so we can use strcmp here. */
2614 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2619 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2621 int j
= font_sort_order
[i
];
2622 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2627 /* Everything else being equal, we prefer fonts with an
2628 y-resolution closer to that of the frame. */
2629 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2630 int x_resy
= x
->numeric
[XLFD_RESY
];
2631 int y_resy
= y
->numeric
[XLFD_RESY
];
2632 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2640 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2641 is non-nil list fonts matching that pattern. Otherwise, if
2642 REGISTRY is non-nil return only fonts with that registry, otherwise
2643 return fonts of any registry. Set *FONTS to a vector of font_name
2644 structures allocated from the heap containing the fonts found.
2645 Value is the number of fonts found. */
2648 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2650 Lisp_Object pattern
, family
, registry
;
2651 struct font_name
**fonts
;
2653 char *pattern_str
, *family_str
, *registry_str
;
2657 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2658 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2660 pattern_str
= (char *) alloca (strlen (family_str
)
2661 + strlen (registry_str
)
2663 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2664 strcat (pattern_str
, family_str
);
2665 strcat (pattern_str
, "-*-");
2666 strcat (pattern_str
, registry_str
);
2667 if (!index (registry_str
, '-'))
2669 if (registry_str
[strlen (registry_str
) - 1] == '*')
2670 strcat (pattern_str
, "-*");
2672 strcat (pattern_str
, "*-*");
2676 pattern_str
= (char *) SDATA (pattern
);
2678 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2682 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2683 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2684 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2687 static struct font_name
*
2688 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2689 struct font_name
*fonts1
, *fonts2
;
2690 int nfonts1
, nfonts2
;
2692 int new_nfonts
= nfonts1
+ nfonts2
;
2693 struct font_name
*new_fonts
;
2695 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2696 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2697 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2704 /* Get a sorted list of fonts of family FAMILY on frame F.
2706 If PATTERN is non-nil list fonts matching that pattern.
2708 If REGISTRY is non-nil, return fonts with that registry and the
2709 alternative registries from Vface_alternative_font_registry_alist.
2711 If REGISTRY is nil return fonts of any registry.
2713 Set *FONTS to a vector of font_name structures allocated from the
2714 heap containing the fonts found. Value is the number of fonts
2718 font_list (f
, pattern
, family
, registry
, fonts
)
2720 Lisp_Object pattern
, family
, registry
;
2721 struct font_name
**fonts
;
2723 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2725 if (!NILP (registry
)
2726 && CONSP (Vface_alternative_font_registry_alist
))
2730 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2735 for (alter
= XCDR (alter
), reg_prio
= 1;
2737 alter
= XCDR (alter
), reg_prio
++)
2738 if (STRINGP (XCAR (alter
)))
2741 struct font_name
*fonts2
;
2743 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2745 for (i
= 0; i
< nfonts2
; i
++)
2746 fonts2
[i
].registry_priority
= reg_prio
;
2747 *fonts
= (nfonts
> 0
2748 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2759 /* Remove elements from LIST whose cars are `equal'. Called from
2760 x-family-fonts and x-font-family-list to remove duplicate font
2764 remove_duplicates (list
)
2767 Lisp_Object tail
= list
;
2769 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2771 Lisp_Object next
= XCDR (tail
);
2772 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2773 XSETCDR (tail
, XCDR (next
));
2780 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2781 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2782 If FAMILY is omitted or nil, list all families.
2783 Otherwise, FAMILY must be a string, possibly containing wildcards
2785 If FRAME is omitted or nil, use the selected frame.
2786 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2787 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2788 FAMILY is the font family name. POINT-SIZE is the size of the
2789 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2790 width, weight and slant of the font. These symbols are the same as for
2791 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2792 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2793 giving the registry and encoding of the font.
2794 The result list is sorted according to the current setting of
2795 the face font sort order. */)
2797 Lisp_Object family
, frame
;
2799 struct frame
*f
= check_x_frame (frame
);
2800 struct font_name
*fonts
;
2803 struct gcpro gcpro1
;
2806 CHECK_STRING (family
);
2810 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2811 for (i
= nfonts
- 1; i
>= 0; --i
)
2813 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2816 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2817 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2818 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2819 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2820 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2821 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2822 tem
= build_font_name (fonts
+ i
);
2823 ASET (v
, 6, build_string (tem
));
2824 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2825 fonts
[i
].fields
[XLFD_ENCODING
]);
2826 ASET (v
, 7, build_string (tem
));
2829 result
= Fcons (v
, result
);
2832 remove_duplicates (result
);
2833 free_font_names (fonts
, nfonts
);
2839 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2841 doc
: /* Return a list of available font families on FRAME.
2842 If FRAME is omitted or nil, use the selected frame.
2843 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2844 is a font family, and FIXED-P is non-nil if fonts of that family
2845 are fixed-pitch. */)
2849 struct frame
*f
= check_x_frame (frame
);
2851 struct font_name
*fonts
;
2853 struct gcpro gcpro1
;
2854 int count
= SPECPDL_INDEX ();
2856 /* Let's consider all fonts. */
2857 specbind (intern ("font-list-limit"), make_number (-1));
2858 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2862 for (i
= nfonts
- 1; i
>= 0; --i
)
2863 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2864 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2867 remove_duplicates (result
);
2868 free_font_names (fonts
, nfonts
);
2870 return unbind_to (count
, result
);
2874 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2875 doc
: /* Return a list of the names of available fonts matching PATTERN.
2876 If optional arguments FACE and FRAME are specified, return only fonts
2877 the same size as FACE on FRAME.
2878 PATTERN is a string, perhaps with wildcard characters;
2879 the * character matches any substring, and
2880 the ? character matches any single character.
2881 PATTERN is case-insensitive.
2882 FACE is a face name--a symbol.
2884 The return value is a list of strings, suitable as arguments to
2887 Fonts Emacs can't use may or may not be excluded
2888 even if they match PATTERN and FACE.
2889 The optional fourth argument MAXIMUM sets a limit on how many
2890 fonts to match. The first MAXIMUM fonts are reported.
2891 The optional fifth argument WIDTH, if specified, is a number of columns
2892 occupied by a character of a font. In that case, return only fonts
2893 the WIDTH times as wide as FACE on FRAME. */)
2894 (pattern
, face
, frame
, maximum
, width
)
2895 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2902 CHECK_STRING (pattern
);
2908 CHECK_NATNUM (maximum
);
2909 maxnames
= XINT (maximum
);
2913 CHECK_NUMBER (width
);
2915 /* We can't simply call check_x_frame because this function may be
2916 called before any frame is created. */
2917 f
= frame_or_selected_frame (frame
, 2);
2918 if (!FRAME_WINDOW_P (f
))
2920 /* Perhaps we have not yet created any frame. */
2925 /* Determine the width standard for comparison with the fonts we find. */
2931 /* This is of limited utility since it works with character
2932 widths. Keep it for compatibility. --gerd. */
2933 int face_id
= lookup_named_face (f
, face
, 0);
2934 struct face
*face
= (face_id
< 0
2936 : FACE_FROM_ID (f
, face_id
));
2938 if (face
&& face
->font
)
2939 size
= FONT_WIDTH (face
->font
);
2941 size
= FONT_WIDTH (FRAME_FONT (f
));
2944 size
*= XINT (width
);
2948 Lisp_Object args
[2];
2950 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2952 /* We don't have to check fontsets. */
2954 args
[1] = list_fontsets (f
, pattern
, size
);
2955 return Fnconc (2, args
);
2959 #endif /* HAVE_WINDOW_SYSTEM */
2963 /***********************************************************************
2965 ***********************************************************************/
2967 /* Access face attributes of face LFACE, a Lisp vector. */
2969 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2970 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2971 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2972 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2973 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2974 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2975 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2976 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2977 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2978 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2979 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2980 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2981 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2982 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2983 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2984 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2986 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2987 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2989 #define LFACEP(LFACE) \
2991 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2992 && EQ (AREF (LFACE, 0), Qface))
2997 /* Check consistency of Lisp face attribute vector ATTRS. */
3000 check_lface_attrs (attrs
)
3003 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3004 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3005 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3006 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3007 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3008 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3009 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3010 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3011 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3012 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3013 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3014 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3015 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3016 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3017 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3018 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3019 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3020 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3021 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3022 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3023 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3024 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3025 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3026 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3027 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3028 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3029 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3030 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3031 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3032 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3033 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3034 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3035 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3036 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3037 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3038 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3039 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3040 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3041 #ifdef HAVE_WINDOW_SYSTEM
3042 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3043 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3044 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3045 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3046 || NILP (attrs
[LFACE_FONT_INDEX
])
3047 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3052 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3060 xassert (LFACEP (lface
));
3061 check_lface_attrs (XVECTOR (lface
)->contents
);
3065 #else /* GLYPH_DEBUG == 0 */
3067 #define check_lface_attrs(attrs) (void) 0
3068 #define check_lface(lface) (void) 0
3070 #endif /* GLYPH_DEBUG == 0 */
3073 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3074 to make it a symvol. If FACE_NAME is an alias for another face,
3075 return that face's name. */
3078 resolve_face_name (face_name
)
3079 Lisp_Object face_name
;
3081 Lisp_Object aliased
;
3083 if (STRINGP (face_name
))
3084 face_name
= intern (SDATA (face_name
));
3086 while (SYMBOLP (face_name
))
3088 aliased
= Fget (face_name
, Qface_alias
);
3092 face_name
= aliased
;
3099 /* Return the face definition of FACE_NAME on frame F. F null means
3100 return the definition for new frames. FACE_NAME may be a string or
3101 a symbol (apparently Emacs 20.2 allowed strings as face names in
3102 face text properties; Ediff uses that). If FACE_NAME is an alias
3103 for another face, return that face's definition. If SIGNAL_P is
3104 non-zero, signal an error if FACE_NAME is not a valid face name.
3105 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3108 static INLINE Lisp_Object
3109 lface_from_face_name (f
, face_name
, signal_p
)
3111 Lisp_Object face_name
;
3116 face_name
= resolve_face_name (face_name
);
3119 lface
= assq_no_quit (face_name
, f
->face_alist
);
3121 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3124 lface
= XCDR (lface
);
3126 signal_error ("Invalid face", face_name
);
3128 check_lface (lface
);
3133 /* Get face attributes of face FACE_NAME from frame-local faces on
3134 frame F. Store the resulting attributes in ATTRS which must point
3135 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3136 is non-zero, signal an error if FACE_NAME does not name a face.
3137 Otherwise, value is zero if FACE_NAME is not a face. */
3140 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3142 Lisp_Object face_name
;
3149 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3152 bcopy (XVECTOR (lface
)->contents
, attrs
,
3153 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3163 /* Non-zero if all attributes in face attribute vector ATTRS are
3164 specified, i.e. are non-nil. */
3167 lface_fully_specified_p (attrs
)
3172 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3173 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3174 && i
!= LFACE_AVGWIDTH_INDEX
)
3175 if (UNSPECIFIEDP (attrs
[i
]))
3178 return i
== LFACE_VECTOR_SIZE
;
3181 #ifdef HAVE_WINDOW_SYSTEM
3183 /* Set font-related attributes of Lisp face LFACE from the fullname of
3184 the font opened by FONTNAME. If FORCE_P is zero, set only
3185 unspecified attributes of LFACE. The exception is `font'
3186 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3188 If FONTNAME is not available on frame F,
3189 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3190 If the fullname is not in a valid XLFD format,
3191 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3192 in LFACE and return 1.
3193 Otherwise, return 1. */
3196 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3199 Lisp_Object fontname
;
3200 int force_p
, may_fail_p
;
3202 struct font_name font
;
3207 char *font_name
= SDATA (fontname
);
3208 struct font_info
*font_info
;
3210 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3211 fontset
= fs_query_fontset (fontname
, 0);
3213 font_name
= SDATA (fontset_ascii (fontset
));
3215 /* Check if FONT_NAME is surely available on the system. Usually
3216 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3217 returns quickly. But, even if FONT_NAME is not yet cached,
3218 caching it now is not futail because we anyway load the font
3221 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3231 font
.name
= STRDUPA (font_info
->full_name
);
3232 have_xlfd_p
= split_font_name (f
, &font
, 1);
3234 /* Set attributes only if unspecified, otherwise face defaults for
3235 new frames would never take effect. If we couldn't get a font
3236 name conforming to XLFD, set normal values. */
3238 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3243 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3244 + strlen (font
.fields
[XLFD_FOUNDRY
])
3246 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3247 font
.fields
[XLFD_FAMILY
]);
3248 val
= build_string (buffer
);
3251 val
= build_string ("*");
3252 LFACE_FAMILY (lface
) = val
;
3255 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3258 pt
= xlfd_point_size (f
, &font
);
3260 pt
= pixel_point_size (f
, font_info
->height
* 10);
3262 LFACE_HEIGHT (lface
) = make_number (pt
);
3265 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3266 LFACE_SWIDTH (lface
)
3267 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3269 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3270 LFACE_AVGWIDTH (lface
)
3272 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3275 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3276 LFACE_WEIGHT (lface
)
3277 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3279 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3281 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3283 LFACE_FONT (lface
) = fontname
;
3288 #endif /* HAVE_WINDOW_SYSTEM */
3291 /* Merges the face height FROM with the face height TO, and returns the
3292 merged height. If FROM is an invalid height, then INVALID is
3293 returned instead. FROM and TO may be either absolute face heights or
3294 `relative' heights; the returned value is always an absolute height
3295 unless both FROM and TO are relative. GCPRO is a lisp value that
3296 will be protected from garbage-collection if this function makes a
3300 merge_face_heights (from
, to
, invalid
, gcpro
)
3301 Lisp_Object from
, to
, invalid
, gcpro
;
3303 Lisp_Object result
= invalid
;
3305 if (INTEGERP (from
))
3306 /* FROM is absolute, just use it as is. */
3308 else if (FLOATP (from
))
3309 /* FROM is a scale, use it to adjust TO. */
3312 /* relative X absolute => absolute */
3313 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3314 else if (FLOATP (to
))
3315 /* relative X relative => relative */
3316 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3318 else if (FUNCTIONP (from
))
3319 /* FROM is a function, which use to adjust TO. */
3321 /* Call function with current height as argument.
3322 From is the new height. */
3323 Lisp_Object args
[2];
3324 struct gcpro gcpro1
;
3330 result
= safe_call (2, args
);
3334 /* Ensure that if TO was absolute, so is the result. */
3335 if (INTEGERP (to
) && !INTEGERP (result
))
3343 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3344 store the resulting attributes in TO, which must be already be
3345 completely specified and contain only absolute attributes. Every
3346 specified attribute of FROM overrides the corresponding attribute of
3347 TO; relative attributes in FROM are merged with the absolute value in
3348 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3349 face inheritance; it should be Qnil when called from other places. */
3352 merge_face_vectors (f
, from
, to
, cycle_check
)
3354 Lisp_Object
*from
, *to
;
3355 Lisp_Object cycle_check
;
3359 /* If FROM inherits from some other faces, merge their attributes into
3360 TO before merging FROM's direct attributes. Note that an :inherit
3361 attribute of `unspecified' is the same as one of nil; we never
3362 merge :inherit attributes, so nil is more correct, but lots of
3363 other code uses `unspecified' as a generic value for face attributes. */
3364 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3365 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3366 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3368 /* If TO specifies a :font attribute, and FROM specifies some
3369 font-related attribute, we need to clear TO's :font attribute
3370 (because it will be inconsistent with whatever FROM specifies, and
3371 FROM takes precedence). */
3372 if (!NILP (to
[LFACE_FONT_INDEX
])
3373 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3374 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3375 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3376 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3377 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3378 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3379 to
[LFACE_FONT_INDEX
] = Qnil
;
3381 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3382 if (!UNSPECIFIEDP (from
[i
]))
3384 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3385 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3390 /* TO is always an absolute face, which should inherit from nothing.
3391 We blindly copy the :inherit attribute above and fix it up here. */
3392 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3396 /* Checks the `cycle check' variable CHECK to see if it indicates that
3397 EL is part of a cycle; CHECK must be either Qnil or a value returned
3398 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3399 elements after which a cycle might be suspected; after that many
3400 elements, this macro begins consing in order to keep more precise
3403 Returns nil if a cycle was detected, otherwise a new value for CHECK
3406 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3407 the caller should make sure that's ok. */
3409 #define CYCLE_CHECK(check, el, suspicious) \
3412 : (INTEGERP (check) \
3413 ? (XFASTINT (check) < (suspicious) \
3414 ? make_number (XFASTINT (check) + 1) \
3415 : Fcons (el, Qnil)) \
3416 : (!NILP (Fmemq ((el), (check))) \
3418 : Fcons ((el), (check)))))
3421 /* Merge face attributes from the face on frame F whose name is
3422 INHERITS, into the vector of face attributes TO; INHERITS may also be
3423 a list of face names, in which case they are applied in order.
3424 CYCLE_CHECK is used to detect loops in face inheritance.
3425 Returns true if any of the inherited attributes are `font-related'. */
3428 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3430 Lisp_Object inherit
;
3432 Lisp_Object cycle_check
;
3434 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3435 /* Inherit from the named face INHERIT. */
3439 /* Make sure we're not in an inheritance loop. */
3440 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3441 if (NILP (cycle_check
))
3442 /* Cycle detected, ignore any further inheritance. */
3445 lface
= lface_from_face_name (f
, inherit
, 0);
3447 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3449 else if (CONSP (inherit
))
3450 /* Handle a list of inherited faces by calling ourselves recursively
3451 on each element. Note that we only do so for symbol elements, so
3452 it's not possible to infinitely recurse. */
3454 while (CONSP (inherit
))
3456 if (SYMBOLP (XCAR (inherit
)))
3457 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3459 /* Check for a circular inheritance list. */
3460 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3461 if (NILP (cycle_check
))
3462 /* Cycle detected. */
3465 inherit
= XCDR (inherit
);
3471 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3472 is a face property, determine the resulting face attributes on
3473 frame F, and store them in TO. PROP may be a single face
3474 specification or a list of such specifications. Each face
3475 specification can be
3477 1. A symbol or string naming a Lisp face.
3479 2. A property list of the form (KEYWORD VALUE ...) where each
3480 KEYWORD is a face attribute name, and value is an appropriate value
3483 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3484 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3485 for compatibility with 20.2.
3487 Face specifications earlier in lists take precedence over later
3491 merge_face_vector_with_property (f
, to
, prop
)
3498 Lisp_Object first
= XCAR (prop
);
3500 if (EQ (first
, Qforeground_color
)
3501 || EQ (first
, Qbackground_color
))
3503 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3504 . COLOR). COLOR must be a string. */
3505 Lisp_Object color_name
= XCDR (prop
);
3506 Lisp_Object color
= first
;
3508 if (STRINGP (color_name
))
3510 if (EQ (color
, Qforeground_color
))
3511 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3513 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3516 add_to_log ("Invalid face color", color_name
, Qnil
);
3518 else if (SYMBOLP (first
)
3519 && *SDATA (SYMBOL_NAME (first
)) == ':')
3521 /* Assume this is the property list form. */
3522 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3524 Lisp_Object keyword
= XCAR (prop
);
3525 Lisp_Object value
= XCAR (XCDR (prop
));
3527 if (EQ (keyword
, QCfamily
))
3529 if (STRINGP (value
))
3530 to
[LFACE_FAMILY_INDEX
] = value
;
3532 add_to_log ("Invalid face font family", value
, Qnil
);
3534 else if (EQ (keyword
, QCheight
))
3536 Lisp_Object new_height
=
3537 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3540 if (NILP (new_height
))
3541 add_to_log ("Invalid face font height", value
, Qnil
);
3543 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3545 else if (EQ (keyword
, QCweight
))
3548 && face_numeric_weight (value
) >= 0)
3549 to
[LFACE_WEIGHT_INDEX
] = value
;
3551 add_to_log ("Invalid face weight", value
, Qnil
);
3553 else if (EQ (keyword
, QCslant
))
3556 && face_numeric_slant (value
) >= 0)
3557 to
[LFACE_SLANT_INDEX
] = value
;
3559 add_to_log ("Invalid face slant", value
, Qnil
);
3561 else if (EQ (keyword
, QCunderline
))
3566 to
[LFACE_UNDERLINE_INDEX
] = value
;
3568 add_to_log ("Invalid face underline", value
, Qnil
);
3570 else if (EQ (keyword
, QCoverline
))
3575 to
[LFACE_OVERLINE_INDEX
] = value
;
3577 add_to_log ("Invalid face overline", value
, Qnil
);
3579 else if (EQ (keyword
, QCstrike_through
))
3584 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3586 add_to_log ("Invalid face strike-through", value
, Qnil
);
3588 else if (EQ (keyword
, QCbox
))
3591 value
= make_number (1);
3592 if (INTEGERP (value
)
3596 to
[LFACE_BOX_INDEX
] = value
;
3598 add_to_log ("Invalid face box", value
, Qnil
);
3600 else if (EQ (keyword
, QCinverse_video
)
3601 || EQ (keyword
, QCreverse_video
))
3603 if (EQ (value
, Qt
) || NILP (value
))
3604 to
[LFACE_INVERSE_INDEX
] = value
;
3606 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3608 else if (EQ (keyword
, QCforeground
))
3610 if (STRINGP (value
))
3611 to
[LFACE_FOREGROUND_INDEX
] = value
;
3613 add_to_log ("Invalid face foreground", value
, Qnil
);
3615 else if (EQ (keyword
, QCbackground
))
3617 if (STRINGP (value
))
3618 to
[LFACE_BACKGROUND_INDEX
] = value
;
3620 add_to_log ("Invalid face background", value
, Qnil
);
3622 else if (EQ (keyword
, QCstipple
))
3624 #ifdef HAVE_X_WINDOWS
3625 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3626 if (!NILP (pixmap_p
))
3627 to
[LFACE_STIPPLE_INDEX
] = value
;
3629 add_to_log ("Invalid face stipple", value
, Qnil
);
3632 else if (EQ (keyword
, QCwidth
))
3635 && face_numeric_swidth (value
) >= 0)
3636 to
[LFACE_SWIDTH_INDEX
] = value
;
3638 add_to_log ("Invalid face width", value
, Qnil
);
3640 else if (EQ (keyword
, QCinherit
))
3642 if (SYMBOLP (value
))
3643 to
[LFACE_INHERIT_INDEX
] = value
;
3647 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3648 if (!SYMBOLP (XCAR (tail
)))
3651 to
[LFACE_INHERIT_INDEX
] = value
;
3653 add_to_log ("Invalid face inherit", value
, Qnil
);
3657 add_to_log ("Invalid attribute %s in face property",
3660 prop
= XCDR (XCDR (prop
));
3665 /* This is a list of face specs. Specifications at the
3666 beginning of the list take precedence over later
3667 specifications, so we have to merge starting with the
3668 last specification. */
3669 Lisp_Object next
= XCDR (prop
);
3671 merge_face_vector_with_property (f
, to
, next
);
3672 merge_face_vector_with_property (f
, to
, first
);
3677 /* PROP ought to be a face name. */
3678 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3680 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3682 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3687 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3688 Sinternal_make_lisp_face
, 1, 2, 0,
3689 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3690 If FACE was not known as a face before, create a new one.
3691 If optional argument FRAME is specified, make a frame-local face
3692 for that frame. Otherwise operate on the global face definition.
3693 Value is a vector of face attributes. */)
3695 Lisp_Object face
, frame
;
3697 Lisp_Object global_lface
, lface
;
3701 CHECK_SYMBOL (face
);
3702 global_lface
= lface_from_face_name (NULL
, face
, 0);
3706 CHECK_LIVE_FRAME (frame
);
3708 lface
= lface_from_face_name (f
, face
, 0);
3711 f
= NULL
, lface
= Qnil
;
3713 /* Add a global definition if there is none. */
3714 if (NILP (global_lface
))
3716 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3718 AREF (global_lface
, 0) = Qface
;
3719 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3720 Vface_new_frame_defaults
);
3722 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3723 face id to Lisp face is given by the vector lface_id_to_name.
3724 The mapping from Lisp face to Lisp face id is given by the
3725 property `face' of the Lisp face name. */
3726 if (next_lface_id
== lface_id_to_name_size
)
3728 int new_size
= max (50, 2 * lface_id_to_name_size
);
3729 int sz
= new_size
* sizeof *lface_id_to_name
;
3730 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3731 lface_id_to_name_size
= new_size
;
3734 lface_id_to_name
[next_lface_id
] = face
;
3735 Fput (face
, Qface
, make_number (next_lface_id
));
3739 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3740 AREF (global_lface
, i
) = Qunspecified
;
3742 /* Add a frame-local definition. */
3747 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3749 AREF (lface
, 0) = Qface
;
3750 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3753 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3754 AREF (lface
, i
) = Qunspecified
;
3757 lface
= global_lface
;
3759 /* Changing a named face means that all realized faces depending on
3760 that face are invalid. Since we cannot tell which realized faces
3761 depend on the face, make sure they are all removed. This is done
3762 by incrementing face_change_count. The next call to
3763 init_iterator will then free realized faces. */
3764 ++face_change_count
;
3765 ++windows_or_buffers_changed
;
3767 xassert (LFACEP (lface
));
3768 check_lface (lface
);
3773 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3774 Sinternal_lisp_face_p
, 1, 2, 0,
3775 doc
: /* Return non-nil if FACE names a face.
3776 If optional second parameter FRAME is non-nil, check for the
3777 existence of a frame-local face with name FACE on that frame.
3778 Otherwise check for the existence of a global face. */)
3780 Lisp_Object face
, frame
;
3786 CHECK_LIVE_FRAME (frame
);
3787 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3790 lface
= lface_from_face_name (NULL
, face
, 0);
3796 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3797 Sinternal_copy_lisp_face
, 4, 4, 0,
3798 doc
: /* Copy face FROM to TO.
3799 If FRAME it t, copy the global face definition of FROM to the
3800 global face definition of TO. Otherwise, copy the frame-local
3801 definition of FROM on FRAME to the frame-local definition of TO
3802 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3805 (from
, to
, frame
, new_frame
)
3806 Lisp_Object from
, to
, frame
, new_frame
;
3808 Lisp_Object lface
, copy
;
3810 CHECK_SYMBOL (from
);
3812 if (NILP (new_frame
))
3817 /* Copy global definition of FROM. We don't make copies of
3818 strings etc. because 20.2 didn't do it either. */
3819 lface
= lface_from_face_name (NULL
, from
, 1);
3820 copy
= Finternal_make_lisp_face (to
, Qnil
);
3824 /* Copy frame-local definition of FROM. */
3825 CHECK_LIVE_FRAME (frame
);
3826 CHECK_LIVE_FRAME (new_frame
);
3827 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3828 copy
= Finternal_make_lisp_face (to
, new_frame
);
3831 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3832 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3834 /* Changing a named face means that all realized faces depending on
3835 that face are invalid. Since we cannot tell which realized faces
3836 depend on the face, make sure they are all removed. This is done
3837 by incrementing face_change_count. The next call to
3838 init_iterator will then free realized faces. */
3839 ++face_change_count
;
3840 ++windows_or_buffers_changed
;
3846 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3847 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3848 doc
: /* Set attribute ATTR of FACE to VALUE.
3849 FRAME being a frame means change the face on that frame.
3850 FRAME nil means change the face of the selected frame.
3851 FRAME t means change the default for new frames.
3852 FRAME 0 means change the face on all frames, and change the default
3854 (face
, attr
, value
, frame
)
3855 Lisp_Object face
, attr
, value
, frame
;
3858 Lisp_Object old_value
= Qnil
;
3859 /* Set 1 if ATTR is QCfont. */
3860 int font_attr_p
= 0;
3861 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3862 int font_related_attr_p
= 0;
3864 CHECK_SYMBOL (face
);
3865 CHECK_SYMBOL (attr
);
3867 face
= resolve_face_name (face
);
3869 /* If FRAME is 0, change face on all frames, and change the
3870 default for new frames. */
3871 if (INTEGERP (frame
) && XINT (frame
) == 0)
3874 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3875 FOR_EACH_FRAME (tail
, frame
)
3876 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3880 /* Set lface to the Lisp attribute vector of FACE. */
3882 lface
= lface_from_face_name (NULL
, face
, 1);
3886 frame
= selected_frame
;
3888 CHECK_LIVE_FRAME (frame
);
3889 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3891 /* If a frame-local face doesn't exist yet, create one. */
3893 lface
= Finternal_make_lisp_face (face
, frame
);
3896 if (EQ (attr
, QCfamily
))
3898 if (!UNSPECIFIEDP (value
))
3900 CHECK_STRING (value
);
3901 if (SCHARS (value
) == 0)
3902 signal_error ("Invalid face family", value
);
3904 old_value
= LFACE_FAMILY (lface
);
3905 LFACE_FAMILY (lface
) = value
;
3906 font_related_attr_p
= 1;
3908 else if (EQ (attr
, QCheight
))
3910 if (!UNSPECIFIEDP (value
))
3914 test
= (EQ (face
, Qdefault
)
3916 /* The default face must have an absolute size,
3917 otherwise, we do a test merge with a random
3918 height to see if VALUE's ok. */
3919 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3921 if (!INTEGERP (test
) || XINT (test
) <= 0)
3922 signal_error ("Invalid face height", value
);
3925 old_value
= LFACE_HEIGHT (lface
);
3926 LFACE_HEIGHT (lface
) = value
;
3927 font_related_attr_p
= 1;
3929 else if (EQ (attr
, QCweight
))
3931 if (!UNSPECIFIEDP (value
))
3933 CHECK_SYMBOL (value
);
3934 if (face_numeric_weight (value
) < 0)
3935 signal_error ("Invalid face weight", value
);
3937 old_value
= LFACE_WEIGHT (lface
);
3938 LFACE_WEIGHT (lface
) = value
;
3939 font_related_attr_p
= 1;
3941 else if (EQ (attr
, QCslant
))
3943 if (!UNSPECIFIEDP (value
))
3945 CHECK_SYMBOL (value
);
3946 if (face_numeric_slant (value
) < 0)
3947 signal_error ("Invalid face slant", value
);
3949 old_value
= LFACE_SLANT (lface
);
3950 LFACE_SLANT (lface
) = value
;
3951 font_related_attr_p
= 1;
3953 else if (EQ (attr
, QCunderline
))
3955 if (!UNSPECIFIEDP (value
))
3956 if ((SYMBOLP (value
)
3958 && !EQ (value
, Qnil
))
3959 /* Underline color. */
3961 && SCHARS (value
) == 0))
3962 signal_error ("Invalid face underline", value
);
3964 old_value
= LFACE_UNDERLINE (lface
);
3965 LFACE_UNDERLINE (lface
) = value
;
3967 else if (EQ (attr
, QCoverline
))
3969 if (!UNSPECIFIEDP (value
))
3970 if ((SYMBOLP (value
)
3972 && !EQ (value
, Qnil
))
3973 /* Overline color. */
3975 && SCHARS (value
) == 0))
3976 signal_error ("Invalid face overline", value
);
3978 old_value
= LFACE_OVERLINE (lface
);
3979 LFACE_OVERLINE (lface
) = value
;
3981 else if (EQ (attr
, QCstrike_through
))
3983 if (!UNSPECIFIEDP (value
))
3984 if ((SYMBOLP (value
)
3986 && !EQ (value
, Qnil
))
3987 /* Strike-through color. */
3989 && SCHARS (value
) == 0))
3990 signal_error ("Invalid face strike-through", value
);
3992 old_value
= LFACE_STRIKE_THROUGH (lface
);
3993 LFACE_STRIKE_THROUGH (lface
) = value
;
3995 else if (EQ (attr
, QCbox
))
3999 /* Allow t meaning a simple box of width 1 in foreground color
4002 value
= make_number (1);
4004 if (UNSPECIFIEDP (value
))
4006 else if (NILP (value
))
4008 else if (INTEGERP (value
))
4009 valid_p
= XINT (value
) != 0;
4010 else if (STRINGP (value
))
4011 valid_p
= SCHARS (value
) > 0;
4012 else if (CONSP (value
))
4028 if (EQ (k
, QCline_width
))
4030 if (!INTEGERP (v
) || XINT (v
) == 0)
4033 else if (EQ (k
, QCcolor
))
4035 if (!STRINGP (v
) || SCHARS (v
) == 0)
4038 else if (EQ (k
, QCstyle
))
4040 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4047 valid_p
= NILP (tem
);
4053 signal_error ("Invalid face box", value
);
4055 old_value
= LFACE_BOX (lface
);
4056 LFACE_BOX (lface
) = value
;
4058 else if (EQ (attr
, QCinverse_video
)
4059 || EQ (attr
, QCreverse_video
))
4061 if (!UNSPECIFIEDP (value
))
4063 CHECK_SYMBOL (value
);
4064 if (!EQ (value
, Qt
) && !NILP (value
))
4065 signal_error ("Invalid inverse-video face attribute value", value
);
4067 old_value
= LFACE_INVERSE (lface
);
4068 LFACE_INVERSE (lface
) = value
;
4070 else if (EQ (attr
, QCforeground
))
4072 if (!UNSPECIFIEDP (value
))
4074 /* Don't check for valid color names here because it depends
4075 on the frame (display) whether the color will be valid
4076 when the face is realized. */
4077 CHECK_STRING (value
);
4078 if (SCHARS (value
) == 0)
4079 signal_error ("Empty foreground color value", value
);
4081 old_value
= LFACE_FOREGROUND (lface
);
4082 LFACE_FOREGROUND (lface
) = value
;
4084 else if (EQ (attr
, QCbackground
))
4086 if (!UNSPECIFIEDP (value
))
4088 /* Don't check for valid color names here because it depends
4089 on the frame (display) whether the color will be valid
4090 when the face is realized. */
4091 CHECK_STRING (value
);
4092 if (SCHARS (value
) == 0)
4093 signal_error ("Empty background color value", value
);
4095 old_value
= LFACE_BACKGROUND (lface
);
4096 LFACE_BACKGROUND (lface
) = value
;
4098 else if (EQ (attr
, QCstipple
))
4100 #ifdef HAVE_X_WINDOWS
4101 if (!UNSPECIFIEDP (value
)
4103 && NILP (Fbitmap_spec_p (value
)))
4104 signal_error ("Invalid stipple attribute", value
);
4105 old_value
= LFACE_STIPPLE (lface
);
4106 LFACE_STIPPLE (lface
) = value
;
4107 #endif /* HAVE_X_WINDOWS */
4109 else if (EQ (attr
, QCwidth
))
4111 if (!UNSPECIFIEDP (value
))
4113 CHECK_SYMBOL (value
);
4114 if (face_numeric_swidth (value
) < 0)
4115 signal_error ("Invalid face width", value
);
4117 old_value
= LFACE_SWIDTH (lface
);
4118 LFACE_SWIDTH (lface
) = value
;
4119 font_related_attr_p
= 1;
4121 else if (EQ (attr
, QCfont
))
4123 #ifdef HAVE_WINDOW_SYSTEM
4124 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4126 /* Set font-related attributes of the Lisp face from an XLFD
4131 CHECK_STRING (value
);
4133 f
= SELECTED_FRAME ();
4135 f
= check_x_frame (frame
);
4137 /* VALUE may be a fontset name or an alias of fontset. In
4138 such a case, use the base fontset name. */
4139 tmp
= Fquery_fontset (value
, Qnil
);
4143 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4144 signal_error ("Invalid font or fontset name", value
);
4148 #endif /* HAVE_WINDOW_SYSTEM */
4150 else if (EQ (attr
, QCinherit
))
4153 if (SYMBOLP (value
))
4156 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4157 if (!SYMBOLP (XCAR (tail
)))
4160 LFACE_INHERIT (lface
) = value
;
4162 signal_error ("Invalid face inheritance", value
);
4164 else if (EQ (attr
, QCbold
))
4166 old_value
= LFACE_WEIGHT (lface
);
4167 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4168 font_related_attr_p
= 1;
4170 else if (EQ (attr
, QCitalic
))
4172 old_value
= LFACE_SLANT (lface
);
4173 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4174 font_related_attr_p
= 1;
4177 signal_error ("Invalid face attribute name", attr
);
4179 if (font_related_attr_p
4180 && !UNSPECIFIEDP (value
))
4181 /* If a font-related attribute other than QCfont is specified, the
4182 original `font' attribute nor that of default face is useless
4183 to determine a new font. Thus, we set it to nil so that font
4184 selection mechanism doesn't use it. */
4185 LFACE_FONT (lface
) = Qnil
;
4187 /* Changing a named face means that all realized faces depending on
4188 that face are invalid. Since we cannot tell which realized faces
4189 depend on the face, make sure they are all removed. This is done
4190 by incrementing face_change_count. The next call to
4191 init_iterator will then free realized faces. */
4193 && (EQ (attr
, QCfont
)
4194 || NILP (Fequal (old_value
, value
))))
4196 ++face_change_count
;
4197 ++windows_or_buffers_changed
;
4200 if (!UNSPECIFIEDP (value
)
4201 && NILP (Fequal (old_value
, value
)))
4207 if (EQ (face
, Qdefault
))
4209 #ifdef HAVE_WINDOW_SYSTEM
4210 /* Changed font-related attributes of the `default' face are
4211 reflected in changed `font' frame parameters. */
4213 && (font_related_attr_p
|| font_attr_p
)
4214 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4215 set_font_frame_param (frame
, lface
);
4217 #endif /* HAVE_WINDOW_SYSTEM */
4219 if (EQ (attr
, QCforeground
))
4220 param
= Qforeground_color
;
4221 else if (EQ (attr
, QCbackground
))
4222 param
= Qbackground_color
;
4224 #ifdef HAVE_WINDOW_SYSTEM
4226 else if (EQ (face
, Qscroll_bar
))
4228 /* Changing the colors of `scroll-bar' sets frame parameters
4229 `scroll-bar-foreground' and `scroll-bar-background'. */
4230 if (EQ (attr
, QCforeground
))
4231 param
= Qscroll_bar_foreground
;
4232 else if (EQ (attr
, QCbackground
))
4233 param
= Qscroll_bar_background
;
4235 #endif /* not WINDOWSNT */
4236 else if (EQ (face
, Qborder
))
4238 /* Changing background color of `border' sets frame parameter
4240 if (EQ (attr
, QCbackground
))
4241 param
= Qborder_color
;
4243 else if (EQ (face
, Qcursor
))
4245 /* Changing background color of `cursor' sets frame parameter
4247 if (EQ (attr
, QCbackground
))
4248 param
= Qcursor_color
;
4250 else if (EQ (face
, Qmouse
))
4252 /* Changing background color of `mouse' sets frame parameter
4254 if (EQ (attr
, QCbackground
))
4255 param
= Qmouse_color
;
4257 #endif /* HAVE_WINDOW_SYSTEM */
4258 else if (EQ (face
, Qmenu
))
4260 /* Indicate that we have to update the menu bar when
4261 realizing faces on FRAME. FRAME t change the
4262 default for new frames. We do this by setting
4263 setting the flag in new face caches */
4266 struct frame
*f
= XFRAME (frame
);
4267 if (FRAME_FACE_CACHE (f
) == NULL
)
4268 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4269 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4272 menu_face_changed_default
= 1;
4278 /* Update `default-frame-alist', which is used for new frames. */
4280 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4283 /* Update the current frame's parameters. */
4286 cons
= XCAR (Vparam_value_alist
);
4287 XSETCAR (cons
, param
);
4288 XSETCDR (cons
, value
);
4289 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4298 #ifdef HAVE_WINDOW_SYSTEM
4300 /* Set the `font' frame parameter of FRAME determined from `default'
4301 face attributes LFACE. If a face or fontset name is explicitely
4302 specfied in LFACE, use it as is. Otherwise, determine a font name
4303 from the other font-related atrributes of LFACE. In that case, if
4304 there's no matching font, signals an error. */
4307 set_font_frame_param (frame
, lface
)
4308 Lisp_Object frame
, lface
;
4310 struct frame
*f
= XFRAME (frame
);
4312 if (FRAME_WINDOW_P (f
))
4314 Lisp_Object font_name
;
4317 if (STRINGP (LFACE_FONT (lface
)))
4318 font_name
= LFACE_FONT (lface
);
4321 /* Choose a font name that reflects LFACE's attributes and has
4322 the registry and encoding pattern specified in the default
4323 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4324 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0, 0);
4326 error ("No font matches the specified attribute");
4327 font_name
= build_string (font
);
4331 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4336 /* Update the corresponding face when frame parameter PARAM on frame F
4337 has been assigned the value NEW_VALUE. */
4340 update_face_from_frame_parameter (f
, param
, new_value
)
4342 Lisp_Object param
, new_value
;
4346 /* If there are no faces yet, give up. This is the case when called
4347 from Fx_create_frame, and we do the necessary things later in
4348 face-set-after-frame-defaults. */
4349 if (NILP (f
->face_alist
))
4352 /* Changing a named face means that all realized faces depending on
4353 that face are invalid. Since we cannot tell which realized faces
4354 depend on the face, make sure they are all removed. This is done
4355 by incrementing face_change_count. The next call to
4356 init_iterator will then free realized faces. */
4357 ++face_change_count
;
4358 ++windows_or_buffers_changed
;
4360 if (EQ (param
, Qforeground_color
))
4362 lface
= lface_from_face_name (f
, Qdefault
, 1);
4363 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4364 ? new_value
: Qunspecified
);
4365 realize_basic_faces (f
);
4367 else if (EQ (param
, Qbackground_color
))
4371 /* Changing the background color might change the background
4372 mode, so that we have to load new defface specs. Call
4373 frame-update-face-colors to do that. */
4374 XSETFRAME (frame
, f
);
4375 call1 (Qframe_update_face_colors
, frame
);
4377 lface
= lface_from_face_name (f
, Qdefault
, 1);
4378 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4379 ? new_value
: Qunspecified
);
4380 realize_basic_faces (f
);
4382 if (EQ (param
, Qborder_color
))
4384 lface
= lface_from_face_name (f
, Qborder
, 1);
4385 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4386 ? new_value
: Qunspecified
);
4388 else if (EQ (param
, Qcursor_color
))
4390 lface
= lface_from_face_name (f
, Qcursor
, 1);
4391 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4392 ? new_value
: Qunspecified
);
4394 else if (EQ (param
, Qmouse_color
))
4396 lface
= lface_from_face_name (f
, Qmouse
, 1);
4397 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4398 ? new_value
: Qunspecified
);
4403 /* Get the value of X resource RESOURCE, class CLASS for the display
4404 of frame FRAME. This is here because ordinary `x-get-resource'
4405 doesn't take a frame argument. */
4407 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4408 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4409 (resource
, class, frame
)
4410 Lisp_Object resource
, class, frame
;
4412 Lisp_Object value
= Qnil
;
4415 CHECK_STRING (resource
);
4416 CHECK_STRING (class);
4417 CHECK_LIVE_FRAME (frame
);
4419 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4420 resource
, class, Qnil
, Qnil
);
4422 #endif /* not MAC_OS */
4423 #endif /* not WINDOWSNT */
4428 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4429 If VALUE is "on" or "true", return t. If VALUE is "off" or
4430 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4431 error; if SIGNAL_P is zero, return 0. */
4434 face_boolean_x_resource_value (value
, signal_p
)
4438 Lisp_Object result
= make_number (0);
4440 xassert (STRINGP (value
));
4442 if (xstricmp (SDATA (value
), "on") == 0
4443 || xstricmp (SDATA (value
), "true") == 0)
4445 else if (xstricmp (SDATA (value
), "off") == 0
4446 || xstricmp (SDATA (value
), "false") == 0)
4448 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4449 result
= Qunspecified
;
4451 signal_error ("Invalid face attribute value from X resource", value
);
4457 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4458 Finternal_set_lisp_face_attribute_from_resource
,
4459 Sinternal_set_lisp_face_attribute_from_resource
,
4460 3, 4, 0, doc
: /* */)
4461 (face
, attr
, value
, frame
)
4462 Lisp_Object face
, attr
, value
, frame
;
4464 CHECK_SYMBOL (face
);
4465 CHECK_SYMBOL (attr
);
4466 CHECK_STRING (value
);
4468 if (xstricmp (SDATA (value
), "unspecified") == 0)
4469 value
= Qunspecified
;
4470 else if (EQ (attr
, QCheight
))
4472 value
= Fstring_to_number (value
, make_number (10));
4473 if (XINT (value
) <= 0)
4474 signal_error ("Invalid face height from X resource", value
);
4476 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4477 value
= face_boolean_x_resource_value (value
, 1);
4478 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4479 value
= intern (SDATA (value
));
4480 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4481 value
= face_boolean_x_resource_value (value
, 1);
4482 else if (EQ (attr
, QCunderline
)
4483 || EQ (attr
, QCoverline
)
4484 || EQ (attr
, QCstrike_through
))
4486 Lisp_Object boolean_value
;
4488 /* If the result of face_boolean_x_resource_value is t or nil,
4489 VALUE does NOT specify a color. */
4490 boolean_value
= face_boolean_x_resource_value (value
, 0);
4491 if (SYMBOLP (boolean_value
))
4492 value
= boolean_value
;
4494 else if (EQ (attr
, QCbox
))
4495 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4497 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4500 #endif /* HAVE_WINDOW_SYSTEM */
4503 /***********************************************************************
4505 ***********************************************************************/
4507 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4509 /* Make menus on frame F appear as specified by the `menu' face. */
4512 x_update_menu_appearance (f
)
4515 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4519 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4523 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4524 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4525 const char *myname
= SDATA (Vx_resource_name
);
4528 const char *popup_path
= "popup_menu";
4530 const char *popup_path
= "menu.popup";
4533 if (STRINGP (LFACE_FOREGROUND (lface
)))
4535 sprintf (line
, "%s.%s*foreground: %s",
4537 SDATA (LFACE_FOREGROUND (lface
)));
4538 XrmPutLineResource (&rdb
, line
);
4539 sprintf (line
, "%s.pane.menubar*foreground: %s",
4540 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4541 XrmPutLineResource (&rdb
, line
);
4545 if (STRINGP (LFACE_BACKGROUND (lface
)))
4547 sprintf (line
, "%s.%s*background: %s",
4549 SDATA (LFACE_BACKGROUND (lface
)));
4550 XrmPutLineResource (&rdb
, line
);
4551 sprintf (line
, "%s.pane.menubar*background: %s",
4552 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4553 XrmPutLineResource (&rdb
, line
);
4558 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4559 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4560 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4561 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4562 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4563 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4566 const char *suffix
= "List";
4568 const char *suffix
= "";
4570 sprintf (line
, "%s.pane.menubar*font%s: %s",
4571 myname
, suffix
, face
->font_name
);
4572 XrmPutLineResource (&rdb
, line
);
4573 sprintf (line
, "%s.%s*font%s: %s",
4574 myname
, popup_path
, suffix
, face
->font_name
);
4575 XrmPutLineResource (&rdb
, line
);
4579 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4580 free_frame_menubar (f
);
4584 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4587 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4588 Sface_attribute_relative_p
,
4590 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4592 Lisp_Object attribute
, value
;
4594 if (EQ (value
, Qunspecified
))
4596 else if (EQ (attribute
, QCheight
))
4597 return INTEGERP (value
) ? Qnil
: Qt
;
4602 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4604 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4605 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4606 the result will be absolute, otherwise it will be relative. */)
4607 (attribute
, value1
, value2
)
4608 Lisp_Object attribute
, value1
, value2
;
4610 if (EQ (value1
, Qunspecified
))
4612 else if (EQ (attribute
, QCheight
))
4613 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4619 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4620 Sinternal_get_lisp_face_attribute
,
4622 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4623 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4624 face attribute name, signal an error.
4625 If the optional argument FRAME is given, report on face FACE in that
4626 frame. If FRAME is t, report on the defaults for face FACE (for new
4627 frames). If FRAME is omitted or nil, use the selected frame. */)
4628 (symbol
, keyword
, frame
)
4629 Lisp_Object symbol
, keyword
, frame
;
4631 Lisp_Object lface
, value
= Qnil
;
4633 CHECK_SYMBOL (symbol
);
4634 CHECK_SYMBOL (keyword
);
4637 lface
= lface_from_face_name (NULL
, symbol
, 1);
4641 frame
= selected_frame
;
4642 CHECK_LIVE_FRAME (frame
);
4643 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4646 if (EQ (keyword
, QCfamily
))
4647 value
= LFACE_FAMILY (lface
);
4648 else if (EQ (keyword
, QCheight
))
4649 value
= LFACE_HEIGHT (lface
);
4650 else if (EQ (keyword
, QCweight
))
4651 value
= LFACE_WEIGHT (lface
);
4652 else if (EQ (keyword
, QCslant
))
4653 value
= LFACE_SLANT (lface
);
4654 else if (EQ (keyword
, QCunderline
))
4655 value
= LFACE_UNDERLINE (lface
);
4656 else if (EQ (keyword
, QCoverline
))
4657 value
= LFACE_OVERLINE (lface
);
4658 else if (EQ (keyword
, QCstrike_through
))
4659 value
= LFACE_STRIKE_THROUGH (lface
);
4660 else if (EQ (keyword
, QCbox
))
4661 value
= LFACE_BOX (lface
);
4662 else if (EQ (keyword
, QCinverse_video
)
4663 || EQ (keyword
, QCreverse_video
))
4664 value
= LFACE_INVERSE (lface
);
4665 else if (EQ (keyword
, QCforeground
))
4666 value
= LFACE_FOREGROUND (lface
);
4667 else if (EQ (keyword
, QCbackground
))
4668 value
= LFACE_BACKGROUND (lface
);
4669 else if (EQ (keyword
, QCstipple
))
4670 value
= LFACE_STIPPLE (lface
);
4671 else if (EQ (keyword
, QCwidth
))
4672 value
= LFACE_SWIDTH (lface
);
4673 else if (EQ (keyword
, QCinherit
))
4674 value
= LFACE_INHERIT (lface
);
4675 else if (EQ (keyword
, QCfont
))
4676 value
= LFACE_FONT (lface
);
4678 signal_error ("Invalid face attribute name", keyword
);
4684 DEFUN ("internal-lisp-face-attribute-values",
4685 Finternal_lisp_face_attribute_values
,
4686 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4687 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4688 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4692 Lisp_Object result
= Qnil
;
4694 CHECK_SYMBOL (attr
);
4696 if (EQ (attr
, QCweight
)
4697 || EQ (attr
, QCslant
)
4698 || EQ (attr
, QCwidth
))
4700 /* Extract permissible symbols from tables. */
4701 struct table_entry
*table
;
4704 if (EQ (attr
, QCweight
))
4705 table
= weight_table
, dim
= DIM (weight_table
);
4706 else if (EQ (attr
, QCslant
))
4707 table
= slant_table
, dim
= DIM (slant_table
);
4709 table
= swidth_table
, dim
= DIM (swidth_table
);
4711 for (i
= 0; i
< dim
; ++i
)
4713 Lisp_Object symbol
= *table
[i
].symbol
;
4714 Lisp_Object tail
= result
;
4717 && !EQ (XCAR (tail
), symbol
))
4721 result
= Fcons (symbol
, result
);
4724 else if (EQ (attr
, QCunderline
))
4725 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4726 else if (EQ (attr
, QCoverline
))
4727 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4728 else if (EQ (attr
, QCstrike_through
))
4729 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4730 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4731 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4737 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4738 Sinternal_merge_in_global_face
, 2, 2, 0,
4739 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4740 Default face attributes override any local face attributes. */)
4742 Lisp_Object face
, frame
;
4745 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4747 CHECK_LIVE_FRAME (frame
);
4748 global_lface
= lface_from_face_name (NULL
, face
, 1);
4749 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4750 if (NILP (local_lface
))
4751 local_lface
= Finternal_make_lisp_face (face
, frame
);
4753 /* Make every specified global attribute override the local one.
4754 BEWARE!! This is only used from `face-set-after-frame-default' where
4755 the local frame is defined from default specs in `face-defface-spec'
4756 and those should be overridden by global settings. Hence the strange
4757 "global before local" priority. */
4758 lvec
= XVECTOR (local_lface
)->contents
;
4759 gvec
= XVECTOR (global_lface
)->contents
;
4760 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4761 if (! UNSPECIFIEDP (gvec
[i
]))
4768 /* The following function is implemented for compatibility with 20.2.
4769 The function is used in x-resolve-fonts when it is asked to
4770 return fonts with the same size as the font of a face. This is
4771 done in fontset.el. */
4773 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4774 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4775 If the optional argument FRAME is given, report on face FACE in that frame.
4776 If FRAME is t, report on the defaults for face FACE (for new frames).
4777 The font default for a face is either nil, or a list
4778 of the form (bold), (italic) or (bold italic).
4779 If FRAME is omitted or nil, use the selected frame. */)
4781 Lisp_Object face
, frame
;
4785 Lisp_Object result
= Qnil
;
4786 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4788 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4789 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4790 result
= Fcons (Qbold
, result
);
4792 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4793 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4794 result
= Fcons (Qitalic
, result
);
4800 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4801 int face_id
= lookup_named_face (f
, face
, 0);
4802 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4803 return face
? build_string (face
->font_name
) : Qnil
;
4808 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4809 all attributes are `equal'. Tries to be fast because this function
4810 is called quite often. */
4813 lface_equal_p (v1
, v2
)
4814 Lisp_Object
*v1
, *v2
;
4818 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4820 Lisp_Object a
= v1
[i
];
4821 Lisp_Object b
= v2
[i
];
4823 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4824 and the other is specified. */
4825 equal_p
= XTYPE (a
) == XTYPE (b
);
4834 equal_p
= ((SBYTES (a
)
4836 && bcmp (SDATA (a
), SDATA (b
),
4846 equal_p
= !NILP (Fequal (a
, b
));
4856 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4857 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4858 doc
: /* True if FACE1 and FACE2 are equal.
4859 If the optional argument FRAME is given, report on face FACE in that frame.
4860 If FRAME is t, report on the defaults for face FACE (for new frames).
4861 If FRAME is omitted or nil, use the selected frame. */)
4862 (face1
, face2
, frame
)
4863 Lisp_Object face1
, face2
, frame
;
4867 Lisp_Object lface1
, lface2
;
4872 /* Don't use check_x_frame here because this function is called
4873 before X frames exist. At that time, if FRAME is nil,
4874 selected_frame will be used which is the frame dumped with
4875 Emacs. That frame is not an X frame. */
4876 f
= frame_or_selected_frame (frame
, 2);
4878 lface1
= lface_from_face_name (NULL
, face1
, 1);
4879 lface2
= lface_from_face_name (NULL
, face2
, 1);
4880 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4881 XVECTOR (lface2
)->contents
);
4882 return equal_p
? Qt
: Qnil
;
4886 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4887 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4888 doc
: /* True if FACE has no attribute specified.
4889 If the optional argument FRAME is given, report on face FACE in that frame.
4890 If FRAME is t, report on the defaults for face FACE (for new frames).
4891 If FRAME is omitted or nil, use the selected frame. */)
4893 Lisp_Object face
, frame
;
4900 frame
= selected_frame
;
4901 CHECK_LIVE_FRAME (frame
);
4905 lface
= lface_from_face_name (NULL
, face
, 1);
4907 lface
= lface_from_face_name (f
, face
, 1);
4909 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4910 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4913 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4917 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4919 doc
: /* Return an alist of frame-local faces defined on FRAME.
4920 For internal use only. */)
4924 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4925 return f
->face_alist
;
4929 /* Return a hash code for Lisp string STRING with case ignored. Used
4930 below in computing a hash value for a Lisp face. */
4932 static INLINE
unsigned
4933 hash_string_case_insensitive (string
)
4936 const unsigned char *s
;
4938 xassert (STRINGP (string
));
4939 for (s
= SDATA (string
); *s
; ++s
)
4940 hash
= (hash
<< 1) ^ tolower (*s
);
4945 /* Return a hash code for face attribute vector V. */
4947 static INLINE
unsigned
4951 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4952 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4953 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4954 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4955 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4956 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4957 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4961 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4962 considering charsets/registries). They do if they specify the same
4963 family, point size, weight, width, slant, and fontset. Both LFACE1
4964 and LFACE2 must be fully-specified. */
4967 lface_same_font_attributes_p (lface1
, lface2
)
4968 Lisp_Object
*lface1
, *lface2
;
4970 xassert (lface_fully_specified_p (lface1
)
4971 && lface_fully_specified_p (lface2
));
4972 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
4973 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4974 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4975 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4976 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4977 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4978 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4979 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4980 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4981 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4982 && xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
4983 SDATA (lface2
[LFACE_FONT_INDEX
])))));
4988 /***********************************************************************
4990 ***********************************************************************/
4992 /* Allocate and return a new realized face for Lisp face attribute
4995 static struct face
*
4996 make_realized_face (attr
)
4999 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5000 bzero (face
, sizeof *face
);
5001 face
->ascii_face
= face
;
5002 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5007 /* Free realized face FACE, including its X resources. FACE may
5011 free_realized_face (f
, face
)
5017 #ifdef HAVE_WINDOW_SYSTEM
5018 if (FRAME_WINDOW_P (f
))
5020 /* Free fontset of FACE if it is ASCII face. */
5021 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5022 free_face_fontset (f
, face
);
5025 x_free_gc (f
, face
->gc
);
5029 free_face_colors (f
, face
);
5030 x_destroy_bitmap (f
, face
->stipple
);
5032 #endif /* HAVE_WINDOW_SYSTEM */
5039 /* Prepare face FACE for subsequent display on frame F. This
5040 allocated GCs if they haven't been allocated yet or have been freed
5041 by clearing the face cache. */
5044 prepare_face_for_display (f
, face
)
5048 #ifdef HAVE_WINDOW_SYSTEM
5049 xassert (FRAME_WINDOW_P (f
));
5054 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5056 xgcv
.foreground
= face
->foreground
;
5057 xgcv
.background
= face
->background
;
5058 #ifdef HAVE_X_WINDOWS
5059 xgcv
.graphics_exposures
= False
;
5061 /* The font of FACE may be null if we couldn't load it. */
5064 #ifdef HAVE_X_WINDOWS
5065 xgcv
.font
= face
->font
->fid
;
5068 xgcv
.font
= face
->font
;
5071 xgcv
.font
= face
->font
;
5077 #ifdef HAVE_X_WINDOWS
5080 xgcv
.fill_style
= FillOpaqueStippled
;
5081 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5082 mask
|= GCFillStyle
| GCStipple
;
5085 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5088 #endif /* HAVE_WINDOW_SYSTEM */
5092 /* Returns the `distance' between the colors X and Y. */
5095 color_distance (x
, y
)
5098 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5099 Quoting from that paper:
5101 This formula has results that are very close to L*u*v* (with the
5102 modified lightness curve) and, more importantly, it is a more even
5103 algorithm: it does not have a range of colours where it suddenly
5104 gives far from optimal results.
5106 See <http://www.compuphase.com/cmetric.htm> for more info. */
5108 long r
= (x
->red
- y
->red
) >> 8;
5109 long g
= (x
->green
- y
->green
) >> 8;
5110 long b
= (x
->blue
- y
->blue
) >> 8;
5111 long r_mean
= (x
->red
+ y
->red
) >> 9;
5114 (((512 + r_mean
) * r
* r
) >> 8)
5116 + (((767 - r_mean
) * b
* b
) >> 8);
5120 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5121 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5122 COLOR1 and COLOR2 may be either strings containing the color name,
5123 or lists of the form (RED GREEN BLUE).
5124 If FRAME is unspecified or nil, the current frame is used. */)
5125 (color1
, color2
, frame
)
5126 Lisp_Object color1
, color2
, frame
;
5129 XColor cdef1
, cdef2
;
5132 frame
= selected_frame
;
5133 CHECK_LIVE_FRAME (frame
);
5136 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5137 || !STRINGP (color1
)
5138 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5139 signal_error ("Invalid color", color1
);
5140 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5141 || !STRINGP (color2
)
5142 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5143 signal_error ("Invalid color", color2
);
5145 return make_number (color_distance (&cdef1
, &cdef2
));
5149 /***********************************************************************
5150 Face capability testing for ttys
5151 ***********************************************************************/
5154 /* If the distance (as returned by color_distance) between two colors is
5155 less than this, then they are considered the same, for determining
5156 whether a color is supported or not. The range of values is 0-65535. */
5158 #define TTY_SAME_COLOR_THRESHOLD 10000
5161 DEFUN ("tty-supports-face-attributes-p",
5162 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5164 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5165 The optional argument FRAME is the frame on which to test; if it is nil
5166 or unspecified, then the current frame is used. If FRAME is not a tty
5167 frame, then nil is returned.
5169 The definition of `supported' is somewhat heuristic, but basically means
5170 that a face containing all the attributes in ATTRIBUTES, when merged
5171 with the default face for display, can be represented in a way that's
5173 \(1) different in appearance than the default face, and
5174 \(2) `close in spirit' to what the attributes specify, if not exact.
5176 Point (2) implies that a `:weight black' attribute will be satisified
5177 by any terminal that can display bold, and a `:foreground "yellow"' as
5178 long as the terminal can display a yellowish color, but `:slant italic'
5179 will _not_ be satisified by the tty display code's automatic
5180 substitution of a `dim' face for italic. */)
5182 Lisp_Object attributes
, frame
;
5186 Lisp_Object val
, fg
, bg
;
5187 XColor fg_tty_color
, fg_std_color
;
5188 XColor bg_tty_color
, bg_std_color
;
5189 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5190 unsigned test_caps
= 0;
5193 frame
= selected_frame
;
5194 CHECK_LIVE_FRAME (frame
);
5197 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5198 attrs
[i
] = Qunspecified
;
5199 merge_face_vector_with_property (f
, attrs
, attributes
);
5201 /* This function only works on ttys. */
5202 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5205 /* First check some easy-to-check stuff; ttys support none of the
5206 following attributes, so we can just return nil if any are requested. */
5209 val
= attrs
[LFACE_STIPPLE_INDEX
];
5210 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5214 val
= attrs
[LFACE_HEIGHT_INDEX
];
5215 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5219 val
= attrs
[LFACE_SWIDTH_INDEX
];
5220 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5221 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5225 val
= attrs
[LFACE_OVERLINE_INDEX
];
5226 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5229 /* strike-through */
5230 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5231 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5235 val
= attrs
[LFACE_BOX_INDEX
];
5236 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5239 /* slant (italics/oblique); We consider any non-default value
5240 unsupportable on ttys, even though the face code actually `fakes'
5241 them using a dim attribute if possible. This is because the faked
5242 result is too different from what the face specifies. */
5243 val
= attrs
[LFACE_SLANT_INDEX
];
5244 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5245 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5249 /* Test for terminal `capabilities' (non-color character attributes). */
5251 /* font weight (bold/dim) */
5252 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5255 if (weight
> XLFD_WEIGHT_MEDIUM
)
5256 test_caps
= TTY_CAP_BOLD
;
5257 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5258 test_caps
= TTY_CAP_DIM
;
5262 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5263 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5266 return Qnil
; /* ttys don't support colored underlines */
5268 test_caps
|= TTY_CAP_UNDERLINE
;
5272 val
= attrs
[LFACE_INVERSE_INDEX
];
5273 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5274 test_caps
|= TTY_CAP_INVERSE
;
5277 /* Color testing. */
5279 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5280 we use them when calling `tty_capable_p' below, even if the face
5281 specifies no colors. */
5282 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5283 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5285 /* Check if foreground color is close enough. */
5286 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5289 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5291 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5292 > TTY_SAME_COLOR_THRESHOLD
)
5296 /* Check if background color is close enough. */
5297 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5300 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5302 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5303 > TTY_SAME_COLOR_THRESHOLD
)
5307 /* If both foreground and background are requested, see if the
5308 distance between them is OK. We just check to see if the distance
5309 between the tty's foreground and background is close enough to the
5310 distance between the standard foreground and background. */
5311 if (STRINGP (fg
) && STRINGP (bg
))
5314 = (color_distance (&fg_std_color
, &bg_std_color
)
5315 - color_distance (&fg_tty_color
, &bg_tty_color
));
5316 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5317 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5322 /* See if the capabilities we selected above are supported, with the
5324 if (test_caps
!= 0 &&
5325 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5329 /* Hmmm, everything checks out, this terminal must support this face. */
5335 /***********************************************************************
5337 ***********************************************************************/
5339 /* Return a new face cache for frame F. */
5341 static struct face_cache
*
5345 struct face_cache
*c
;
5348 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5349 bzero (c
, sizeof *c
);
5350 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5351 c
->buckets
= (struct face
**) xmalloc (size
);
5352 bzero (c
->buckets
, size
);
5354 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5356 c
->menu_face_changed_p
= menu_face_changed_default
;
5361 /* Clear out all graphics contexts for all realized faces, except for
5362 the basic faces. This should be done from time to time just to avoid
5363 keeping too many graphics contexts that are no longer needed. */
5367 struct face_cache
*c
;
5369 if (c
&& FRAME_WINDOW_P (c
->f
))
5371 #ifdef HAVE_WINDOW_SYSTEM
5373 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5375 struct face
*face
= c
->faces_by_id
[i
];
5376 if (face
&& face
->gc
)
5378 x_free_gc (c
->f
, face
->gc
);
5382 #endif /* HAVE_WINDOW_SYSTEM */
5387 /* Free all realized faces in face cache C, including basic faces. C
5388 may be null. If faces are freed, make sure the frame's current
5389 matrix is marked invalid, so that a display caused by an expose
5390 event doesn't try to use faces we destroyed. */
5393 free_realized_faces (c
)
5394 struct face_cache
*c
;
5399 struct frame
*f
= c
->f
;
5401 /* We must block input here because we can't process X events
5402 safely while only some faces are freed, or when the frame's
5403 current matrix still references freed faces. */
5406 for (i
= 0; i
< c
->used
; ++i
)
5408 free_realized_face (f
, c
->faces_by_id
[i
]);
5409 c
->faces_by_id
[i
] = NULL
;
5413 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5414 bzero (c
->buckets
, size
);
5416 /* Must do a thorough redisplay the next time. Mark current
5417 matrices as invalid because they will reference faces freed
5418 above. This function is also called when a frame is
5419 destroyed. In this case, the root window of F is nil. */
5420 if (WINDOWP (f
->root_window
))
5422 clear_current_matrices (f
);
5423 ++windows_or_buffers_changed
;
5431 /* Free all faces realized for multibyte characters on frame F that
5435 free_realized_multibyte_face (f
, fontset
)
5439 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5443 /* We must block input here because we can't process X events safely
5444 while only some faces are freed, or when the frame's current
5445 matrix still references freed faces. */
5448 for (i
= 0; i
< cache
->used
; i
++)
5450 face
= cache
->faces_by_id
[i
];
5452 && face
!= face
->ascii_face
5453 && face
->fontset
== fontset
)
5455 uncache_face (cache
, face
);
5456 free_realized_face (f
, face
);
5460 /* Must do a thorough redisplay the next time. Mark current
5461 matrices as invalid because they will reference faces freed
5462 above. This function is also called when a frame is destroyed.
5463 In this case, the root window of F is nil. */
5464 if (WINDOWP (f
->root_window
))
5466 clear_current_matrices (f
);
5467 ++windows_or_buffers_changed
;
5474 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5475 This is done after attributes of a named face have been changed,
5476 because we can't tell which realized faces depend on that face. */
5479 free_all_realized_faces (frame
)
5485 FOR_EACH_FRAME (rest
, frame
)
5486 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5489 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5493 /* Free face cache C and faces in it, including their X resources. */
5497 struct face_cache
*c
;
5501 free_realized_faces (c
);
5503 xfree (c
->faces_by_id
);
5509 /* Cache realized face FACE in face cache C. HASH is the hash value
5510 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5511 collision list of the face hash table of C. This is done because
5512 otherwise lookup_face would find FACE for every character, even if
5513 faces with the same attributes but for specific characters exist. */
5516 cache_face (c
, face
, hash
)
5517 struct face_cache
*c
;
5521 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5525 if (face
->fontset
>= 0)
5527 struct face
*last
= c
->buckets
[i
];
5538 c
->buckets
[i
] = face
;
5539 face
->prev
= face
->next
= NULL
;
5545 face
->next
= c
->buckets
[i
];
5547 face
->next
->prev
= face
;
5548 c
->buckets
[i
] = face
;
5551 /* Find a free slot in C->faces_by_id and use the index of the free
5552 slot as FACE->id. */
5553 for (i
= 0; i
< c
->used
; ++i
)
5554 if (c
->faces_by_id
[i
] == NULL
)
5558 /* Maybe enlarge C->faces_by_id. */
5559 if (i
== c
->used
&& c
->used
== c
->size
)
5561 int new_size
= 2 * c
->size
;
5562 int sz
= new_size
* sizeof *c
->faces_by_id
;
5563 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5568 /* Check that FACE got a unique id. */
5573 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5574 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5580 #endif /* GLYPH_DEBUG */
5582 c
->faces_by_id
[i
] = face
;
5588 /* Remove face FACE from cache C. */
5591 uncache_face (c
, face
)
5592 struct face_cache
*c
;
5595 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5598 face
->prev
->next
= face
->next
;
5600 c
->buckets
[i
] = face
->next
;
5603 face
->next
->prev
= face
->prev
;
5605 c
->faces_by_id
[face
->id
] = NULL
;
5606 if (face
->id
== c
->used
)
5611 /* Look up a realized face with face attributes ATTR in the face cache
5612 of frame F. The face will be used to display character C. Value
5613 is the ID of the face found. If no suitable face is found, realize
5614 a new one. In that case, if C is a multibyte character, BASE_FACE
5615 is a face that has the same attributes. */
5618 lookup_face (f
, attr
, c
, base_face
)
5622 struct face
*base_face
;
5624 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5629 xassert (cache
!= NULL
);
5630 check_lface_attrs (attr
);
5632 /* Look up ATTR in the face cache. */
5633 hash
= lface_hash (attr
);
5634 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5636 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5637 if (face
->hash
== hash
5638 && (!FRAME_WINDOW_P (f
)
5639 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5640 && lface_equal_p (face
->lface
, attr
))
5643 /* If not found, realize a new face. */
5645 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5648 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5650 /* When this function is called from face_for_char (in this case, C is
5651 a multibyte character), a fontset of a face returned by
5652 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5653 C) is not sutisfied. The fontset is set for this face by
5654 face_for_char later. */
5656 if (FRAME_WINDOW_P (f
))
5657 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5659 #endif /* GLYPH_DEBUG */
5665 /* Return the face id of the realized face for named face SYMBOL on
5666 frame F suitable for displaying character C. Value is -1 if the
5667 face couldn't be determined, which might happen if the default face
5668 isn't realized and cannot be realized. */
5671 lookup_named_face (f
, symbol
, c
)
5676 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5677 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5678 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5680 if (default_face
== NULL
)
5682 if (!realize_basic_faces (f
))
5684 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5687 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5688 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5689 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5690 return lookup_face (f
, attrs
, c
, NULL
);
5694 /* Return the ID of the realized ASCII face of Lisp face with ID
5695 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5698 ascii_face_of_lisp_face (f
, lface_id
)
5704 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5706 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5707 face_id
= lookup_named_face (f
, face_name
, 0);
5716 /* Return a face for charset ASCII that is like the face with id
5717 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5718 STEPS < 0 means larger. Value is the id of the face. */
5721 smaller_face (f
, face_id
, steps
)
5725 #ifdef HAVE_WINDOW_SYSTEM
5727 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5728 int pt
, last_pt
, last_height
;
5731 struct face
*new_face
;
5733 /* If not called for an X frame, just return the original face. */
5734 if (FRAME_TERMCAP_P (f
))
5737 /* Try in increments of 1/2 pt. */
5738 delta
= steps
< 0 ? 5 : -5;
5739 steps
= abs (steps
);
5741 face
= FACE_FROM_ID (f
, face_id
);
5742 bcopy (face
->lface
, attrs
, sizeof attrs
);
5743 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5744 new_face_id
= face_id
;
5745 last_height
= FONT_HEIGHT (face
->font
);
5749 /* Give up if we cannot find a font within 10pt. */
5750 && abs (last_pt
- pt
) < 100)
5752 /* Look up a face for a slightly smaller/larger font. */
5754 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5755 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5756 new_face
= FACE_FROM_ID (f
, new_face_id
);
5758 /* If height changes, count that as one step. */
5759 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5760 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5763 last_height
= FONT_HEIGHT (new_face
->font
);
5770 #else /* not HAVE_WINDOW_SYSTEM */
5774 #endif /* not HAVE_WINDOW_SYSTEM */
5778 /* Return a face for charset ASCII that is like the face with id
5779 FACE_ID on frame F, but has height HEIGHT. */
5782 face_with_height (f
, face_id
, height
)
5787 #ifdef HAVE_WINDOW_SYSTEM
5789 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5791 if (FRAME_TERMCAP_P (f
)
5795 face
= FACE_FROM_ID (f
, face_id
);
5796 bcopy (face
->lface
, attrs
, sizeof attrs
);
5797 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5798 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5799 #endif /* HAVE_WINDOW_SYSTEM */
5805 /* Return the face id of the realized face for named face SYMBOL on
5806 frame F suitable for displaying character C, and use attributes of
5807 the face FACE_ID for attributes that aren't completely specified by
5808 SYMBOL. This is like lookup_named_face, except that the default
5809 attributes come from FACE_ID, not from the default face. FACE_ID
5810 is assumed to be already realized. */
5813 lookup_derived_face (f
, symbol
, c
, face_id
)
5819 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5820 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5821 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5826 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5827 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5828 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5829 return lookup_face (f
, attrs
, c
, default_face
);
5832 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5833 Sface_attributes_as_vector
, 1, 1, 0,
5834 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5839 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5841 merge_face_vector_with_property (XFRAME (selected_frame
),
5842 XVECTOR (lface
)->contents
,
5849 /***********************************************************************
5851 ***********************************************************************/
5853 DEFUN ("internal-set-font-selection-order",
5854 Finternal_set_font_selection_order
,
5855 Sinternal_set_font_selection_order
, 1, 1, 0,
5856 doc
: /* Set font selection order for face font selection to ORDER.
5857 ORDER must be a list of length 4 containing the symbols `:width',
5858 `:height', `:weight', and `:slant'. Face attributes appearing
5859 first in ORDER are matched first, e.g. if `:height' appears before
5860 `:weight' in ORDER, font selection first tries to find a font with
5861 a suitable height, and then tries to match the font weight.
5868 int indices
[DIM (font_sort_order
)];
5871 bzero (indices
, sizeof indices
);
5875 CONSP (list
) && i
< DIM (indices
);
5876 list
= XCDR (list
), ++i
)
5878 Lisp_Object attr
= XCAR (list
);
5881 if (EQ (attr
, QCwidth
))
5883 else if (EQ (attr
, QCheight
))
5884 xlfd
= XLFD_POINT_SIZE
;
5885 else if (EQ (attr
, QCweight
))
5887 else if (EQ (attr
, QCslant
))
5892 if (indices
[i
] != 0)
5897 if (!NILP (list
) || i
!= DIM (indices
))
5898 signal_error ("Invalid font sort order", order
);
5899 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5900 if (indices
[i
] == 0)
5901 signal_error ("Invalid font sort order", order
);
5903 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5905 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5906 free_all_realized_faces (Qnil
);
5913 DEFUN ("internal-set-alternative-font-family-alist",
5914 Finternal_set_alternative_font_family_alist
,
5915 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5916 doc
: /* Define alternative font families to try in face font selection.
5917 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5918 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5919 be found. Value is ALIST. */)
5924 Vface_alternative_font_family_alist
= alist
;
5925 free_all_realized_faces (Qnil
);
5930 DEFUN ("internal-set-alternative-font-registry-alist",
5931 Finternal_set_alternative_font_registry_alist
,
5932 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5933 doc
: /* Define alternative font registries to try in face font selection.
5934 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5935 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5936 be found. Value is ALIST. */)
5941 Vface_alternative_font_registry_alist
= alist
;
5942 free_all_realized_faces (Qnil
);
5947 #ifdef HAVE_WINDOW_SYSTEM
5949 /* Value is non-zero if FONT is the name of a scalable font. The
5950 X11R6 XLFD spec says that point size, pixel size, and average width
5951 are zero for scalable fonts. Intlfonts contain at least one
5952 scalable font ("*-muleindian-1") for which this isn't true, so we
5953 just test average width. */
5956 font_scalable_p (font
)
5957 struct font_name
*font
;
5959 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5960 return (*s
== '0' && *(s
+ 1) == '\0')
5962 /* Windows implementation of XLFD is slightly broken for backward
5963 compatibility with previous broken versions, so test for
5964 wildcards as well as 0. */
5971 /* Ignore the difference of font point size less than this value. */
5973 #define FONT_POINT_SIZE_QUANTUM 5
5975 /* Value is non-zero if FONT1 is a better match for font attributes
5976 VALUES than FONT2. VALUES is an array of face attribute values in
5977 font sort order. COMPARE_PT_P zero means don't compare point
5978 sizes. AVGWIDTH, if not zero, is a specified font average width
5982 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5984 struct font_name
*font1
, *font2
;
5985 int compare_pt_p
, avgwidth
;
5989 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5991 int xlfd_idx
= font_sort_order
[i
];
5993 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5995 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5996 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5998 if (xlfd_idx
== XLFD_POINT_SIZE
5999 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6001 if (delta1
> delta2
)
6003 else if (delta1
< delta2
)
6007 /* The difference may be equal because, e.g., the face
6008 specifies `italic' but we have only `regular' and
6009 `oblique'. Prefer `oblique' in this case. */
6010 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6011 && font1
->numeric
[xlfd_idx
] > values
[i
]
6012 && font2
->numeric
[xlfd_idx
] < values
[i
])
6020 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6021 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6022 if (delta1
> delta2
)
6024 else if (delta1
< delta2
)
6028 return font1
->registry_priority
< font2
->registry_priority
;
6032 /* Value is non-zero if FONT is an exact match for face attributes in
6033 SPECIFIED. SPECIFIED is an array of face attribute values in font
6034 sort order. AVGWIDTH, if non-zero, is an average width to compare
6038 exact_face_match_p (specified
, font
, avgwidth
)
6040 struct font_name
*font
;
6045 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6046 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6049 return (i
== DIM (font_sort_order
)
6051 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6055 /* Value is the name of a scaled font, generated from scalable font
6056 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6057 Value is allocated from heap. */
6060 build_scalable_font_name (f
, font
, specified_pt
)
6062 struct font_name
*font
;
6065 char point_size
[20], pixel_size
[20];
6067 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6070 /* If scalable font is for a specific resolution, compute
6071 the point size we must specify from the resolution of
6072 the display and the specified resolution of the font. */
6073 if (font
->numeric
[XLFD_RESY
] != 0)
6075 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6076 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6081 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6084 /* Set point size of the font. */
6085 sprintf (point_size
, "%d", (int) pt
);
6086 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6087 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6089 /* Set pixel size. */
6090 sprintf (pixel_size
, "%d", pixel_value
);
6091 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6092 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6094 /* If font doesn't specify its resolution, use the
6095 resolution of the display. */
6096 if (font
->numeric
[XLFD_RESY
] == 0)
6099 sprintf (buffer
, "%d", (int) resy
);
6100 font
->fields
[XLFD_RESY
] = buffer
;
6101 font
->numeric
[XLFD_RESY
] = resy
;
6104 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6107 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6108 sprintf (buffer
, "%d", resx
);
6109 font
->fields
[XLFD_RESX
] = buffer
;
6110 font
->numeric
[XLFD_RESX
] = resx
;
6113 return build_font_name (font
);
6117 /* Value is non-zero if we are allowed to use scalable font FONT. We
6118 can't run a Lisp function here since this function may be called
6119 with input blocked. */
6122 may_use_scalable_font_p (font
)
6125 if (EQ (Vscalable_fonts_allowed
, Qt
))
6127 else if (CONSP (Vscalable_fonts_allowed
))
6129 Lisp_Object tail
, regexp
;
6131 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6133 regexp
= XCAR (tail
);
6134 if (STRINGP (regexp
)
6135 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6145 /* Return the name of the best matching font for face attributes ATTRS
6146 in the array of font_name structures FONTS which contains NFONTS
6147 elements. WIDTH_RATIO is a factor with which to multiply average
6148 widths if ATTRS specifies such a width.
6150 Value is a font name which is allocated from the heap. FONTS is
6151 freed by this function.
6153 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6154 indicate whether the resulting font should be drawn using overstrike
6155 to simulate bold-face. */
6158 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6161 struct font_name
*fonts
;
6164 int *needs_overstrike
;
6167 struct font_name
*best
;
6170 int exact_p
, avgwidth
;
6175 /* Make specified font attributes available in `specified',
6176 indexed by sort order. */
6177 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6179 int xlfd_idx
= font_sort_order
[i
];
6181 if (xlfd_idx
== XLFD_SWIDTH
)
6182 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6183 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6184 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6185 else if (xlfd_idx
== XLFD_WEIGHT
)
6186 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6187 else if (xlfd_idx
== XLFD_SLANT
)
6188 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6193 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6195 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6199 if (needs_overstrike
)
6200 *needs_overstrike
= 0;
6202 /* Start with the first non-scalable font in the list. */
6203 for (i
= 0; i
< nfonts
; ++i
)
6204 if (!font_scalable_p (fonts
+ i
))
6207 /* Find the best match among the non-scalable fonts. */
6212 for (i
= 1; i
< nfonts
; ++i
)
6213 if (!font_scalable_p (fonts
+ i
)
6214 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6218 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6226 /* Unless we found an exact match among non-scalable fonts, see if
6227 we can find a better match among scalable fonts. */
6230 /* A scalable font is better if
6232 1. its weight, slant, swidth attributes are better, or.
6234 2. the best non-scalable font doesn't have the required
6235 point size, and the scalable fonts weight, slant, swidth
6238 int non_scalable_has_exact_height_p
;
6240 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6241 non_scalable_has_exact_height_p
= 1;
6243 non_scalable_has_exact_height_p
= 0;
6245 for (i
= 0; i
< nfonts
; ++i
)
6246 if (font_scalable_p (fonts
+ i
))
6249 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6250 || (!non_scalable_has_exact_height_p
6251 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6255 if (needs_overstrike
)
6257 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6258 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6260 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6262 /* We want a bold font, but didn't get one; try to use
6263 overstriking instead to simulate bold-face. However,
6264 don't overstrike an already-bold fontn unless the
6265 desired weight grossly exceeds the available weight. */
6266 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6267 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6269 *needs_overstrike
= 1;
6274 if (font_scalable_p (best
))
6275 font_name
= build_scalable_font_name (f
, best
, pt
);
6277 font_name
= build_font_name (best
);
6279 /* Free font_name structures. */
6280 free_font_names (fonts
, nfonts
);
6286 /* Get a list of matching fonts on frame F, considering FAMILY
6287 and alternative font families from Vface_alternative_font_registry_alist.
6289 FAMILY is the font family whose alternatives are considered.
6291 REGISTRY, if a string, specifies a font registry and encoding to
6292 match. A value of nil means include fonts of any registry and
6295 Return in *FONTS a pointer to a vector of font_name structures for
6296 the fonts matched. Value is the number of fonts found. */
6299 try_alternative_families (f
, family
, registry
, fonts
)
6301 Lisp_Object family
, registry
;
6302 struct font_name
**fonts
;
6307 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6310 /* Try alternative font families. */
6311 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6314 for (alter
= XCDR (alter
);
6315 CONSP (alter
) && nfonts
== 0;
6316 alter
= XCDR (alter
))
6318 if (STRINGP (XCAR (alter
)))
6319 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6323 /* Try all scalable fonts before giving up. */
6324 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6326 int count
= SPECPDL_INDEX ();
6327 specbind (Qscalable_fonts_allowed
, Qt
);
6328 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6329 unbind_to (count
, Qnil
);
6336 /* Get a list of matching fonts on frame F.
6338 FAMILY, if a string, specifies a font family derived from the fontset.
6339 It is only used if the face does not specify any family in ATTRS or
6340 if we cannot find any font of the face's family.
6342 REGISTRY, if a string, specifies a font registry and encoding to
6343 match. A value of nil means include fonts of any registry and
6346 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6347 Otherwise, prefer FAMILY.
6349 Return in *FONTS a pointer to a vector of font_name structures for
6350 the fonts matched. Value is the number of fonts found. */
6353 try_font_list (f
, attrs
, family
, registry
, fonts
, prefer_face_family
)
6356 Lisp_Object family
, registry
;
6357 struct font_name
**fonts
;
6358 int prefer_face_family
;
6361 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6362 Lisp_Object try_family
;
6364 try_family
= (prefer_face_family
|| NILP (family
)) ? face_family
: family
;
6366 if (STRINGP (try_family
))
6367 nfonts
= try_alternative_families (f
, try_family
, registry
, fonts
);
6370 /* When realizing the default face and a font spec does not matched
6371 exactly, Emacs looks for ones with the same registry as the
6372 default font. On the Mac, this is mac-roman, which does not work
6373 if the family is -etl-fixed, e.g. The following widens the
6374 choices and fixes that problem. */
6375 if (nfonts
== 0 && STRINGP (try_family
) && STRINGP (registry
)
6376 && xstricmp (SDATA (registry
), "mac-roman") == 0)
6377 nfonts
= try_alternative_families (f
, try_family
, Qnil
, fonts
);
6380 if (EQ (try_family
, family
))
6381 family
= face_family
;
6383 if (nfonts
== 0 && STRINGP (family
))
6384 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6386 /* Try font family of the default face or "fixed". */
6389 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6391 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6393 family
= build_string ("fixed");
6394 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6397 /* Try any family with the given registry. */
6399 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6405 /* Return the fontset id of the base fontset name or alias name given
6406 by the fontset attribute of ATTRS. Value is -1 if the fontset
6407 attribute of ATTRS doesn't name a fontset. */
6410 face_fontset (attrs
)
6415 name
= attrs
[LFACE_FONT_INDEX
];
6416 if (!STRINGP (name
))
6418 return fs_query_fontset (name
, 0);
6422 /* Choose a name of font to use on frame F to display character C with
6423 Lisp face attributes specified by ATTRS. The font name is
6424 determined by the font-related attributes in ATTRS and the name
6425 pattern for C in FONTSET. Value is the font name which is
6426 allocated from the heap and must be freed by the caller, or NULL if
6427 we can get no information about the font name of C. It is assured
6428 that we always get some information for a single byte
6431 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6432 indicate whether the resulting font should be drawn using overstrike
6433 to simulate bold-face. */
6436 choose_face_font (f
, attrs
, fontset
, c
, needs_overstrike
)
6440 int *needs_overstrike
;
6442 Lisp_Object pattern
;
6443 char *font_name
= NULL
;
6444 struct font_name
*fonts
;
6445 int nfonts
, width_ratio
;
6447 /* Get (foundry and) family name and registry (and encoding) name of
6449 pattern
= fontset_font_pattern (f
, fontset
, c
);
6452 xassert (!SINGLE_BYTE_CHAR_P (c
));
6456 /* If what we got is a name pattern, return it. */
6457 if (STRINGP (pattern
))
6458 return xstrdup (SDATA (pattern
));
6460 /* Get a list of fonts matching that pattern and choose the
6461 best match for the specified face attributes from it. */
6462 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
,
6463 (SINGLE_BYTE_CHAR_P (c
)
6464 || CHAR_CHARSET (c
) == charset_latin_iso8859_1
));
6465 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6467 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6468 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
,
6473 #endif /* HAVE_WINDOW_SYSTEM */
6477 /***********************************************************************
6479 ***********************************************************************/
6481 /* Realize basic faces on frame F. Value is zero if frame parameters
6482 of F don't contain enough information needed to realize the default
6486 realize_basic_faces (f
)
6490 int count
= SPECPDL_INDEX ();
6492 /* Block input here so that we won't be surprised by an X expose
6493 event, for instance, without having the faces set up. */
6495 specbind (Qscalable_fonts_allowed
, Qt
);
6497 if (realize_default_face (f
))
6499 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6500 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6501 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6502 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6503 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6504 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6505 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6506 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6507 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6508 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6510 /* Reflect changes in the `menu' face in menu bars. */
6511 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6513 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6514 #ifdef USE_X_TOOLKIT
6515 x_update_menu_appearance (f
);
6522 unbind_to (count
, Qnil
);
6528 /* Realize the default face on frame F. If the face is not fully
6529 specified, make it fully-specified. Attributes of the default face
6530 that are not explicitly specified are taken from frame parameters. */
6533 realize_default_face (f
)
6536 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6538 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6539 Lisp_Object frame_font
;
6542 /* If the `default' face is not yet known, create it. */
6543 lface
= lface_from_face_name (f
, Qdefault
, 0);
6547 XSETFRAME (frame
, f
);
6548 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6551 #ifdef HAVE_WINDOW_SYSTEM
6552 if (FRAME_WINDOW_P (f
))
6554 /* Set frame_font to the value of the `font' frame parameter. */
6555 frame_font
= Fassq (Qfont
, f
->param_alist
);
6556 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6557 frame_font
= XCDR (frame_font
);
6558 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6560 #endif /* HAVE_WINDOW_SYSTEM */
6562 if (!FRAME_WINDOW_P (f
))
6564 LFACE_FAMILY (lface
) = build_string ("default");
6565 LFACE_SWIDTH (lface
) = Qnormal
;
6566 LFACE_HEIGHT (lface
) = make_number (1);
6567 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6568 LFACE_WEIGHT (lface
) = Qnormal
;
6569 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6570 LFACE_SLANT (lface
) = Qnormal
;
6571 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6574 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6575 LFACE_UNDERLINE (lface
) = Qnil
;
6577 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6578 LFACE_OVERLINE (lface
) = Qnil
;
6580 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6581 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6583 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6584 LFACE_BOX (lface
) = Qnil
;
6586 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6587 LFACE_INVERSE (lface
) = Qnil
;
6589 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6591 /* This function is called so early that colors are not yet
6592 set in the frame parameter list. */
6593 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6595 if (CONSP (color
) && STRINGP (XCDR (color
)))
6596 LFACE_FOREGROUND (lface
) = XCDR (color
);
6597 else if (FRAME_WINDOW_P (f
))
6599 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6600 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6605 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6607 /* This function is called so early that colors are not yet
6608 set in the frame parameter list. */
6609 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6610 if (CONSP (color
) && STRINGP (XCDR (color
)))
6611 LFACE_BACKGROUND (lface
) = XCDR (color
);
6612 else if (FRAME_WINDOW_P (f
))
6614 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6615 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6620 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6621 LFACE_STIPPLE (lface
) = Qnil
;
6623 /* Realize the face; it must be fully-specified now. */
6624 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6625 check_lface (lface
);
6626 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6627 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6632 /* Realize basic faces other than the default face in face cache C.
6633 SYMBOL is the face name, ID is the face id the realized face must
6634 have. The default face must have been realized already. */
6637 realize_named_face (f
, symbol
, id
)
6642 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6643 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6644 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6645 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6646 struct face
*new_face
;
6648 /* The default face must exist and be fully specified. */
6649 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6650 check_lface_attrs (attrs
);
6651 xassert (lface_fully_specified_p (attrs
));
6653 /* If SYMBOL isn't know as a face, create it. */
6657 XSETFRAME (frame
, f
);
6658 lface
= Finternal_make_lisp_face (symbol
, frame
);
6661 /* Merge SYMBOL's face with the default face. */
6662 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6663 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6665 /* Realize the face. */
6666 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6670 /* Realize the fully-specified face with attributes ATTRS in face
6671 cache CACHE for character C. If C is a multibyte character,
6672 BASE_FACE is a face that has the same attributes. Otherwise,
6673 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6674 ID of face to remove before caching the new face. Value is a
6675 pointer to the newly created realized face. */
6677 static struct face
*
6678 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6679 struct face_cache
*cache
;
6682 struct face
*base_face
;
6687 /* LFACE must be fully specified. */
6688 xassert (cache
!= NULL
);
6689 check_lface_attrs (attrs
);
6691 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6693 /* Remove the former face. */
6694 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6695 uncache_face (cache
, former_face
);
6696 free_realized_face (cache
->f
, former_face
);
6699 if (FRAME_WINDOW_P (cache
->f
))
6700 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6701 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6702 face
= realize_tty_face (cache
, attrs
, c
);
6706 /* Insert the new face. */
6707 cache_face (cache
, face
, lface_hash (attrs
));
6708 #ifdef HAVE_WINDOW_SYSTEM
6709 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6710 load_face_font (cache
->f
, face
, c
);
6711 #endif /* HAVE_WINDOW_SYSTEM */
6716 /* Realize the fully-specified face with attributes ATTRS in face
6717 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6718 a multibyte character, BASE_FACE is a face that has the same
6719 attributes. Otherwise, BASE_FACE is ignored. If the new face
6720 doesn't share font with the default face, a fontname is allocated
6721 from the heap and set in `font_name' of the new face, but it is not
6722 yet loaded here. Value is a pointer to the newly created realized
6725 static struct face
*
6726 realize_x_face (cache
, attrs
, c
, base_face
)
6727 struct face_cache
*cache
;
6730 struct face
*base_face
;
6732 #ifdef HAVE_WINDOW_SYSTEM
6733 struct face
*face
, *default_face
;
6735 Lisp_Object stipple
, overline
, strike_through
, box
;
6737 xassert (FRAME_WINDOW_P (cache
->f
));
6738 xassert (SINGLE_BYTE_CHAR_P (c
)
6741 /* Allocate a new realized face. */
6742 face
= make_realized_face (attrs
);
6746 /* If C is a multibyte character, we share all face attirbutes with
6747 BASE_FACE including the realized fontset. But, we must load a
6749 if (!SINGLE_BYTE_CHAR_P (c
))
6751 bcopy (base_face
, face
, sizeof *face
);
6754 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6755 face
->colors_copied_bitwise_p
= 1;
6757 /* to force realize_face to load font */
6762 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6764 /* Determine the font to use. Most of the time, the font will be
6765 the same as the font of the default face, so try that first. */
6766 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6768 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6769 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6771 face
->font
= default_face
->font
;
6772 face
->fontset
= default_face
->fontset
;
6773 face
->font_info_id
= default_face
->font_info_id
;
6774 face
->font_name
= default_face
->font_name
;
6775 face
->ascii_face
= face
;
6777 /* But, as we can't share the fontset, make a new realized
6778 fontset that has the same base fontset as of the default
6781 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6785 /* If the face attribute ATTRS specifies a fontset, use it as
6786 the base of a new realized fontset. Otherwise, use the same
6787 base fontset as of the default face. The base determines
6788 registry and encoding of a font. It may also determine
6789 foundry and family. The other fields of font name pattern
6790 are constructed from ATTRS. */
6791 int fontset
= face_fontset (attrs
);
6793 if ((fontset
== -1) && default_face
)
6794 fontset
= default_face
->fontset
;
6795 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6796 face
->font
= NULL
; /* to force realize_face to load font */
6799 /* Load colors, and set remaining attributes. */
6801 load_face_colors (f
, face
, attrs
);
6804 box
= attrs
[LFACE_BOX_INDEX
];
6807 /* A simple box of line width 1 drawn in color given by
6809 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6811 face
->box
= FACE_SIMPLE_BOX
;
6812 face
->box_line_width
= 1;
6814 else if (INTEGERP (box
))
6816 /* Simple box of specified line width in foreground color of the
6818 xassert (XINT (box
) != 0);
6819 face
->box
= FACE_SIMPLE_BOX
;
6820 face
->box_line_width
= XINT (box
);
6821 face
->box_color
= face
->foreground
;
6822 face
->box_color_defaulted_p
= 1;
6824 else if (CONSP (box
))
6826 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6827 being one of `raised' or `sunken'. */
6828 face
->box
= FACE_SIMPLE_BOX
;
6829 face
->box_color
= face
->foreground
;
6830 face
->box_color_defaulted_p
= 1;
6831 face
->box_line_width
= 1;
6835 Lisp_Object keyword
, value
;
6837 keyword
= XCAR (box
);
6845 if (EQ (keyword
, QCline_width
))
6847 if (INTEGERP (value
) && XINT (value
) != 0)
6848 face
->box_line_width
= XINT (value
);
6850 else if (EQ (keyword
, QCcolor
))
6852 if (STRINGP (value
))
6854 face
->box_color
= load_color (f
, face
, value
,
6856 face
->use_box_color_for_shadows_p
= 1;
6859 else if (EQ (keyword
, QCstyle
))
6861 if (EQ (value
, Qreleased_button
))
6862 face
->box
= FACE_RAISED_BOX
;
6863 else if (EQ (value
, Qpressed_button
))
6864 face
->box
= FACE_SUNKEN_BOX
;
6869 /* Text underline, overline, strike-through. */
6871 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6873 /* Use default color (same as foreground color). */
6874 face
->underline_p
= 1;
6875 face
->underline_defaulted_p
= 1;
6876 face
->underline_color
= 0;
6878 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6880 /* Use specified color. */
6881 face
->underline_p
= 1;
6882 face
->underline_defaulted_p
= 0;
6883 face
->underline_color
6884 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6885 LFACE_UNDERLINE_INDEX
);
6887 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6889 face
->underline_p
= 0;
6890 face
->underline_defaulted_p
= 0;
6891 face
->underline_color
= 0;
6894 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6895 if (STRINGP (overline
))
6897 face
->overline_color
6898 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6899 LFACE_OVERLINE_INDEX
);
6900 face
->overline_p
= 1;
6902 else if (EQ (overline
, Qt
))
6904 face
->overline_color
= face
->foreground
;
6905 face
->overline_color_defaulted_p
= 1;
6906 face
->overline_p
= 1;
6909 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6910 if (STRINGP (strike_through
))
6912 face
->strike_through_color
6913 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6914 LFACE_STRIKE_THROUGH_INDEX
);
6915 face
->strike_through_p
= 1;
6917 else if (EQ (strike_through
, Qt
))
6919 face
->strike_through_color
= face
->foreground
;
6920 face
->strike_through_color_defaulted_p
= 1;
6921 face
->strike_through_p
= 1;
6924 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6925 if (!NILP (stipple
))
6926 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6928 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6930 #endif /* HAVE_WINDOW_SYSTEM */
6934 /* Map a specified color of face FACE on frame F to a tty color index.
6935 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6936 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6937 default foreground/background colors. */
6940 map_tty_color (f
, face
, idx
, defaulted
)
6943 enum lface_attribute_index idx
;
6946 Lisp_Object frame
, color
, def
;
6947 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6948 unsigned long default_pixel
, default_other_pixel
, pixel
;
6950 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6954 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6955 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6959 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6960 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6963 XSETFRAME (frame
, f
);
6964 color
= face
->lface
[idx
];
6968 && CONSP (Vtty_defined_color_alist
)
6969 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6972 /* Associations in tty-defined-color-alist are of the form
6973 (NAME INDEX R G B). We need the INDEX part. */
6974 pixel
= XINT (XCAR (XCDR (def
)));
6977 if (pixel
== default_pixel
&& STRINGP (color
))
6979 pixel
= load_color (f
, face
, color
, idx
);
6981 #if defined (MSDOS) || defined (WINDOWSNT)
6982 /* If the foreground of the default face is the default color,
6983 use the foreground color defined by the frame. */
6985 if (FRAME_MSDOS_P (f
))
6988 if (pixel
== default_pixel
6989 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6992 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6994 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6995 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6998 else if (pixel
== default_other_pixel
)
7001 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7003 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7004 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7010 #endif /* MSDOS or WINDOWSNT */
7014 face
->foreground
= pixel
;
7016 face
->background
= pixel
;
7020 /* Realize the fully-specified face with attributes ATTRS in face
7021 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7022 pointer to the newly created realized face. */
7024 static struct face
*
7025 realize_tty_face (cache
, attrs
, c
)
7026 struct face_cache
*cache
;
7032 int face_colors_defaulted
= 0;
7033 struct frame
*f
= cache
->f
;
7035 /* Frame must be a termcap frame. */
7036 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7038 /* Allocate a new realized face. */
7039 face
= make_realized_face (attrs
);
7040 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7042 /* Map face attributes to TTY appearances. We map slant to
7043 dimmed text because we want italic text to appear differently
7044 and because dimmed text is probably used infrequently. */
7045 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7046 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7048 if (weight
> XLFD_WEIGHT_MEDIUM
)
7049 face
->tty_bold_p
= 1;
7050 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7051 face
->tty_dim_p
= 1;
7052 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7053 face
->tty_underline_p
= 1;
7054 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7055 face
->tty_reverse_p
= 1;
7057 /* Map color names to color indices. */
7058 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7059 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7061 /* Swap colors if face is inverse-video. If the colors are taken
7062 from the frame colors, they are already inverted, since the
7063 frame-creation function calls x-handle-reverse-video. */
7064 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7066 unsigned long tem
= face
->foreground
;
7067 face
->foreground
= face
->background
;
7068 face
->background
= tem
;
7071 if (tty_suppress_bold_inverse_default_colors_p
7073 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7074 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7075 face
->tty_bold_p
= 0;
7081 DEFUN ("tty-suppress-bold-inverse-default-colors",
7082 Ftty_suppress_bold_inverse_default_colors
,
7083 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7084 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7085 SUPPRESS non-nil means suppress it.
7086 This affects bold faces on TTYs whose foreground is the default background
7087 color of the display and whose background is the default foreground color.
7088 For such faces, the bold face attribute is ignored if this variable
7091 Lisp_Object suppress
;
7093 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7094 ++face_change_count
;
7100 /***********************************************************************
7102 ***********************************************************************/
7104 /* Return the ID of the face to use to display character CH with face
7105 property PROP on frame F in current_buffer. */
7108 compute_char_face (f
, ch
, prop
)
7115 if (NILP (current_buffer
->enable_multibyte_characters
))
7120 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7121 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7125 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7126 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7127 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7128 merge_face_vector_with_property (f
, attrs
, prop
);
7129 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
7135 /* Return the face ID associated with buffer position POS for
7136 displaying ASCII characters. Return in *ENDPTR the position at
7137 which a different face is needed, as far as text properties and
7138 overlays are concerned. W is a window displaying current_buffer.
7140 REGION_BEG, REGION_END delimit the region, so it can be
7143 LIMIT is a position not to scan beyond. That is to limit the time
7144 this function can take.
7146 If MOUSE is non-zero, use the character's mouse-face, not its face.
7148 The face returned is suitable for displaying ASCII characters. */
7151 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7152 endptr
, limit
, mouse
)
7155 int region_beg
, region_end
;
7160 struct frame
*f
= XFRAME (w
->frame
);
7161 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7162 Lisp_Object prop
, position
;
7164 Lisp_Object
*overlay_vec
;
7167 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7168 Lisp_Object limit1
, end
;
7169 struct face
*default_face
;
7171 /* W must display the current buffer. We could write this function
7172 to use the frame and buffer of W, but right now it doesn't. */
7173 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7175 XSETFRAME (frame
, f
);
7176 XSETFASTINT (position
, pos
);
7179 if (pos
< region_beg
&& region_beg
< endpos
)
7180 endpos
= region_beg
;
7182 /* Get the `face' or `mouse_face' text property at POS, and
7183 determine the next position at which the property changes. */
7184 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7185 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7186 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7188 endpos
= XINT (end
);
7190 /* Look at properties from overlays. */
7195 /* First try with room for 40 overlays. */
7197 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7198 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7199 &next_overlay
, NULL
, 0);
7201 /* If there are more than 40, make enough space for all, and try
7203 if (noverlays
> len
)
7206 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7207 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7208 &next_overlay
, NULL
, 0);
7211 if (next_overlay
< endpos
)
7212 endpos
= next_overlay
;
7217 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7219 /* Optimize common cases where we can use the default face. */
7222 && !(pos
>= region_beg
&& pos
< region_end
))
7223 return DEFAULT_FACE_ID
;
7225 /* Begin with attributes from the default face. */
7226 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7228 /* Merge in attributes specified via text properties. */
7230 merge_face_vector_with_property (f
, attrs
, prop
);
7232 /* Now merge the overlay data. */
7233 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7234 for (i
= 0; i
< noverlays
; i
++)
7239 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7241 merge_face_vector_with_property (f
, attrs
, prop
);
7243 oend
= OVERLAY_END (overlay_vec
[i
]);
7244 oendpos
= OVERLAY_POSITION (oend
);
7245 if (oendpos
< endpos
)
7249 /* If in the region, merge in the region face. */
7250 if (pos
>= region_beg
&& pos
< region_end
)
7252 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7253 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7255 if (region_end
< endpos
)
7256 endpos
= region_end
;
7261 /* Look up a realized face with the given face attributes,
7262 or realize a new one for ASCII characters. */
7263 return lookup_face (f
, attrs
, 0, NULL
);
7267 /* Compute the face at character position POS in Lisp string STRING on
7268 window W, for ASCII characters.
7270 If STRING is an overlay string, it comes from position BUFPOS in
7271 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7272 not an overlay string. W must display the current buffer.
7273 REGION_BEG and REGION_END give the start and end positions of the
7274 region; both are -1 if no region is visible.
7276 BASE_FACE_ID is the id of a face to merge with. For strings coming
7277 from overlays or the `display' property it is the face at BUFPOS.
7279 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7281 Set *ENDPTR to the next position where to check for faces in
7282 STRING; -1 if the face is constant from POS to the end of the
7285 Value is the id of the face to use. The face returned is suitable
7286 for displaying ASCII characters. */
7289 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7290 region_end
, endptr
, base_face_id
, mouse_p
)
7294 int region_beg
, region_end
;
7296 enum face_id base_face_id
;
7299 Lisp_Object prop
, position
, end
, limit
;
7300 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7301 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7302 struct face
*base_face
;
7303 int multibyte_p
= STRING_MULTIBYTE (string
);
7304 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7306 /* Get the value of the face property at the current position within
7307 STRING. Value is nil if there is no face property. */
7308 XSETFASTINT (position
, pos
);
7309 prop
= Fget_text_property (position
, prop_name
, string
);
7311 /* Get the next position at which to check for faces. Value of end
7312 is nil if face is constant all the way to the end of the string.
7313 Otherwise it is a string position where to check faces next.
7314 Limit is the maximum position up to which to check for property
7315 changes in Fnext_single_property_change. Strings are usually
7316 short, so set the limit to the end of the string. */
7317 XSETFASTINT (limit
, SCHARS (string
));
7318 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7320 *endptr
= XFASTINT (end
);
7324 base_face
= FACE_FROM_ID (f
, base_face_id
);
7325 xassert (base_face
);
7327 /* Optimize the default case that there is no face property and we
7328 are not in the region. */
7330 && (base_face_id
!= DEFAULT_FACE_ID
7331 /* BUFPOS <= 0 means STRING is not an overlay string, so
7332 that the region doesn't have to be taken into account. */
7334 || bufpos
< region_beg
7335 || bufpos
>= region_end
)
7337 /* We can't realize faces for different charsets differently
7338 if we don't have fonts, so we can stop here if not working
7339 on a window-system frame. */
7340 || !FRAME_WINDOW_P (f
)
7341 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7342 return base_face
->id
;
7344 /* Begin with attributes from the base face. */
7345 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7347 /* Merge in attributes specified via text properties. */
7349 merge_face_vector_with_property (f
, attrs
, prop
);
7351 /* If in the region, merge in the region face. */
7353 && bufpos
>= region_beg
7354 && bufpos
< region_end
)
7356 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7357 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7360 /* Look up a realized face with the given face attributes,
7361 or realize a new one for ASCII characters. */
7362 return lookup_face (f
, attrs
, 0, NULL
);
7367 /***********************************************************************
7369 ***********************************************************************/
7373 /* Print the contents of the realized face FACE to stderr. */
7376 dump_realized_face (face
)
7379 fprintf (stderr
, "ID: %d\n", face
->id
);
7380 #ifdef HAVE_X_WINDOWS
7381 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7383 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7385 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7386 fprintf (stderr
, "background: 0x%lx (%s)\n",
7388 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7389 fprintf (stderr
, "font_name: %s (%s)\n",
7391 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7392 #ifdef HAVE_X_WINDOWS
7393 fprintf (stderr
, "font = %p\n", face
->font
);
7395 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7396 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7397 fprintf (stderr
, "underline: %d (%s)\n",
7399 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7400 fprintf (stderr
, "hash: %d\n", face
->hash
);
7401 fprintf (stderr
, "charset: %d\n", face
->charset
);
7405 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7413 fprintf (stderr
, "font selection order: ");
7414 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7415 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7416 fprintf (stderr
, "\n");
7418 fprintf (stderr
, "alternative fonts: ");
7419 debug_print (Vface_alternative_font_family_alist
);
7420 fprintf (stderr
, "\n");
7422 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7423 Fdump_face (make_number (i
));
7429 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7431 error ("Not a valid face");
7432 dump_realized_face (face
);
7439 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7440 0, 0, 0, doc
: /* */)
7443 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7444 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7445 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7449 #endif /* GLYPH_DEBUG != 0 */
7453 /***********************************************************************
7455 ***********************************************************************/
7460 Qface
= intern ("face");
7462 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7463 staticpro (&Qbitmap_spec_p
);
7464 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7465 staticpro (&Qframe_update_face_colors
);
7467 /* Lisp face attribute keywords. */
7468 QCfamily
= intern (":family");
7469 staticpro (&QCfamily
);
7470 QCheight
= intern (":height");
7471 staticpro (&QCheight
);
7472 QCweight
= intern (":weight");
7473 staticpro (&QCweight
);
7474 QCslant
= intern (":slant");
7475 staticpro (&QCslant
);
7476 QCunderline
= intern (":underline");
7477 staticpro (&QCunderline
);
7478 QCinverse_video
= intern (":inverse-video");
7479 staticpro (&QCinverse_video
);
7480 QCreverse_video
= intern (":reverse-video");
7481 staticpro (&QCreverse_video
);
7482 QCforeground
= intern (":foreground");
7483 staticpro (&QCforeground
);
7484 QCbackground
= intern (":background");
7485 staticpro (&QCbackground
);
7486 QCstipple
= intern (":stipple");;
7487 staticpro (&QCstipple
);
7488 QCwidth
= intern (":width");
7489 staticpro (&QCwidth
);
7490 QCfont
= intern (":font");
7491 staticpro (&QCfont
);
7492 QCbold
= intern (":bold");
7493 staticpro (&QCbold
);
7494 QCitalic
= intern (":italic");
7495 staticpro (&QCitalic
);
7496 QCoverline
= intern (":overline");
7497 staticpro (&QCoverline
);
7498 QCstrike_through
= intern (":strike-through");
7499 staticpro (&QCstrike_through
);
7500 QCbox
= intern (":box");
7502 QCinherit
= intern (":inherit");
7503 staticpro (&QCinherit
);
7505 /* Symbols used for Lisp face attribute values. */
7506 QCcolor
= intern (":color");
7507 staticpro (&QCcolor
);
7508 QCline_width
= intern (":line-width");
7509 staticpro (&QCline_width
);
7510 QCstyle
= intern (":style");
7511 staticpro (&QCstyle
);
7512 Qreleased_button
= intern ("released-button");
7513 staticpro (&Qreleased_button
);
7514 Qpressed_button
= intern ("pressed-button");
7515 staticpro (&Qpressed_button
);
7516 Qnormal
= intern ("normal");
7517 staticpro (&Qnormal
);
7518 Qultra_light
= intern ("ultra-light");
7519 staticpro (&Qultra_light
);
7520 Qextra_light
= intern ("extra-light");
7521 staticpro (&Qextra_light
);
7522 Qlight
= intern ("light");
7523 staticpro (&Qlight
);
7524 Qsemi_light
= intern ("semi-light");
7525 staticpro (&Qsemi_light
);
7526 Qsemi_bold
= intern ("semi-bold");
7527 staticpro (&Qsemi_bold
);
7528 Qbold
= intern ("bold");
7530 Qextra_bold
= intern ("extra-bold");
7531 staticpro (&Qextra_bold
);
7532 Qultra_bold
= intern ("ultra-bold");
7533 staticpro (&Qultra_bold
);
7534 Qoblique
= intern ("oblique");
7535 staticpro (&Qoblique
);
7536 Qitalic
= intern ("italic");
7537 staticpro (&Qitalic
);
7538 Qreverse_oblique
= intern ("reverse-oblique");
7539 staticpro (&Qreverse_oblique
);
7540 Qreverse_italic
= intern ("reverse-italic");
7541 staticpro (&Qreverse_italic
);
7542 Qultra_condensed
= intern ("ultra-condensed");
7543 staticpro (&Qultra_condensed
);
7544 Qextra_condensed
= intern ("extra-condensed");
7545 staticpro (&Qextra_condensed
);
7546 Qcondensed
= intern ("condensed");
7547 staticpro (&Qcondensed
);
7548 Qsemi_condensed
= intern ("semi-condensed");
7549 staticpro (&Qsemi_condensed
);
7550 Qsemi_expanded
= intern ("semi-expanded");
7551 staticpro (&Qsemi_expanded
);
7552 Qexpanded
= intern ("expanded");
7553 staticpro (&Qexpanded
);
7554 Qextra_expanded
= intern ("extra-expanded");
7555 staticpro (&Qextra_expanded
);
7556 Qultra_expanded
= intern ("ultra-expanded");
7557 staticpro (&Qultra_expanded
);
7558 Qbackground_color
= intern ("background-color");
7559 staticpro (&Qbackground_color
);
7560 Qforeground_color
= intern ("foreground-color");
7561 staticpro (&Qforeground_color
);
7562 Qunspecified
= intern ("unspecified");
7563 staticpro (&Qunspecified
);
7565 Qface_alias
= intern ("face-alias");
7566 staticpro (&Qface_alias
);
7567 Qdefault
= intern ("default");
7568 staticpro (&Qdefault
);
7569 Qtool_bar
= intern ("tool-bar");
7570 staticpro (&Qtool_bar
);
7571 Qregion
= intern ("region");
7572 staticpro (&Qregion
);
7573 Qfringe
= intern ("fringe");
7574 staticpro (&Qfringe
);
7575 Qheader_line
= intern ("header-line");
7576 staticpro (&Qheader_line
);
7577 Qscroll_bar
= intern ("scroll-bar");
7578 staticpro (&Qscroll_bar
);
7579 Qmenu
= intern ("menu");
7581 Qcursor
= intern ("cursor");
7582 staticpro (&Qcursor
);
7583 Qborder
= intern ("border");
7584 staticpro (&Qborder
);
7585 Qmouse
= intern ("mouse");
7586 staticpro (&Qmouse
);
7587 Qmode_line_inactive
= intern ("mode-line-inactive");
7588 staticpro (&Qmode_line_inactive
);
7589 Qtty_color_desc
= intern ("tty-color-desc");
7590 staticpro (&Qtty_color_desc
);
7591 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7592 staticpro (&Qtty_color_standard_values
);
7593 Qtty_color_by_index
= intern ("tty-color-by-index");
7594 staticpro (&Qtty_color_by_index
);
7595 Qtty_color_alist
= intern ("tty-color-alist");
7596 staticpro (&Qtty_color_alist
);
7597 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7598 staticpro (&Qscalable_fonts_allowed
);
7600 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7601 staticpro (&Vparam_value_alist
);
7602 Vface_alternative_font_family_alist
= Qnil
;
7603 staticpro (&Vface_alternative_font_family_alist
);
7604 Vface_alternative_font_registry_alist
= Qnil
;
7605 staticpro (&Vface_alternative_font_registry_alist
);
7607 defsubr (&Sinternal_make_lisp_face
);
7608 defsubr (&Sinternal_lisp_face_p
);
7609 defsubr (&Sinternal_set_lisp_face_attribute
);
7610 #ifdef HAVE_WINDOW_SYSTEM
7611 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7613 defsubr (&Scolor_gray_p
);
7614 defsubr (&Scolor_supported_p
);
7615 defsubr (&Sface_attribute_relative_p
);
7616 defsubr (&Smerge_face_attribute
);
7617 defsubr (&Sinternal_get_lisp_face_attribute
);
7618 defsubr (&Sinternal_lisp_face_attribute_values
);
7619 defsubr (&Sinternal_lisp_face_equal_p
);
7620 defsubr (&Sinternal_lisp_face_empty_p
);
7621 defsubr (&Sinternal_copy_lisp_face
);
7622 defsubr (&Sinternal_merge_in_global_face
);
7623 defsubr (&Sface_font
);
7624 defsubr (&Sframe_face_alist
);
7625 defsubr (&Stty_supports_face_attributes_p
);
7626 defsubr (&Scolor_distance
);
7627 defsubr (&Sinternal_set_font_selection_order
);
7628 defsubr (&Sinternal_set_alternative_font_family_alist
);
7629 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7630 defsubr (&Sface_attributes_as_vector
);
7632 defsubr (&Sdump_face
);
7633 defsubr (&Sshow_face_resources
);
7634 #endif /* GLYPH_DEBUG */
7635 defsubr (&Sclear_face_cache
);
7636 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7638 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7639 defsubr (&Sdump_colors
);
7642 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7643 doc
: /* *Limit for font matching.
7644 If an integer > 0, font matching functions won't load more than
7645 that number of fonts when searching for a matching font. */);
7646 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7648 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7649 doc
: /* List of global face definitions (for internal use only.) */);
7650 Vface_new_frame_defaults
= Qnil
;
7652 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7653 doc
: /* *Default stipple pattern used on monochrome displays.
7654 This stipple pattern is used on monochrome displays
7655 instead of shades of gray for a face background color.
7656 See `set-face-stipple' for possible values for this variable. */);
7657 Vface_default_stipple
= build_string ("gray3");
7659 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7660 doc
: /* An alist of defined terminal colors and their RGB values. */);
7661 Vtty_defined_color_alist
= Qnil
;
7663 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7664 doc
: /* Allowed scalable fonts.
7665 A value of nil means don't allow any scalable fonts.
7666 A value of t means allow any scalable font.
7667 Otherwise, value must be a list of regular expressions. A font may be
7668 scaled if its name matches a regular expression in the list.
7669 Note that if value is nil, a scalable font might still be used, if no
7670 other font of the appropriate family and registry is available. */);
7671 Vscalable_fonts_allowed
= Qnil
;
7673 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7674 doc
: /* List of ignored fonts.
7675 Each element is a regular expression that matches names of fonts to
7677 Vface_ignored_fonts
= Qnil
;
7679 #ifdef HAVE_WINDOW_SYSTEM
7680 defsubr (&Sbitmap_spec_p
);
7681 defsubr (&Sx_list_fonts
);
7682 defsubr (&Sinternal_face_x_get_resource
);
7683 defsubr (&Sx_family_fonts
);
7684 defsubr (&Sx_font_family_list
);
7685 #endif /* HAVE_WINDOW_SYSTEM */