1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2011 Free Software Foundation, Inc.
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 3 of the License, or
10 (at your option) any later version.
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. If not, see <http://www.gnu.org/licenses/>. */
20 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
24 When using Emacs with X, the display style of characters can be
25 changed by defining `faces'. Each face can specify the following
30 2. Font foundary name.
32 3. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 4. Font height in 1/10pt.
37 5. Font weight, e.g. `bold'.
39 6. Font slant, e.g. `italic'.
45 9. Whether or not characters should be underlined, and in what color.
47 10. Whether or not characters should be displayed in inverse video.
49 11. A background stipple, a bitmap.
51 12. Whether or not characters should be overlined, and in what color.
53 13. Whether or not characters should be strike-through, and in what
56 14. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 15. Font-spec, or nil. This is a special attribute.
61 A font-spec is a collection of font attributes (specs).
63 When this attribute is specified, the face uses a font matching
64 with the specs as is except for what overwritten by the specs in
65 the fontset (see below). In addition, the other font-related
66 attributes (1st thru 5th) are updated from the spec.
68 On the other hand, if one of the other font-related attributes are
69 specified, the correspoinding specs in this attribute is set to nil.
71 15. A face name or list of face names from which to inherit attributes.
73 16. A specified average font width, which is invisible from Lisp,
74 and is used to ensure that a font specified on the command line,
75 for example, can be matched exactly.
77 17. A fontset name. This is another special attribute.
79 A fontset is a mappings from characters to font-specs, and the
80 specs overwrite the font-spec in the 14th attribute.
83 Faces are frame-local by nature because Emacs allows to define the
84 same named face (face names are symbols) differently for different
85 frames. Each frame has an alist of face definitions for all named
86 faces. The value of a named face in such an alist is a Lisp vector
87 with the symbol `face' in slot 0, and a slot for each of the face
88 attributes mentioned above.
90 There is also a global face alist `Vface_new_frame_defaults'. Face
91 definitions from this list are used to initialize faces of newly
94 A face doesn't have to specify all attributes. Those not specified
95 have a value of `unspecified'. Faces specifying all attributes but
96 the 14th are called `fully-specified'.
101 The display style of a given character in the text is determined by
102 combining several faces. This process is called `face merging'.
103 Any aspect of the display style that isn't specified by overlays or
104 text properties is taken from the `default' face. Since it is made
105 sure that the default face is always fully-specified, face merging
106 always results in a fully-specified face.
111 After all face attributes for a character have been determined by
112 merging faces of that character, that face is `realized'. The
113 realization process maps face attributes to what is physically
114 available on the system where Emacs runs. The result is a
115 `realized face' in form of a struct face which is stored in the
116 face cache of the frame on which it was realized.
118 Face realization is done in the context of the character to display
119 because different fonts may be used for different characters. In
120 other words, for characters that have different font
121 specifications, different realized faces are needed to display
124 Font specification is done by fontsets. See the comment in
125 fontset.c for the details. In the current implementation, all ASCII
126 characters share the same font in a fontset.
128 Faces are at first realized for ASCII characters, and, at that
129 time, assigned a specific realized fontset. Hereafter, we call
130 such a face as `ASCII face'. When a face for a multibyte character
131 is realized, it inherits (thus shares) a fontset of an ASCII face
132 that has the same attributes other than font-related ones.
134 Thus, all realized faces have a realized fontset.
139 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
140 font as ASCII characters. That is because it is expected that
141 unibyte text users specify a font that is suitable both for ASCII
142 and raw 8-bit characters.
147 Font selection tries to find the best available matching font for a
148 given (character, face) combination.
150 If the face specifies a fontset name, that fontset determines a
151 pattern for fonts of the given character. If the face specifies a
152 font name or the other font-related attributes, a fontset is
153 realized from the default fontset. In that case, that
154 specification determines a pattern for ASCII characters and the
155 default fontset determines a pattern for multibyte characters.
157 Available fonts on the system on which Emacs runs are then matched
158 against the font pattern. The result of font selection is the best
159 match for the given face attributes in this font list.
161 Font selection can be influenced by the user.
163 1. The user can specify the relative importance he gives the face
164 attributes width, height, weight, and slant by setting
165 face-font-selection-order (faces.el) to a list of face attribute
166 names. The default is '(:width :height :weight :slant), and means
167 that font selection first tries to find a good match for the font
168 width specified by a face, then---within fonts with that
169 width---tries to find a best match for the specified font height,
172 2. Setting face-font-family-alternatives allows the user to
173 specify alternative font families to try if a family specified by a
176 3. Setting face-font-registry-alternatives allows the user to
177 specify all alternative font registries to try for a face
178 specifying a registry.
180 4. Setting face-ignored-fonts allows the user to ignore specific
184 Character composition.
186 Usually, the realization process is already finished when Emacs
187 actually reflects the desired glyph matrix on the screen. However,
188 on displaying a composition (sequence of characters to be composed
189 on the screen), a suitable font for the components of the
190 composition is selected and realized while drawing them on the
191 screen, i.e. the realization process is delayed but in principle
195 Initialization of basic faces.
197 The faces `default', `modeline' are considered `basic faces'.
198 When redisplay happens the first time for a newly created frame,
199 basic faces are realized for CHARSET_ASCII. Frame parameters are
200 used to fill in unspecified attributes of the default face. */
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h> /* This needs to be before termchar.h */
210 #include "character.h"
212 #include "keyboard.h"
214 #include "termhooks.h"
216 #ifdef HAVE_X_WINDOWS
220 #include <Xm/XmStrDefs.h>
221 #endif /* USE_MOTIF */
222 #endif /* HAVE_X_WINDOWS */
231 /* Redefine X specifics to W32 equivalents to avoid cluttering the
232 code with #ifdef blocks. */
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
252 #include "dispextern.h"
253 #include "blockinput.h"
255 #include "intervals.h"
256 #include "termchar.h"
259 #ifdef HAVE_WINDOW_SYSTEM
261 #endif /* HAVE_WINDOW_SYSTEM */
263 #ifdef HAVE_X_WINDOWS
265 /* Compensate for a bug in Xos.h on some systems, on which it requires
266 time.h. On some such systems, Xos.h tries to redefine struct
267 timeval and struct timezone if USG is #defined while it is
270 #ifdef XOS_NEEDS_TIME_H
276 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
278 #else /* not XOS_NEEDS_TIME_H */
280 #endif /* not XOS_NEEDS_TIME_H */
282 #endif /* HAVE_X_WINDOWS */
286 /* Number of pt per inch (from the TeXbook). */
288 #define PT_PER_INCH 72.27
290 /* Non-zero if face attribute ATTR is unspecified. */
292 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
294 /* Non-zero if face attribute ATTR is `ignore-defface'. */
296 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
298 /* Value is the number of elements of VECTOR. */
300 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
302 /* Size of hash table of realized faces in face caches (should be a
305 #define FACE_CACHE_BUCKETS_SIZE 1001
307 /* Keyword symbols used for face attribute names. */
309 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
310 static Lisp_Object QCunderline
;
311 static Lisp_Object QCinverse_video
, QCstipple
;
312 Lisp_Object QCforeground
, QCbackground
;
314 static Lisp_Object QCfont
, QCbold
, QCitalic
;
315 static Lisp_Object QCreverse_video
;
316 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
317 static Lisp_Object QCfontset
;
319 /* Symbols used for attribute values. */
323 static Lisp_Object Qultra_light
, Qextra_light
, Qlight
;
324 static Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
325 static Lisp_Object Qoblique
, Qreverse_oblique
, Qreverse_italic
;
327 static Lisp_Object Qultra_condensed
, Qextra_condensed
;
328 Lisp_Object Qcondensed
;
329 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qextra_expanded
;
330 Lisp_Object Qexpanded
;
331 static Lisp_Object Qultra_expanded
;
332 static Lisp_Object Qreleased_button
, Qpressed_button
;
333 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
334 Lisp_Object Qunspecified
; /* used in dosfns.c */
335 static Lisp_Object QCignore_defface
;
337 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
339 /* The name of the function to call when the background of the frame
340 has changed, frame_set_background_mode. */
342 static Lisp_Object Qframe_set_background_mode
;
344 /* Names of basic faces. */
346 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
347 static Lisp_Object Qregion
;
348 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
349 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
350 Lisp_Object Qmode_line_inactive
;
351 static Lisp_Object Qvertical_border
;
353 /* The symbol `face-alias'. A symbols having that property is an
354 alias for another face. Value of the property is the name of
357 static Lisp_Object Qface_alias
;
359 /* Alist of alternative font families. Each element is of the form
360 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
361 try FAMILY1, then FAMILY2, ... */
363 Lisp_Object Vface_alternative_font_family_alist
;
365 /* Alist of alternative font registries. Each element is of the form
366 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
367 loaded, try REGISTRY1, then REGISTRY2, ... */
369 Lisp_Object Vface_alternative_font_registry_alist
;
371 /* Allowed scalable fonts. A value of nil means don't allow any
372 scalable fonts. A value of t means allow the use of any scalable
373 font. Otherwise, value must be a list of regular expressions. A
374 font may be scaled if its name matches a regular expression in the
377 static Lisp_Object Qscalable_fonts_allowed
;
379 #define DEFAULT_FONT_LIST_LIMIT 100
381 /* The symbols `foreground-color' and `background-color' which can be
382 used as part of a `face' property. This is for compatibility with
385 Lisp_Object Qforeground_color
, Qbackground_color
;
387 /* The symbols `face' and `mouse-face' used as text properties. */
391 /* Property for basic faces which other faces cannot inherit. */
393 static Lisp_Object Qface_no_inherit
;
395 /* Error symbol for wrong_type_argument in load_pixmap. */
397 static Lisp_Object Qbitmap_spec_p
;
399 /* The next ID to assign to Lisp faces. */
401 static int next_lface_id
;
403 /* A vector mapping Lisp face Id's to face names. */
405 static Lisp_Object
*lface_id_to_name
;
406 static ptrdiff_t lface_id_to_name_size
;
408 /* TTY color-related functions (defined in tty-colors.el). */
410 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
412 /* The name of the function used to compute colors on TTYs. */
414 static Lisp_Object Qtty_color_alist
;
416 /* Counter for calls to clear_face_cache. If this counter reaches
417 CLEAR_FONT_TABLE_COUNT, and a frame has more than
418 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
420 static int clear_font_table_count
;
421 #define CLEAR_FONT_TABLE_COUNT 100
422 #define CLEAR_FONT_TABLE_NFONTS 10
424 /* Non-zero means face attributes have been changed since the last
425 redisplay. Used in redisplay_internal. */
427 int face_change_count
;
429 /* Non-zero means don't display bold text if a face's foreground
430 and background colors are the inverse of the default colors of the
431 display. This is a kluge to suppress `bold black' foreground text
432 which is hard to read on an LCD monitor. */
434 static int tty_suppress_bold_inverse_default_colors_p
;
436 /* A list of the form `((x . y))' used to avoid consing in
437 Finternal_set_lisp_face_attribute. */
439 static Lisp_Object Vparam_value_alist
;
441 /* The total number of colors currently allocated. */
444 static int ncolors_allocated
;
445 static int npixmaps_allocated
;
449 /* Non-zero means the definition of the `menu' face for new frames has
452 static int menu_face_changed_default
;
455 /* Function prototypes. */
458 struct named_merge_point
;
460 static void map_tty_color (struct frame
*, struct face
*,
461 enum lface_attribute_index
, int *);
462 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
463 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
464 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
465 int, struct named_merge_point
*);
466 static ptrdiff_t load_pixmap (struct frame
*, Lisp_Object
,
467 unsigned *, unsigned *);
468 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
469 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
470 static void free_face_colors (struct frame
*, struct face
*);
471 static int face_color_gray_p (struct frame
*, const char *);
472 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
474 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
476 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
477 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
478 static int realize_basic_faces (struct frame
*);
479 static int realize_default_face (struct frame
*);
480 static void realize_named_face (struct frame
*, Lisp_Object
, int);
481 static int lface_fully_specified_p (Lisp_Object
*);
482 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
483 static unsigned hash_string_case_insensitive (Lisp_Object
);
484 static unsigned lface_hash (Lisp_Object
*);
485 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
486 static struct face_cache
*make_face_cache (struct frame
*);
487 static void clear_face_gcs (struct face_cache
*);
488 static void free_face_cache (struct face_cache
*);
489 static int face_fontset (Lisp_Object
*);
490 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
491 struct named_merge_point
*);
492 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
493 int, struct named_merge_point
*);
494 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
496 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
497 static struct face
*make_realized_face (Lisp_Object
*);
498 static void cache_face (struct face_cache
*, struct face
*, unsigned);
499 static void uncache_face (struct face_cache
*, struct face
*);
501 #ifdef HAVE_WINDOW_SYSTEM
503 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
504 static void x_free_gc (struct frame
*, GC
);
507 static void x_update_menu_appearance (struct frame
*);
509 extern void free_frame_menubar (struct frame
*);
510 #endif /* USE_X_TOOLKIT */
512 #endif /* HAVE_WINDOW_SYSTEM */
515 /***********************************************************************
517 ***********************************************************************/
519 #ifdef HAVE_X_WINDOWS
521 #ifdef DEBUG_X_COLORS
523 /* The following is a poor mans infrastructure for debugging X color
524 allocation problems on displays with PseudoColor-8. Some X servers
525 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
526 color reference counts completely so that they don't signal an
527 error when a color is freed whose reference count is already 0.
528 Other X servers do. To help me debug this, the following code
529 implements a simple reference counting schema of its own, for a
530 single display/screen. --gerd. */
532 /* Reference counts for pixel colors. */
534 int color_count
[256];
536 /* Register color PIXEL as allocated. */
539 register_color (unsigned long pixel
)
541 xassert (pixel
< 256);
542 ++color_count
[pixel
];
546 /* Register color PIXEL as deallocated. */
549 unregister_color (unsigned long pixel
)
551 xassert (pixel
< 256);
552 if (color_count
[pixel
] > 0)
553 --color_count
[pixel
];
559 /* Register N colors from PIXELS as deallocated. */
562 unregister_colors (unsigned long *pixels
, int n
)
565 for (i
= 0; i
< n
; ++i
)
566 unregister_color (pixels
[i
]);
570 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
571 doc
: /* Dump currently allocated colors to stderr. */)
576 fputc ('\n', stderr
);
578 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
581 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
584 fputc ('\n', stderr
);
586 fputc ('\t', stderr
);
590 fputc ('\n', stderr
);
594 #endif /* DEBUG_X_COLORS */
597 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
598 color values. Interrupt input must be blocked when this function
602 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
604 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
606 /* If display has an immutable color map, freeing colors is not
607 necessary and some servers don't allow it. So don't do it. */
608 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
610 #ifdef DEBUG_X_COLORS
611 unregister_colors (pixels
, npixels
);
613 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
621 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
622 color values. Interrupt input must be blocked when this function
626 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
627 long unsigned int *pixels
, int npixels
)
629 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
630 int class = dpyinfo
->visual
->class;
632 /* If display has an immutable color map, freeing colors is not
633 necessary and some servers don't allow it. So don't do it. */
634 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
636 #ifdef DEBUG_X_COLORS
637 unregister_colors (pixels
, npixels
);
639 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
642 #endif /* USE_X_TOOLKIT */
644 /* Create and return a GC for use on frame F. GC values and mask
645 are given by XGCV and MASK. */
648 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
652 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
659 /* Free GC which was used on frame F. */
662 x_free_gc (struct frame
*f
, GC gc
)
664 eassert (interrupt_input_blocked
);
665 IF_DEBUG (xassert (--ngcs
>= 0));
666 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
669 #endif /* HAVE_X_WINDOWS */
672 /* W32 emulation of GCs */
675 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
679 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
686 /* Free GC which was used on frame F. */
689 x_free_gc (struct frame
*f
, GC gc
)
691 IF_DEBUG (xassert (--ngcs
>= 0));
695 #endif /* WINDOWSNT */
698 /* NS emulation of GCs */
701 x_create_gc (struct frame
*f
,
705 GC gc
= xmalloc (sizeof (*gc
));
707 memcpy (gc
, xgcv
, sizeof (XGCValues
));
712 x_free_gc (struct frame
*f
, GC gc
)
718 /* Like strcasecmp/stricmp. Used to compare parts of font names which
722 xstrcasecmp (const char *s1
, const char *s2
)
726 unsigned char b1
= *s1
;
727 unsigned char b2
= *s2
;
728 unsigned char c1
= tolower (b1
);
729 unsigned char c2
= tolower (b2
);
731 return c1
< c2
? -1 : 1;
736 return *s2
== 0 ? 0 : -1;
741 /* If FRAME is nil, return a pointer to the selected frame.
742 Otherwise, check that FRAME is a live frame, and return a pointer
743 to it. NPARAM is the parameter number of FRAME, for
744 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
745 Lisp function definitions. */
747 static inline struct frame
*
748 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
751 frame
= selected_frame
;
753 CHECK_LIVE_FRAME (frame
);
754 return XFRAME (frame
);
758 /***********************************************************************
760 ***********************************************************************/
762 /* Initialize face cache and basic faces for frame F. */
765 init_frame_faces (struct frame
*f
)
767 /* Make a face cache, if F doesn't have one. */
768 if (FRAME_FACE_CACHE (f
) == NULL
)
769 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
771 #ifdef HAVE_WINDOW_SYSTEM
772 /* Make the image cache. */
773 if (FRAME_WINDOW_P (f
))
775 /* We initialize the image cache when creating the first frame
776 on a terminal, and not during terminal creation. This way,
777 `x-open-connection' on a tty won't create an image cache. */
778 if (FRAME_IMAGE_CACHE (f
) == NULL
)
779 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
780 ++FRAME_IMAGE_CACHE (f
)->refcount
;
782 #endif /* HAVE_WINDOW_SYSTEM */
784 /* Realize basic faces. Must have enough information in frame
785 parameters to realize basic faces at this point. */
786 #ifdef HAVE_X_WINDOWS
787 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
790 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
793 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
795 if (!realize_basic_faces (f
))
800 /* Free face cache of frame F. Called from delete_frame. */
803 free_frame_faces (struct frame
*f
)
805 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
809 free_face_cache (face_cache
);
810 FRAME_FACE_CACHE (f
) = NULL
;
813 #ifdef HAVE_WINDOW_SYSTEM
814 if (FRAME_WINDOW_P (f
))
816 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
819 --image_cache
->refcount
;
820 if (image_cache
->refcount
== 0)
821 free_image_cache (f
);
824 #endif /* HAVE_WINDOW_SYSTEM */
828 /* Clear face caches, and recompute basic faces for frame F. Call
829 this after changing frame parameters on which those faces depend,
830 or when realized faces have been freed due to changing attributes
834 recompute_basic_faces (struct frame
*f
)
836 if (FRAME_FACE_CACHE (f
))
838 clear_face_cache (0);
839 if (!realize_basic_faces (f
))
845 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
846 try to free unused fonts, too. */
849 clear_face_cache (int clear_fonts_p
)
851 #ifdef HAVE_WINDOW_SYSTEM
852 Lisp_Object tail
, frame
;
855 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
858 /* Not yet implemented. */
859 clear_font_cache (frame
);
862 /* From time to time see if we can unload some fonts. This also
863 frees all realized faces on all frames. Fonts needed by
864 faces will be loaded again when faces are realized again. */
865 clear_font_table_count
= 0;
867 FOR_EACH_FRAME (tail
, frame
)
869 struct frame
*f
= XFRAME (frame
);
870 if (FRAME_WINDOW_P (f
)
871 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
872 free_all_realized_faces (frame
);
877 /* Clear GCs of realized faces. */
878 FOR_EACH_FRAME (tail
, frame
)
880 struct frame
*f
= XFRAME (frame
);
881 if (FRAME_WINDOW_P (f
))
882 clear_face_gcs (FRAME_FACE_CACHE (f
));
884 clear_image_caches (Qnil
);
886 #endif /* HAVE_WINDOW_SYSTEM */
890 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
891 doc
: /* Clear face caches on all frames.
892 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
893 (Lisp_Object thoroughly
)
895 clear_face_cache (!NILP (thoroughly
));
897 ++windows_or_buffers_changed
;
902 /***********************************************************************
904 ***********************************************************************/
906 #ifdef HAVE_WINDOW_SYSTEM
908 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
909 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
910 A bitmap specification is either a string, a file name, or a list
911 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
912 HEIGHT is its height, and DATA is a string containing the bits of
913 the pixmap. Bits are stored row by row, each row occupies
914 \(WIDTH + 7)/8 bytes. */)
919 if (STRINGP (object
))
920 /* If OBJECT is a string, it's a file name. */
922 else if (CONSP (object
))
924 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
925 HEIGHT must be integers > 0, and DATA must be string large
926 enough to hold a bitmap of the specified size. */
927 Lisp_Object width
, height
, data
;
929 height
= width
= data
= Qnil
;
933 width
= XCAR (object
);
934 object
= XCDR (object
);
937 height
= XCAR (object
);
938 object
= XCDR (object
);
940 data
= XCAR (object
);
945 && INTEGERP (width
) && 0 < XINT (width
)
946 && INTEGERP (height
) && 0 < XINT (height
))
948 EMACS_INT bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
950 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
955 return pixmap_p
? Qt
: Qnil
;
959 /* Load a bitmap according to NAME (which is either a file name or a
960 pixmap spec) for use on frame F. Value is the bitmap_id (see
961 xfns.c). If NAME is nil, return with a bitmap id of zero. If
962 bitmap cannot be loaded, display a message saying so, and return
963 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
964 if these pointers are not null. */
967 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
,
975 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
980 /* Decode a bitmap spec into a bitmap. */
985 w
= XINT (Fcar (name
));
986 h
= XINT (Fcar (Fcdr (name
)));
987 bits
= Fcar (Fcdr (Fcdr (name
)));
989 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
994 /* It must be a string -- a file name. */
995 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1001 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
1012 ++npixmaps_allocated
;
1015 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1018 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1024 #endif /* HAVE_WINDOW_SYSTEM */
1028 /***********************************************************************
1030 ***********************************************************************/
1032 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1033 RGB_LIST should contain (at least) 3 lisp integers.
1034 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1037 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1039 #define PARSE_RGB_LIST_FIELD(field) \
1040 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1042 color->field = XINT (XCAR (rgb_list)); \
1043 rgb_list = XCDR (rgb_list); \
1048 PARSE_RGB_LIST_FIELD (red
);
1049 PARSE_RGB_LIST_FIELD (green
);
1050 PARSE_RGB_LIST_FIELD (blue
);
1056 /* Lookup on frame F the color described by the lisp string COLOR.
1057 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1058 non-zero, then the `standard' definition of the same color is
1062 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
1065 Lisp_Object frame
, color_desc
;
1067 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1070 XSETFRAME (frame
, f
);
1072 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1073 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1077 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1080 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1082 rgb
= XCDR (XCDR (color_desc
));
1083 if (! parse_rgb_list (rgb
, tty_color
))
1086 /* Should we fill in STD_COLOR too? */
1089 /* Default STD_COLOR to the same as TTY_COLOR. */
1090 *std_color
= *tty_color
;
1092 /* Do a quick check to see if the returned descriptor is
1093 actually _exactly_ equal to COLOR, otherwise we have to
1094 lookup STD_COLOR separately. If it's impossible to lookup
1095 a standard color, we just give up and use TTY_COLOR. */
1096 if ((!STRINGP (XCAR (color_desc
))
1097 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1098 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1100 /* Look up STD_COLOR separately. */
1101 rgb
= call1 (Qtty_color_standard_values
, color
);
1102 if (! parse_rgb_list (rgb
, std_color
))
1109 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1110 /* We were called early during startup, and the colors are not
1111 yet set up in tty-defined-color-alist. Don't return a failure
1112 indication, since this produces the annoying "Unable to
1113 load color" messages in the *Messages* buffer. */
1116 /* tty-color-desc seems to have returned a bad value. */
1120 /* A version of defined_color for non-X frames. */
1123 tty_defined_color (struct frame
*f
, const char *color_name
,
1124 XColor
*color_def
, int alloc
)
1129 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1131 color_def
->blue
= 0;
1132 color_def
->green
= 0;
1135 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1137 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1139 if (strcmp (color_name
, "unspecified-fg") == 0)
1140 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1141 else if (strcmp (color_name
, "unspecified-bg") == 0)
1142 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1145 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1152 /* Decide if color named COLOR_NAME is valid for the display
1153 associated with the frame F; if so, return the rgb values in
1154 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1156 This does the right thing for any type of frame. */
1159 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1162 if (!FRAME_WINDOW_P (f
))
1163 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1164 #ifdef HAVE_X_WINDOWS
1165 else if (FRAME_X_P (f
))
1166 return x_defined_color (f
, color_name
, color_def
, alloc
);
1169 else if (FRAME_W32_P (f
))
1170 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1173 else if (FRAME_NS_P (f
))
1174 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1181 /* Given the index IDX of a tty color on frame F, return its name, a
1185 tty_color_name (struct frame
*f
, int idx
)
1187 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1190 Lisp_Object coldesc
;
1192 XSETFRAME (frame
, f
);
1193 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1195 if (!NILP (coldesc
))
1196 return XCAR (coldesc
);
1199 /* We can have an MSDOG frame under -nw for a short window of
1200 opportunity before internal_terminal_init is called. DTRT. */
1201 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1202 return msdos_stdcolor_name (idx
);
1205 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1206 return build_string (unspecified_fg
);
1207 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1208 return build_string (unspecified_bg
);
1210 return Qunspecified
;
1214 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1217 The criterion implemented here is not a terribly sophisticated one. */
1220 face_color_gray_p (struct frame
*f
, const char *color_name
)
1225 if (defined_color (f
, color_name
, &color
, 0))
1226 gray_p
= (/* Any color sufficiently close to black counts as grey. */
1227 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1229 ((eabs (color
.red
- color
.green
)
1230 < max (color
.red
, color
.green
) / 20)
1231 && (eabs (color
.green
- color
.blue
)
1232 < max (color
.green
, color
.blue
) / 20)
1233 && (eabs (color
.blue
- color
.red
)
1234 < max (color
.blue
, color
.red
) / 20)));
1242 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1243 BACKGROUND_P non-zero means the color will be used as background
1247 face_color_supported_p (struct frame
*f
, const char *color_name
,
1253 XSETFRAME (frame
, f
);
1255 #ifdef HAVE_WINDOW_SYSTEM
1257 ? (!NILP (Fxw_display_color_p (frame
))
1258 || xstrcasecmp (color_name
, "black") == 0
1259 || xstrcasecmp (color_name
, "white") == 0
1261 && face_color_gray_p (f
, color_name
))
1262 || (!NILP (Fx_display_grayscale_p (frame
))
1263 && face_color_gray_p (f
, color_name
)))
1266 tty_defined_color (f
, color_name
, ¬_used
, 0);
1270 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1271 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1272 FRAME specifies the frame and thus the display for interpreting COLOR.
1273 If FRAME is nil or omitted, use the selected frame. */)
1274 (Lisp_Object color
, Lisp_Object frame
)
1278 CHECK_STRING (color
);
1280 frame
= selected_frame
;
1282 CHECK_FRAME (frame
);
1284 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1288 DEFUN ("color-supported-p", Fcolor_supported_p
,
1289 Scolor_supported_p
, 1, 3, 0,
1290 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1291 BACKGROUND-P non-nil means COLOR is used as a background.
1292 Otherwise, this function tells whether it can be used as a foreground.
1293 If FRAME is nil or omitted, use the selected frame.
1294 COLOR must be a valid color name. */)
1295 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1299 CHECK_STRING (color
);
1301 frame
= selected_frame
;
1303 CHECK_FRAME (frame
);
1305 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1311 /* Load color with name NAME for use by face FACE on frame F.
1312 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1313 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1314 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1315 pixel color. If color cannot be loaded, display a message, and
1316 return the foreground, background or underline color of F, but
1317 record that fact in flags of the face so that we don't try to free
1321 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1322 enum lface_attribute_index target_index
)
1326 xassert (STRINGP (name
));
1327 xassert (target_index
== LFACE_FOREGROUND_INDEX
1328 || target_index
== LFACE_BACKGROUND_INDEX
1329 || target_index
== LFACE_UNDERLINE_INDEX
1330 || target_index
== LFACE_OVERLINE_INDEX
1331 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1332 || target_index
== LFACE_BOX_INDEX
);
1334 /* if the color map is full, defined_color will return a best match
1335 to the values in an existing cell. */
1336 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1338 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1340 switch (target_index
)
1342 case LFACE_FOREGROUND_INDEX
:
1343 face
->foreground_defaulted_p
= 1;
1344 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1347 case LFACE_BACKGROUND_INDEX
:
1348 face
->background_defaulted_p
= 1;
1349 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1352 case LFACE_UNDERLINE_INDEX
:
1353 face
->underline_defaulted_p
= 1;
1354 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1357 case LFACE_OVERLINE_INDEX
:
1358 face
->overline_color_defaulted_p
= 1;
1359 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1362 case LFACE_STRIKE_THROUGH_INDEX
:
1363 face
->strike_through_color_defaulted_p
= 1;
1364 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1367 case LFACE_BOX_INDEX
:
1368 face
->box_color_defaulted_p
= 1;
1369 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1378 ++ncolors_allocated
;
1385 #ifdef HAVE_WINDOW_SYSTEM
1387 /* Load colors for face FACE which is used on frame F. Colors are
1388 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1389 of ATTRS. If the background color specified is not supported on F,
1390 try to emulate gray colors with a stipple from Vface_default_stipple. */
1393 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1397 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1398 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1400 /* Swap colors if face is inverse-video. */
1401 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1409 /* Check for support for foreground, not for background because
1410 face_color_supported_p is smart enough to know that grays are
1411 "supported" as background because we are supposed to use stipple
1413 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1414 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1416 x_destroy_bitmap (f
, face
->stipple
);
1417 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1418 &face
->pixmap_w
, &face
->pixmap_h
);
1421 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1422 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1426 /* Free color PIXEL on frame F. */
1429 unload_color (struct frame
*f
, long unsigned int pixel
)
1431 #ifdef HAVE_X_WINDOWS
1435 x_free_colors (f
, &pixel
, 1);
1442 /* Free colors allocated for FACE. */
1445 free_face_colors (struct frame
*f
, struct face
*face
)
1447 /* PENDING(NS): need to do something here? */
1448 #ifdef HAVE_X_WINDOWS
1449 if (face
->colors_copied_bitwise_p
)
1454 if (!face
->foreground_defaulted_p
)
1456 x_free_colors (f
, &face
->foreground
, 1);
1457 IF_DEBUG (--ncolors_allocated
);
1460 if (!face
->background_defaulted_p
)
1462 x_free_colors (f
, &face
->background
, 1);
1463 IF_DEBUG (--ncolors_allocated
);
1466 if (face
->underline_p
1467 && !face
->underline_defaulted_p
)
1469 x_free_colors (f
, &face
->underline_color
, 1);
1470 IF_DEBUG (--ncolors_allocated
);
1473 if (face
->overline_p
1474 && !face
->overline_color_defaulted_p
)
1476 x_free_colors (f
, &face
->overline_color
, 1);
1477 IF_DEBUG (--ncolors_allocated
);
1480 if (face
->strike_through_p
1481 && !face
->strike_through_color_defaulted_p
)
1483 x_free_colors (f
, &face
->strike_through_color
, 1);
1484 IF_DEBUG (--ncolors_allocated
);
1487 if (face
->box
!= FACE_NO_BOX
1488 && !face
->box_color_defaulted_p
)
1490 x_free_colors (f
, &face
->box_color
, 1);
1491 IF_DEBUG (--ncolors_allocated
);
1495 #endif /* HAVE_X_WINDOWS */
1498 #endif /* HAVE_WINDOW_SYSTEM */
1502 /***********************************************************************
1504 ***********************************************************************/
1506 /* An enumerator for each field of an XLFD font name. */
1527 /* An enumerator for each possible slant value of a font. Taken from
1528 the XLFD specification. */
1536 XLFD_SLANT_REVERSE_ITALIC
,
1537 XLFD_SLANT_REVERSE_OBLIQUE
,
1541 /* Relative font weight according to XLFD documentation. */
1545 XLFD_WEIGHT_UNKNOWN
,
1546 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1547 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1548 XLFD_WEIGHT_LIGHT
, /* 30 */
1549 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1550 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1551 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1552 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1553 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1554 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1557 /* Relative proportionate width. */
1561 XLFD_SWIDTH_UNKNOWN
,
1562 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1563 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1564 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1565 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1566 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1567 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1568 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1569 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1570 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1573 /* Order by which font selection chooses fonts. The default values
1574 mean `first, find a best match for the font width, then for the
1575 font height, then for weight, then for slant.' This variable can be
1576 set via set-face-font-sort-order. */
1578 static int font_sort_order
[4];
1580 #ifdef HAVE_WINDOW_SYSTEM
1582 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1585 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1587 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1588 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1591 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1593 enum font_property_index idx
= font_props_for_sorting
[i
];
1594 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1597 if (idx
<= FONT_REGISTRY_INDEX
)
1600 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1602 result
= STRINGP (val2
) ? 1 : 0;
1606 if (INTEGERP (val1
))
1607 result
= INTEGERP (val2
) ? XINT (val1
) - XINT (val2
) : -1;
1609 result
= INTEGERP (val2
) ? 1 : 0;
1617 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1618 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1619 If FAMILY is omitted or nil, list all families.
1620 Otherwise, FAMILY must be a string, possibly containing wildcards
1622 If FRAME is omitted or nil, use the selected frame.
1623 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1624 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1625 FAMILY is the font family name. POINT-SIZE is the size of the
1626 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1627 width, weight and slant of the font. These symbols are the same as for
1628 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1629 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1630 giving the registry and encoding of the font.
1631 The result list is sorted according to the current setting of
1632 the face font sort order. */)
1633 (Lisp_Object family
, Lisp_Object frame
)
1635 Lisp_Object font_spec
, list
, *drivers
, vec
;
1636 int i
, nfonts
, ndrivers
;
1640 frame
= selected_frame
;
1641 CHECK_LIVE_FRAME (frame
);
1643 font_spec
= Ffont_spec (0, NULL
);
1646 CHECK_STRING (family
);
1647 font_parse_family_registry (family
, Qnil
, font_spec
);
1650 list
= font_list_entities (frame
, font_spec
);
1654 /* Sort the font entities. */
1655 for (i
= 0; i
< 4; i
++)
1656 switch (font_sort_order
[i
])
1659 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1660 case XLFD_POINT_SIZE
:
1661 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1663 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1665 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1667 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1668 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1669 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1670 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1672 ndrivers
= XINT (Flength (list
));
1673 drivers
= alloca (sizeof (Lisp_Object
) * ndrivers
);
1674 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1675 drivers
[i
] = XCAR (list
);
1676 vec
= Fvconcat (ndrivers
, drivers
);
1677 nfonts
= ASIZE (vec
);
1679 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1680 compare_fonts_by_sort_order
);
1683 for (i
= nfonts
- 1; i
>= 0; --i
)
1685 Lisp_Object font
= AREF (vec
, i
);
1686 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1688 Lisp_Object spacing
;
1690 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1691 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1692 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1693 XFRAME (frame
)->resy
);
1694 ASET (v
, 2, make_number (point
));
1695 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1696 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1697 spacing
= Ffont_get (font
, QCspacing
);
1698 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1699 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1700 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1702 result
= Fcons (v
, result
);
1708 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1709 doc
: /* Return a list of the names of available fonts matching PATTERN.
1710 If optional arguments FACE and FRAME are specified, return only fonts
1711 the same size as FACE on FRAME.
1713 PATTERN should be a string containing a font name in the XLFD,
1714 Fontconfig, or GTK format. A font name given in the XLFD format may
1715 contain wildcard characters:
1716 the * character matches any substring, and
1717 the ? character matches any single character.
1718 PATTERN is case-insensitive.
1720 The return value is a list of strings, suitable as arguments to
1723 Fonts Emacs can't use may or may not be excluded
1724 even if they match PATTERN and FACE.
1725 The optional fourth argument MAXIMUM sets a limit on how many
1726 fonts to match. The first MAXIMUM fonts are reported.
1727 The optional fifth argument WIDTH, if specified, is a number of columns
1728 occupied by a character of a font. In that case, return only fonts
1729 the WIDTH times as wide as FACE on FRAME. */)
1730 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1731 Lisp_Object maximum
, Lisp_Object width
)
1734 int size
, avgwidth
IF_LINT (= 0);
1737 CHECK_STRING (pattern
);
1739 if (! NILP (maximum
))
1740 CHECK_NATNUM (maximum
);
1743 CHECK_NUMBER (width
);
1745 /* We can't simply call check_x_frame because this function may be
1746 called before any frame is created. */
1748 frame
= selected_frame
;
1749 f
= frame_or_selected_frame (frame
, 2);
1750 if (! FRAME_WINDOW_P (f
))
1752 /* Perhaps we have not yet created any frame. */
1758 /* Determine the width standard for comparison with the fonts we find. */
1764 /* This is of limited utility since it works with character
1765 widths. Keep it for compatibility. --gerd. */
1766 int face_id
= lookup_named_face (f
, face
, 0);
1767 struct face
*width_face
= (face_id
< 0
1769 : FACE_FROM_ID (f
, face_id
));
1771 if (width_face
&& width_face
->font
)
1773 size
= width_face
->font
->pixel_size
;
1774 avgwidth
= width_face
->font
->average_width
;
1778 size
= FRAME_FONT (f
)->pixel_size
;
1779 avgwidth
= FRAME_FONT (f
)->average_width
;
1782 avgwidth
*= XINT (width
);
1786 Lisp_Object font_spec
;
1787 Lisp_Object args
[2], tail
;
1789 font_spec
= font_spec_from_name (pattern
);
1790 if (!FONTP (font_spec
))
1791 signal_error ("Invalid font name", pattern
);
1795 Ffont_put (font_spec
, QCsize
, make_number (size
));
1796 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1798 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1799 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1801 Lisp_Object font_entity
;
1803 font_entity
= XCAR (tail
);
1804 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1805 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1806 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1808 /* This is a scalable font. For backward compatibility,
1809 we set the specified size. */
1810 font_entity
= copy_font_spec (font_entity
);
1811 ASET (font_entity
, FONT_SIZE_INDEX
,
1812 AREF (font_spec
, FONT_SIZE_INDEX
));
1814 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1817 /* We don't have to check fontsets. */
1819 args
[1] = list_fontsets (f
, pattern
, size
);
1820 return Fnconc (2, args
);
1824 #endif /* HAVE_WINDOW_SYSTEM */
1827 /***********************************************************************
1829 ***********************************************************************/
1831 /* Access face attributes of face LFACE, a Lisp vector. */
1833 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1834 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1835 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1836 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1837 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1838 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1839 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1840 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1841 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1842 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1843 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1844 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1845 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1846 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1847 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1848 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1849 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1852 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1853 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1855 #define LFACEP(LFACE) \
1857 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1858 && EQ (AREF (LFACE, 0), Qface))
1864 /* Check consistency of Lisp face attribute vector ATTRS. */
1867 check_lface_attrs (Lisp_Object
*attrs
)
1869 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1870 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1871 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1872 xassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1873 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1874 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1875 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1876 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1877 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1878 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1879 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1880 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1881 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1882 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1883 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1884 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1885 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1886 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1887 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1888 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1889 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1890 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1891 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1892 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
1893 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1894 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1895 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1896 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1897 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1898 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1899 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1900 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1901 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1902 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1903 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1904 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1905 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1906 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1907 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1908 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1909 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1910 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1911 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1912 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1913 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1914 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1915 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1916 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1917 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1918 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1919 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1920 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1921 #ifdef HAVE_WINDOW_SYSTEM
1922 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1923 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1924 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1925 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1926 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1927 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1928 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1929 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1930 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1931 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1936 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1939 check_lface (Lisp_Object lface
)
1943 xassert (LFACEP (lface
));
1944 check_lface_attrs (XVECTOR (lface
)->contents
);
1948 #else /* GLYPH_DEBUG == 0 */
1950 #define check_lface_attrs(attrs) (void) 0
1951 #define check_lface(lface) (void) 0
1953 #endif /* GLYPH_DEBUG == 0 */
1957 /* Face-merge cycle checking. */
1959 enum named_merge_point_kind
1961 NAMED_MERGE_POINT_NORMAL
,
1962 NAMED_MERGE_POINT_REMAP
1965 /* A `named merge point' is simply a point during face-merging where we
1966 look up a face by name. We keep a stack of which named lookups we're
1967 currently processing so that we can easily detect cycles, using a
1968 linked- list of struct named_merge_point structures, typically
1969 allocated on the stack frame of the named lookup functions which are
1970 active (so no consing is required). */
1971 struct named_merge_point
1973 Lisp_Object face_name
;
1974 enum named_merge_point_kind named_merge_point_kind
;
1975 struct named_merge_point
*prev
;
1979 /* If a face merging cycle is detected for FACE_NAME, return 0,
1980 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1981 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1982 pointed to by NAMED_MERGE_POINTS, and return 1. */
1985 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1986 Lisp_Object face_name
,
1987 enum named_merge_point_kind named_merge_point_kind
,
1988 struct named_merge_point
**named_merge_points
)
1990 struct named_merge_point
*prev
;
1992 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1993 if (EQ (face_name
, prev
->face_name
))
1995 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1996 /* A cycle, so fail. */
1998 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1999 /* A remap `hides ' any previous normal merge points
2000 (because the remap means that it's actually different face),
2001 so as we know the current merge point must be normal, we
2002 can just assume it's OK. */
2006 new_named_merge_point
->face_name
= face_name
;
2007 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
2008 new_named_merge_point
->prev
= *named_merge_points
;
2010 *named_merge_points
= new_named_merge_point
;
2016 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2017 to make it a symbol. If FACE_NAME is an alias for another face,
2018 return that face's name.
2020 Return default face in case of errors. */
2023 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2025 Lisp_Object orig_face
;
2026 Lisp_Object tortoise
, hare
;
2028 if (STRINGP (face_name
))
2029 face_name
= intern (SSDATA (face_name
));
2031 if (NILP (face_name
) || !SYMBOLP (face_name
))
2034 orig_face
= face_name
;
2035 tortoise
= hare
= face_name
;
2040 hare
= Fget (hare
, Qface_alias
);
2041 if (NILP (hare
) || !SYMBOLP (hare
))
2045 hare
= Fget (hare
, Qface_alias
);
2046 if (NILP (hare
) || !SYMBOLP (hare
))
2049 tortoise
= Fget (tortoise
, Qface_alias
);
2050 if (EQ (hare
, tortoise
))
2053 xsignal1 (Qcircular_list
, orig_face
);
2062 /* Return the face definition of FACE_NAME on frame F. F null means
2063 return the definition for new frames. FACE_NAME may be a string or
2064 a symbol (apparently Emacs 20.2 allowed strings as face names in
2065 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2066 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2067 is zero, value is nil if FACE_NAME is not a valid face name. */
2068 static inline Lisp_Object
2069 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
2075 lface
= assq_no_quit (face_name
, f
->face_alist
);
2077 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2080 lface
= XCDR (lface
);
2082 signal_error ("Invalid face", face_name
);
2084 check_lface (lface
);
2089 /* Return the face definition of FACE_NAME on frame F. F null means
2090 return the definition for new frames. FACE_NAME may be a string or
2091 a symbol (apparently Emacs 20.2 allowed strings as face names in
2092 face text properties; Ediff uses that). If FACE_NAME is an alias
2093 for another face, return that face's definition. If SIGNAL_P is
2094 non-zero, signal an error if FACE_NAME is not a valid face name.
2095 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2097 static inline Lisp_Object
2098 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2100 face_name
= resolve_face_name (face_name
, signal_p
);
2101 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2105 /* Get face attributes of face FACE_NAME from frame-local faces on
2106 frame F. Store the resulting attributes in ATTRS which must point
2107 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2108 is non-zero, signal an error if FACE_NAME does not name a face.
2109 Otherwise, value is zero if FACE_NAME is not a face. */
2112 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
2113 Lisp_Object
*attrs
, int signal_p
)
2117 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2120 memcpy (attrs
, XVECTOR (lface
)->contents
,
2121 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2123 return !NILP (lface
);
2126 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2127 F. Store the resulting attributes in ATTRS which must point to a
2128 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2129 alias for another face, use that face's definition. If SIGNAL_P is
2130 non-zero, signal an error if FACE_NAME does not name a face.
2131 Otherwise, value is zero if FACE_NAME is not a face. */
2134 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2135 Lisp_Object
*attrs
, int signal_p
,
2136 struct named_merge_point
*named_merge_points
)
2138 Lisp_Object face_remapping
;
2140 face_name
= resolve_face_name (face_name
, signal_p
);
2142 /* See if SYMBOL has been remapped to some other face (usually this
2143 is done buffer-locally). */
2144 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2145 if (CONSP (face_remapping
))
2147 struct named_merge_point named_merge_point
;
2149 if (push_named_merge_point (&named_merge_point
,
2150 face_name
, NAMED_MERGE_POINT_REMAP
,
2151 &named_merge_points
))
2155 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2156 attrs
[i
] = Qunspecified
;
2158 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2159 signal_p
, named_merge_points
);
2163 /* Default case, no remapping. */
2164 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2168 /* Non-zero if all attributes in face attribute vector ATTRS are
2169 specified, i.e. are non-nil. */
2172 lface_fully_specified_p (Lisp_Object
*attrs
)
2176 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2177 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2178 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2181 return i
== LFACE_VECTOR_SIZE
;
2184 #ifdef HAVE_WINDOW_SYSTEM
2186 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2187 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2188 exception is `font' attribute. It is set to FONT_OBJECT regardless
2192 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2193 Lisp_Object font_object
, int force_p
)
2196 struct font
*font
= XFONT_OBJECT (font_object
);
2198 /* Set attributes only if unspecified, otherwise face defaults for
2199 new frames would never take effect. If the font doesn't have a
2200 specific property, set a normal value for that. */
2202 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2204 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2206 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2209 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2211 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2213 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2216 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2218 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2221 LFACE_HEIGHT (lface
) = make_number (pt
);
2224 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2226 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2227 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2229 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2231 val
= FONT_SLANT_FOR_FACE (font_object
);
2232 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2234 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2236 val
= FONT_WIDTH_FOR_FACE (font_object
);
2237 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2240 LFACE_FONT (lface
) = font_object
;
2244 #endif /* HAVE_WINDOW_SYSTEM */
2247 /* Merges the face height FROM with the face height TO, and returns the
2248 merged height. If FROM is an invalid height, then INVALID is
2249 returned instead. FROM and TO may be either absolute face heights or
2250 `relative' heights; the returned value is always an absolute height
2251 unless both FROM and TO are relative. */
2254 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2256 Lisp_Object result
= invalid
;
2258 if (INTEGERP (from
))
2259 /* FROM is absolute, just use it as is. */
2261 else if (FLOATP (from
))
2262 /* FROM is a scale, use it to adjust TO. */
2265 /* relative X absolute => absolute */
2266 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
2267 else if (FLOATP (to
))
2268 /* relative X relative => relative */
2269 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2270 else if (UNSPECIFIEDP (to
))
2273 else if (FUNCTIONP (from
))
2274 /* FROM is a function, which use to adjust TO. */
2276 /* Call function with current height as argument.
2277 From is the new height. */
2278 Lisp_Object args
[2];
2282 result
= safe_call (2, args
);
2284 /* Ensure that if TO was absolute, so is the result. */
2285 if (INTEGERP (to
) && !INTEGERP (result
))
2293 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2294 store the resulting attributes in TO, which must be already be
2295 completely specified and contain only absolute attributes. Every
2296 specified attribute of FROM overrides the corresponding attribute of
2297 TO; relative attributes in FROM are merged with the absolute value in
2298 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2299 loops in face inheritance/remapping; it should be 0 when called from
2303 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2304 struct named_merge_point
*named_merge_points
)
2308 /* If FROM inherits from some other faces, merge their attributes into
2309 TO before merging FROM's direct attributes. Note that an :inherit
2310 attribute of `unspecified' is the same as one of nil; we never
2311 merge :inherit attributes, so nil is more correct, but lots of
2312 other code uses `unspecified' as a generic value for face attributes. */
2313 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2314 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2315 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2317 i
= LFACE_FONT_INDEX
;
2318 if (!UNSPECIFIEDP (from
[i
]))
2320 if (!UNSPECIFIEDP (to
[i
]))
2321 to
[i
] = merge_font_spec (from
[i
], to
[i
]);
2323 to
[i
] = copy_font_spec (from
[i
]);
2324 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2325 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2326 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2327 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2328 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2329 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2330 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2331 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2332 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2333 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2334 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2337 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2338 if (!UNSPECIFIEDP (from
[i
]))
2340 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2342 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2343 font_clear_prop (to
, FONT_SIZE_INDEX
);
2345 else if (i
!= LFACE_FONT_INDEX
2346 && ! EQ (to
[i
], from
[i
]))
2349 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2350 font_clear_prop (to
,
2351 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2352 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2353 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2354 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2355 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2356 : FONT_SLANT_INDEX
));
2360 /* TO is always an absolute face, which should inherit from nothing.
2361 We blindly copy the :inherit attribute above and fix it up here. */
2362 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2365 /* Merge the named face FACE_NAME on frame F, into the vector of face
2366 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2367 inheritance. Returns true if FACE_NAME is a valid face name and
2368 merging succeeded. */
2371 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2372 struct named_merge_point
*named_merge_points
)
2374 struct named_merge_point named_merge_point
;
2376 if (push_named_merge_point (&named_merge_point
,
2377 face_name
, NAMED_MERGE_POINT_NORMAL
,
2378 &named_merge_points
))
2380 struct gcpro gcpro1
;
2381 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2382 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2386 GCPRO1 (named_merge_point
.face_name
);
2387 merge_face_vectors (f
, from
, to
, named_merge_points
);
2398 /* Merge face attributes from the lisp `face reference' FACE_REF on
2399 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2400 problems with FACE_REF cause an error message to be shown. Return
2401 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2402 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2403 list structure; it may be 0 for most callers.
2405 FACE_REF may be a single face specification or a list of such
2406 specifications. Each face specification can be:
2408 1. A symbol or string naming a Lisp face.
2410 2. A property list of the form (KEYWORD VALUE ...) where each
2411 KEYWORD is a face attribute name, and value is an appropriate value
2414 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2415 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2416 for compatibility with 20.2.
2418 Face specifications earlier in lists take precedence over later
2422 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2423 int err_msgs
, struct named_merge_point
*named_merge_points
)
2425 int ok
= 1; /* Succeed without an error? */
2427 if (CONSP (face_ref
))
2429 Lisp_Object first
= XCAR (face_ref
);
2431 if (EQ (first
, Qforeground_color
)
2432 || EQ (first
, Qbackground_color
))
2434 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2435 . COLOR). COLOR must be a string. */
2436 Lisp_Object color_name
= XCDR (face_ref
);
2437 Lisp_Object color
= first
;
2439 if (STRINGP (color_name
))
2441 if (EQ (color
, Qforeground_color
))
2442 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2444 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2449 add_to_log ("Invalid face color", color_name
, Qnil
);
2453 else if (SYMBOLP (first
)
2454 && *SDATA (SYMBOL_NAME (first
)) == ':')
2456 /* Assume this is the property list form. */
2457 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2459 Lisp_Object keyword
= XCAR (face_ref
);
2460 Lisp_Object value
= XCAR (XCDR (face_ref
));
2463 /* Specifying `unspecified' is a no-op. */
2464 if (EQ (value
, Qunspecified
))
2466 else if (EQ (keyword
, QCfamily
))
2468 if (STRINGP (value
))
2470 to
[LFACE_FAMILY_INDEX
] = value
;
2471 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2476 else if (EQ (keyword
, QCfoundry
))
2478 if (STRINGP (value
))
2480 to
[LFACE_FOUNDRY_INDEX
] = value
;
2481 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2486 else if (EQ (keyword
, QCheight
))
2488 Lisp_Object new_height
=
2489 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2491 if (! NILP (new_height
))
2493 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2494 font_clear_prop (to
, FONT_SIZE_INDEX
);
2499 else if (EQ (keyword
, QCweight
))
2501 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2503 to
[LFACE_WEIGHT_INDEX
] = value
;
2504 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2509 else if (EQ (keyword
, QCslant
))
2511 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2513 to
[LFACE_SLANT_INDEX
] = value
;
2514 font_clear_prop (to
, FONT_SLANT_INDEX
);
2519 else if (EQ (keyword
, QCunderline
))
2524 to
[LFACE_UNDERLINE_INDEX
] = value
;
2528 else if (EQ (keyword
, QCoverline
))
2533 to
[LFACE_OVERLINE_INDEX
] = value
;
2537 else if (EQ (keyword
, QCstrike_through
))
2542 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2546 else if (EQ (keyword
, QCbox
))
2549 value
= make_number (1);
2550 if (INTEGERP (value
)
2554 to
[LFACE_BOX_INDEX
] = value
;
2558 else if (EQ (keyword
, QCinverse_video
)
2559 || EQ (keyword
, QCreverse_video
))
2561 if (EQ (value
, Qt
) || NILP (value
))
2562 to
[LFACE_INVERSE_INDEX
] = value
;
2566 else if (EQ (keyword
, QCforeground
))
2568 if (STRINGP (value
))
2569 to
[LFACE_FOREGROUND_INDEX
] = value
;
2573 else if (EQ (keyword
, QCbackground
))
2575 if (STRINGP (value
))
2576 to
[LFACE_BACKGROUND_INDEX
] = value
;
2580 else if (EQ (keyword
, QCstipple
))
2582 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
2583 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2584 if (!NILP (pixmap_p
))
2585 to
[LFACE_STIPPLE_INDEX
] = value
;
2590 else if (EQ (keyword
, QCwidth
))
2592 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2594 to
[LFACE_SWIDTH_INDEX
] = value
;
2595 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2600 else if (EQ (keyword
, QCinherit
))
2602 /* This is not really very useful; it's just like a
2603 normal face reference. */
2604 if (! merge_face_ref (f
, value
, to
,
2605 err_msgs
, named_merge_points
))
2613 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2617 face_ref
= XCDR (XCDR (face_ref
));
2622 /* This is a list of face refs. Those at the beginning of the
2623 list take precedence over what follows, so we have to merge
2624 from the end backwards. */
2625 Lisp_Object next
= XCDR (face_ref
);
2628 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2630 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2636 /* FACE_REF ought to be a face name. */
2637 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2638 if (!ok
&& err_msgs
)
2639 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2646 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2647 Sinternal_make_lisp_face
, 1, 2, 0,
2648 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2649 If FACE was not known as a face before, create a new one.
2650 If optional argument FRAME is specified, make a frame-local face
2651 for that frame. Otherwise operate on the global face definition.
2652 Value is a vector of face attributes. */)
2653 (Lisp_Object face
, Lisp_Object frame
)
2655 Lisp_Object global_lface
, lface
;
2659 CHECK_SYMBOL (face
);
2660 global_lface
= lface_from_face_name (NULL
, face
, 0);
2664 CHECK_LIVE_FRAME (frame
);
2666 lface
= lface_from_face_name (f
, face
, 0);
2669 f
= NULL
, lface
= Qnil
;
2671 /* Add a global definition if there is none. */
2672 if (NILP (global_lface
))
2674 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2676 ASET (global_lface
, 0, Qface
);
2677 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2678 Vface_new_frame_defaults
);
2680 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2681 face id to Lisp face is given by the vector lface_id_to_name.
2682 The mapping from Lisp face to Lisp face id is given by the
2683 property `face' of the Lisp face name. */
2684 if (next_lface_id
== lface_id_to_name_size
)
2686 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1,
2687 min (INT_MAX
, MOST_POSITIVE_FIXNUM
),
2688 sizeof *lface_id_to_name
);
2690 lface_id_to_name
[next_lface_id
] = face
;
2691 Fput (face
, Qface
, make_number (next_lface_id
));
2695 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2696 ASET (global_lface
, i
, Qunspecified
);
2698 /* Add a frame-local definition. */
2703 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2705 ASET (lface
, 0, Qface
);
2706 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2709 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2710 ASET (lface
, i
, Qunspecified
);
2713 lface
= global_lface
;
2715 /* Changing a named face means that all realized faces depending on
2716 that face are invalid. Since we cannot tell which realized faces
2717 depend on the face, make sure they are all removed. This is done
2718 by incrementing face_change_count. The next call to
2719 init_iterator will then free realized faces. */
2720 if (NILP (Fget (face
, Qface_no_inherit
)))
2722 ++face_change_count
;
2723 ++windows_or_buffers_changed
;
2726 xassert (LFACEP (lface
));
2727 check_lface (lface
);
2732 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2733 Sinternal_lisp_face_p
, 1, 2, 0,
2734 doc
: /* Return non-nil if FACE names a face.
2735 FACE should be a symbol or string.
2736 If optional second argument FRAME is non-nil, check for the
2737 existence of a frame-local face with name FACE on that frame.
2738 Otherwise check for the existence of a global face. */)
2739 (Lisp_Object face
, Lisp_Object frame
)
2743 face
= resolve_face_name (face
, 1);
2747 CHECK_LIVE_FRAME (frame
);
2748 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2751 lface
= lface_from_face_name (NULL
, face
, 0);
2757 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2758 Sinternal_copy_lisp_face
, 4, 4, 0,
2759 doc
: /* Copy face FROM to TO.
2760 If FRAME is t, copy the global face definition of FROM.
2761 Otherwise, copy the frame-local definition of FROM on FRAME.
2762 If NEW-FRAME is a frame, copy that data into the frame-local
2763 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2764 FRAME controls where the data is copied to.
2766 The value is TO. */)
2767 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2769 Lisp_Object lface
, copy
;
2771 CHECK_SYMBOL (from
);
2776 /* Copy global definition of FROM. We don't make copies of
2777 strings etc. because 20.2 didn't do it either. */
2778 lface
= lface_from_face_name (NULL
, from
, 1);
2779 copy
= Finternal_make_lisp_face (to
, Qnil
);
2783 /* Copy frame-local definition of FROM. */
2784 if (NILP (new_frame
))
2786 CHECK_LIVE_FRAME (frame
);
2787 CHECK_LIVE_FRAME (new_frame
);
2788 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2789 copy
= Finternal_make_lisp_face (to
, new_frame
);
2792 memcpy (XVECTOR (copy
)->contents
, XVECTOR (lface
)->contents
,
2793 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2795 /* Changing a named face means that all realized faces depending on
2796 that face are invalid. Since we cannot tell which realized faces
2797 depend on the face, make sure they are all removed. This is done
2798 by incrementing face_change_count. The next call to
2799 init_iterator will then free realized faces. */
2800 if (NILP (Fget (to
, Qface_no_inherit
)))
2802 ++face_change_count
;
2803 ++windows_or_buffers_changed
;
2810 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2811 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2812 doc
: /* Set attribute ATTR of FACE to VALUE.
2813 FRAME being a frame means change the face on that frame.
2814 FRAME nil means change the face of the selected frame.
2815 FRAME t means change the default for new frames.
2816 FRAME 0 means change the face on all frames, and change the default
2818 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2821 Lisp_Object old_value
= Qnil
;
2822 /* Set one of enum font_property_index (> 0) if ATTR is one of
2823 font-related attributes other than QCfont and QCfontset. */
2824 enum font_property_index prop_index
= 0;
2826 CHECK_SYMBOL (face
);
2827 CHECK_SYMBOL (attr
);
2829 face
= resolve_face_name (face
, 1);
2831 /* If FRAME is 0, change face on all frames, and change the
2832 default for new frames. */
2833 if (INTEGERP (frame
) && XINT (frame
) == 0)
2836 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2837 FOR_EACH_FRAME (tail
, frame
)
2838 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2842 /* Set lface to the Lisp attribute vector of FACE. */
2845 lface
= lface_from_face_name (NULL
, face
, 1);
2847 /* When updating face-new-frame-defaults, we put :ignore-defface
2848 where the caller wants `unspecified'. This forces the frame
2849 defaults to ignore the defface value. Otherwise, the defface
2850 will take effect, which is generally not what is intended.
2851 The value of that attribute will be inherited from some other
2852 face during face merging. See internal_merge_in_global_face. */
2853 if (UNSPECIFIEDP (value
))
2854 value
= QCignore_defface
;
2859 frame
= selected_frame
;
2861 CHECK_LIVE_FRAME (frame
);
2862 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2864 /* If a frame-local face doesn't exist yet, create one. */
2866 lface
= Finternal_make_lisp_face (face
, frame
);
2869 if (EQ (attr
, QCfamily
))
2871 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2873 CHECK_STRING (value
);
2874 if (SCHARS (value
) == 0)
2875 signal_error ("Invalid face family", value
);
2877 old_value
= LFACE_FAMILY (lface
);
2878 LFACE_FAMILY (lface
) = value
;
2879 prop_index
= FONT_FAMILY_INDEX
;
2881 else if (EQ (attr
, QCfoundry
))
2883 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2885 CHECK_STRING (value
);
2886 if (SCHARS (value
) == 0)
2887 signal_error ("Invalid face foundry", value
);
2889 old_value
= LFACE_FOUNDRY (lface
);
2890 LFACE_FOUNDRY (lface
) = value
;
2891 prop_index
= FONT_FOUNDRY_INDEX
;
2893 else if (EQ (attr
, QCheight
))
2895 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2897 if (EQ (face
, Qdefault
))
2899 /* The default face must have an absolute size. */
2900 if (!INTEGERP (value
) || XINT (value
) <= 0)
2901 signal_error ("Default face height not absolute and positive",
2906 /* For non-default faces, do a test merge with a random
2907 height to see if VALUE's ok. */
2908 Lisp_Object test
= merge_face_heights (value
,
2911 if (!INTEGERP (test
) || XINT (test
) <= 0)
2912 signal_error ("Face height does not produce a positive integer",
2917 old_value
= LFACE_HEIGHT (lface
);
2918 LFACE_HEIGHT (lface
) = value
;
2919 prop_index
= FONT_SIZE_INDEX
;
2921 else if (EQ (attr
, QCweight
))
2923 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2925 CHECK_SYMBOL (value
);
2926 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2927 signal_error ("Invalid face weight", value
);
2929 old_value
= LFACE_WEIGHT (lface
);
2930 LFACE_WEIGHT (lface
) = value
;
2931 prop_index
= FONT_WEIGHT_INDEX
;
2933 else if (EQ (attr
, QCslant
))
2935 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2937 CHECK_SYMBOL (value
);
2938 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2939 signal_error ("Invalid face slant", value
);
2941 old_value
= LFACE_SLANT (lface
);
2942 LFACE_SLANT (lface
) = value
;
2943 prop_index
= FONT_SLANT_INDEX
;
2945 else if (EQ (attr
, QCunderline
))
2947 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2948 if ((SYMBOLP (value
)
2950 && !EQ (value
, Qnil
))
2951 /* Underline color. */
2953 && SCHARS (value
) == 0))
2954 signal_error ("Invalid face underline", value
);
2956 old_value
= LFACE_UNDERLINE (lface
);
2957 LFACE_UNDERLINE (lface
) = value
;
2959 else if (EQ (attr
, QCoverline
))
2961 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2962 if ((SYMBOLP (value
)
2964 && !EQ (value
, Qnil
))
2965 /* Overline color. */
2967 && SCHARS (value
) == 0))
2968 signal_error ("Invalid face overline", value
);
2970 old_value
= LFACE_OVERLINE (lface
);
2971 LFACE_OVERLINE (lface
) = value
;
2973 else if (EQ (attr
, QCstrike_through
))
2975 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2976 if ((SYMBOLP (value
)
2978 && !EQ (value
, Qnil
))
2979 /* Strike-through color. */
2981 && SCHARS (value
) == 0))
2982 signal_error ("Invalid face strike-through", value
);
2984 old_value
= LFACE_STRIKE_THROUGH (lface
);
2985 LFACE_STRIKE_THROUGH (lface
) = value
;
2987 else if (EQ (attr
, QCbox
))
2991 /* Allow t meaning a simple box of width 1 in foreground color
2994 value
= make_number (1);
2996 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2998 else if (NILP (value
))
3000 else if (INTEGERP (value
))
3001 valid_p
= XINT (value
) != 0;
3002 else if (STRINGP (value
))
3003 valid_p
= SCHARS (value
) > 0;
3004 else if (CONSP (value
))
3020 if (EQ (k
, QCline_width
))
3022 if (!INTEGERP (v
) || XINT (v
) == 0)
3025 else if (EQ (k
, QCcolor
))
3027 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3030 else if (EQ (k
, QCstyle
))
3032 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3039 valid_p
= NILP (tem
);
3045 signal_error ("Invalid face box", value
);
3047 old_value
= LFACE_BOX (lface
);
3048 LFACE_BOX (lface
) = value
;
3050 else if (EQ (attr
, QCinverse_video
)
3051 || EQ (attr
, QCreverse_video
))
3053 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3055 CHECK_SYMBOL (value
);
3056 if (!EQ (value
, Qt
) && !NILP (value
))
3057 signal_error ("Invalid inverse-video face attribute value", value
);
3059 old_value
= LFACE_INVERSE (lface
);
3060 LFACE_INVERSE (lface
) = value
;
3062 else if (EQ (attr
, QCforeground
))
3064 /* Compatibility with 20.x. */
3066 value
= Qunspecified
;
3067 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3069 /* Don't check for valid color names here because it depends
3070 on the frame (display) whether the color will be valid
3071 when the face is realized. */
3072 CHECK_STRING (value
);
3073 if (SCHARS (value
) == 0)
3074 signal_error ("Empty foreground color value", value
);
3076 old_value
= LFACE_FOREGROUND (lface
);
3077 LFACE_FOREGROUND (lface
) = value
;
3079 else if (EQ (attr
, QCbackground
))
3081 /* Compatibility with 20.x. */
3083 value
= Qunspecified
;
3084 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3086 /* Don't check for valid color names here because it depends
3087 on the frame (display) whether the color will be valid
3088 when the face is realized. */
3089 CHECK_STRING (value
);
3090 if (SCHARS (value
) == 0)
3091 signal_error ("Empty background color value", value
);
3093 old_value
= LFACE_BACKGROUND (lface
);
3094 LFACE_BACKGROUND (lface
) = value
;
3096 else if (EQ (attr
, QCstipple
))
3098 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
3099 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3101 && NILP (Fbitmap_spec_p (value
)))
3102 signal_error ("Invalid stipple attribute", value
);
3103 old_value
= LFACE_STIPPLE (lface
);
3104 LFACE_STIPPLE (lface
) = value
;
3105 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3107 else if (EQ (attr
, QCwidth
))
3109 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3111 CHECK_SYMBOL (value
);
3112 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3113 signal_error ("Invalid face width", value
);
3115 old_value
= LFACE_SWIDTH (lface
);
3116 LFACE_SWIDTH (lface
) = value
;
3117 prop_index
= FONT_WIDTH_INDEX
;
3119 else if (EQ (attr
, QCfont
))
3121 #ifdef HAVE_WINDOW_SYSTEM
3122 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3124 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3128 old_value
= LFACE_FONT (lface
);
3129 if (! FONTP (value
))
3131 if (STRINGP (value
))
3133 Lisp_Object name
= value
;
3134 int fontset
= fs_query_fontset (name
, 0);
3137 name
= fontset_ascii (fontset
);
3138 value
= font_spec_from_name (name
);
3140 signal_error ("Invalid font name", name
);
3143 signal_error ("Invalid font or font-spec", value
);
3146 f
= XFRAME (selected_frame
);
3149 if (! FONT_OBJECT_P (value
))
3151 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3152 Lisp_Object font_object
;
3154 font_object
= font_load_for_lface (f
, attrs
, value
);
3155 if (NILP (font_object
))
3156 signal_error ("Font not available", value
);
3157 value
= font_object
;
3159 set_lface_from_font (f
, lface
, value
, 1);
3162 LFACE_FONT (lface
) = value
;
3164 #endif /* HAVE_WINDOW_SYSTEM */
3166 else if (EQ (attr
, QCfontset
))
3168 #ifdef HAVE_WINDOW_SYSTEM
3169 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3173 old_value
= LFACE_FONTSET (lface
);
3174 tmp
= Fquery_fontset (value
, Qnil
);
3176 signal_error ("Invalid fontset name", value
);
3177 LFACE_FONTSET (lface
) = value
= tmp
;
3179 #endif /* HAVE_WINDOW_SYSTEM */
3181 else if (EQ (attr
, QCinherit
))
3184 if (SYMBOLP (value
))
3187 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3188 if (!SYMBOLP (XCAR (tail
)))
3191 LFACE_INHERIT (lface
) = value
;
3193 signal_error ("Invalid face inheritance", value
);
3195 else if (EQ (attr
, QCbold
))
3197 old_value
= LFACE_WEIGHT (lface
);
3198 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3199 prop_index
= FONT_WEIGHT_INDEX
;
3201 else if (EQ (attr
, QCitalic
))
3204 old_value
= LFACE_SLANT (lface
);
3205 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3206 prop_index
= FONT_SLANT_INDEX
;
3209 signal_error ("Invalid face attribute name", attr
);
3213 /* If a font-related attribute other than QCfont and QCfontset
3214 is specified, and if the original QCfont attribute has a font
3215 (font-spec or font-object), set the corresponding property in
3216 the font to nil so that the font selector doesn't think that
3217 the attribute is mandatory. Also, clear the average
3219 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3222 /* Changing a named face means that all realized faces depending on
3223 that face are invalid. Since we cannot tell which realized faces
3224 depend on the face, make sure they are all removed. This is done
3225 by incrementing face_change_count. The next call to
3226 init_iterator will then free realized faces. */
3228 && NILP (Fget (face
, Qface_no_inherit
))
3229 && NILP (Fequal (old_value
, value
)))
3231 ++face_change_count
;
3232 ++windows_or_buffers_changed
;
3235 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3236 && NILP (Fequal (old_value
, value
)))
3242 if (EQ (face
, Qdefault
))
3244 #ifdef HAVE_WINDOW_SYSTEM
3245 /* Changed font-related attributes of the `default' face are
3246 reflected in changed `font' frame parameters. */
3248 && (prop_index
|| EQ (attr
, QCfont
))
3249 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3250 set_font_frame_param (frame
, lface
);
3252 #endif /* HAVE_WINDOW_SYSTEM */
3254 if (EQ (attr
, QCforeground
))
3255 param
= Qforeground_color
;
3256 else if (EQ (attr
, QCbackground
))
3257 param
= Qbackground_color
;
3259 #ifdef HAVE_WINDOW_SYSTEM
3261 else if (EQ (face
, Qscroll_bar
))
3263 /* Changing the colors of `scroll-bar' sets frame parameters
3264 `scroll-bar-foreground' and `scroll-bar-background'. */
3265 if (EQ (attr
, QCforeground
))
3266 param
= Qscroll_bar_foreground
;
3267 else if (EQ (attr
, QCbackground
))
3268 param
= Qscroll_bar_background
;
3270 #endif /* not WINDOWSNT */
3271 else if (EQ (face
, Qborder
))
3273 /* Changing background color of `border' sets frame parameter
3275 if (EQ (attr
, QCbackground
))
3276 param
= Qborder_color
;
3278 else if (EQ (face
, Qcursor
))
3280 /* Changing background color of `cursor' sets frame parameter
3282 if (EQ (attr
, QCbackground
))
3283 param
= Qcursor_color
;
3285 else if (EQ (face
, Qmouse
))
3287 /* Changing background color of `mouse' sets frame parameter
3289 if (EQ (attr
, QCbackground
))
3290 param
= Qmouse_color
;
3292 #endif /* HAVE_WINDOW_SYSTEM */
3293 else if (EQ (face
, Qmenu
))
3295 /* Indicate that we have to update the menu bar when
3296 realizing faces on FRAME. FRAME t change the
3297 default for new frames. We do this by setting
3298 setting the flag in new face caches */
3301 struct frame
*f
= XFRAME (frame
);
3302 if (FRAME_FACE_CACHE (f
) == NULL
)
3303 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3304 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3307 menu_face_changed_default
= 1;
3313 /* Update `default-frame-alist', which is used for new frames. */
3315 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3318 /* Update the current frame's parameters. */
3321 cons
= XCAR (Vparam_value_alist
);
3322 XSETCAR (cons
, param
);
3323 XSETCDR (cons
, value
);
3324 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3333 /* Update the corresponding face when frame parameter PARAM on frame F
3334 has been assigned the value NEW_VALUE. */
3337 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3338 Lisp_Object new_value
)
3340 Lisp_Object face
= Qnil
;
3343 /* If there are no faces yet, give up. This is the case when called
3344 from Fx_create_frame, and we do the necessary things later in
3345 face-set-after-frame-defaults. */
3346 if (NILP (f
->face_alist
))
3349 if (EQ (param
, Qforeground_color
))
3352 lface
= lface_from_face_name (f
, face
, 1);
3353 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3354 ? new_value
: Qunspecified
);
3355 realize_basic_faces (f
);
3357 else if (EQ (param
, Qbackground_color
))
3361 /* Changing the background color might change the background
3362 mode, so that we have to load new defface specs.
3363 Call frame-update-face-colors to do that. */
3364 XSETFRAME (frame
, f
);
3365 call1 (Qframe_set_background_mode
, frame
);
3368 lface
= lface_from_face_name (f
, face
, 1);
3369 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3370 ? new_value
: Qunspecified
);
3371 realize_basic_faces (f
);
3373 #ifdef HAVE_WINDOW_SYSTEM
3374 else if (EQ (param
, Qborder_color
))
3377 lface
= lface_from_face_name (f
, face
, 1);
3378 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3379 ? new_value
: Qunspecified
);
3381 else if (EQ (param
, Qcursor_color
))
3384 lface
= lface_from_face_name (f
, face
, 1);
3385 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3386 ? new_value
: Qunspecified
);
3388 else if (EQ (param
, Qmouse_color
))
3391 lface
= lface_from_face_name (f
, face
, 1);
3392 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3393 ? new_value
: Qunspecified
);
3397 /* Changing a named face means that all realized faces depending on
3398 that face are invalid. Since we cannot tell which realized faces
3399 depend on the face, make sure they are all removed. This is done
3400 by incrementing face_change_count. The next call to
3401 init_iterator will then free realized faces. */
3403 && NILP (Fget (face
, Qface_no_inherit
)))
3405 ++face_change_count
;
3406 ++windows_or_buffers_changed
;
3411 #ifdef HAVE_WINDOW_SYSTEM
3413 /* Set the `font' frame parameter of FRAME determined from the
3414 font-object set in `default' face attributes LFACE. */
3417 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3419 struct frame
*f
= XFRAME (frame
);
3422 if (FRAME_WINDOW_P (f
)
3423 /* Don't do anything if the font is `unspecified'. This can
3424 happen during frame creation. */
3425 && (font
= LFACE_FONT (lface
),
3426 ! UNSPECIFIEDP (font
)))
3428 if (FONT_SPEC_P (font
))
3430 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3433 LFACE_FONT (lface
) = font
;
3435 f
->default_face_done_p
= 0;
3436 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3441 /* Get the value of X resource RESOURCE, class CLASS for the display
3442 of frame FRAME. This is here because ordinary `x-get-resource'
3443 doesn't take a frame argument. */
3445 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3446 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3447 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3449 Lisp_Object value
= Qnil
;
3450 CHECK_STRING (resource
);
3451 CHECK_STRING (class);
3452 CHECK_LIVE_FRAME (frame
);
3454 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3455 resource
, class, Qnil
, Qnil
);
3461 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3462 If VALUE is "on" or "true", return t. If VALUE is "off" or
3463 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3464 error; if SIGNAL_P is zero, return 0. */
3467 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3469 Lisp_Object result
= make_number (0);
3471 xassert (STRINGP (value
));
3473 if (xstrcasecmp (SSDATA (value
), "on") == 0
3474 || xstrcasecmp (SSDATA (value
), "true") == 0)
3476 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3477 || xstrcasecmp (SSDATA (value
), "false") == 0)
3479 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3480 result
= Qunspecified
;
3482 signal_error ("Invalid face attribute value from X resource", value
);
3488 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3489 Finternal_set_lisp_face_attribute_from_resource
,
3490 Sinternal_set_lisp_face_attribute_from_resource
,
3491 3, 4, 0, doc
: /* */)
3492 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3494 CHECK_SYMBOL (face
);
3495 CHECK_SYMBOL (attr
);
3496 CHECK_STRING (value
);
3498 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3499 value
= Qunspecified
;
3500 else if (EQ (attr
, QCheight
))
3502 value
= Fstring_to_number (value
, make_number (10));
3503 if (XINT (value
) <= 0)
3504 signal_error ("Invalid face height from X resource", value
);
3506 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3507 value
= face_boolean_x_resource_value (value
, 1);
3508 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3509 value
= intern (SSDATA (value
));
3510 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3511 value
= face_boolean_x_resource_value (value
, 1);
3512 else if (EQ (attr
, QCunderline
)
3513 || EQ (attr
, QCoverline
)
3514 || EQ (attr
, QCstrike_through
))
3516 Lisp_Object boolean_value
;
3518 /* If the result of face_boolean_x_resource_value is t or nil,
3519 VALUE does NOT specify a color. */
3520 boolean_value
= face_boolean_x_resource_value (value
, 0);
3521 if (SYMBOLP (boolean_value
))
3522 value
= boolean_value
;
3524 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3525 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3527 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3530 #endif /* HAVE_WINDOW_SYSTEM */
3533 /***********************************************************************
3535 ***********************************************************************/
3537 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3539 /* Make menus on frame F appear as specified by the `menu' face. */
3542 x_update_menu_appearance (struct frame
*f
)
3544 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3548 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3552 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3553 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3554 const char *myname
= SSDATA (Vx_resource_name
);
3557 const char *popup_path
= "popup_menu";
3559 const char *popup_path
= "menu.popup";
3562 if (STRINGP (LFACE_FOREGROUND (lface
)))
3564 sprintf (line
, "%s.%s*foreground: %s",
3566 SDATA (LFACE_FOREGROUND (lface
)));
3567 XrmPutLineResource (&rdb
, line
);
3568 sprintf (line
, "%s.pane.menubar*foreground: %s",
3569 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3570 XrmPutLineResource (&rdb
, line
);
3574 if (STRINGP (LFACE_BACKGROUND (lface
)))
3576 sprintf (line
, "%s.%s*background: %s",
3578 SDATA (LFACE_BACKGROUND (lface
)));
3579 XrmPutLineResource (&rdb
, line
);
3580 sprintf (line
, "%s.pane.menubar*background: %s",
3581 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3582 XrmPutLineResource (&rdb
, line
);
3587 /* On Solaris 5.8, it's been reported that the `menu' face
3588 can be unspecified here, during startup. Why this
3589 happens remains unknown. -- cyd */
3590 && FONTP (LFACE_FONT (lface
))
3591 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3592 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3593 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3594 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3595 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3596 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3598 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3600 const char *suffix
= "List";
3603 #if defined HAVE_X_I18N
3605 const char *suffix
= "Set";
3607 const char *suffix
= "";
3614 #if defined HAVE_X_I18N
3615 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3617 char *fontsetname
= SSDATA (xlfd
);
3619 sprintf (line
, "%s.pane.menubar*font%s: %s",
3620 myname
, suffix
, fontsetname
);
3621 XrmPutLineResource (&rdb
, line
);
3622 sprintf (line
, "%s.%s*font%s: %s",
3623 myname
, popup_path
, suffix
, fontsetname
);
3624 XrmPutLineResource (&rdb
, line
);
3626 if (fontsetname
!= SSDATA (xlfd
))
3627 xfree (fontsetname
);
3631 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3632 free_frame_menubar (f
);
3636 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3639 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3640 Sface_attribute_relative_p
,
3642 doc
: /* Check whether a face attribute value is relative.
3643 Specifically, this function returns t if the attribute ATTRIBUTE
3644 with the value VALUE is relative.
3646 A relative value is one that doesn't entirely override whatever is
3647 inherited from another face. For most possible attributes,
3648 the only relative value that users see is `unspecified'.
3649 However, for :height, floating point values are also relative. */)
3650 (Lisp_Object attribute
, Lisp_Object value
)
3652 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3654 else if (EQ (attribute
, QCheight
))
3655 return INTEGERP (value
) ? Qnil
: Qt
;
3660 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3662 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3663 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3664 the result will be absolute, otherwise it will be relative. */)
3665 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3667 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3669 else if (EQ (attribute
, QCheight
))
3670 return merge_face_heights (value1
, value2
, value1
);
3676 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3677 Sinternal_get_lisp_face_attribute
,
3679 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3680 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3681 face attribute name, signal an error.
3682 If the optional argument FRAME is given, report on face SYMBOL in that
3683 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3684 frames). If FRAME is omitted or nil, use the selected frame. */)
3685 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3687 Lisp_Object lface
, value
= Qnil
;
3689 CHECK_SYMBOL (symbol
);
3690 CHECK_SYMBOL (keyword
);
3693 lface
= lface_from_face_name (NULL
, symbol
, 1);
3697 frame
= selected_frame
;
3698 CHECK_LIVE_FRAME (frame
);
3699 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3702 if (EQ (keyword
, QCfamily
))
3703 value
= LFACE_FAMILY (lface
);
3704 else if (EQ (keyword
, QCfoundry
))
3705 value
= LFACE_FOUNDRY (lface
);
3706 else if (EQ (keyword
, QCheight
))
3707 value
= LFACE_HEIGHT (lface
);
3708 else if (EQ (keyword
, QCweight
))
3709 value
= LFACE_WEIGHT (lface
);
3710 else if (EQ (keyword
, QCslant
))
3711 value
= LFACE_SLANT (lface
);
3712 else if (EQ (keyword
, QCunderline
))
3713 value
= LFACE_UNDERLINE (lface
);
3714 else if (EQ (keyword
, QCoverline
))
3715 value
= LFACE_OVERLINE (lface
);
3716 else if (EQ (keyword
, QCstrike_through
))
3717 value
= LFACE_STRIKE_THROUGH (lface
);
3718 else if (EQ (keyword
, QCbox
))
3719 value
= LFACE_BOX (lface
);
3720 else if (EQ (keyword
, QCinverse_video
)
3721 || EQ (keyword
, QCreverse_video
))
3722 value
= LFACE_INVERSE (lface
);
3723 else if (EQ (keyword
, QCforeground
))
3724 value
= LFACE_FOREGROUND (lface
);
3725 else if (EQ (keyword
, QCbackground
))
3726 value
= LFACE_BACKGROUND (lface
);
3727 else if (EQ (keyword
, QCstipple
))
3728 value
= LFACE_STIPPLE (lface
);
3729 else if (EQ (keyword
, QCwidth
))
3730 value
= LFACE_SWIDTH (lface
);
3731 else if (EQ (keyword
, QCinherit
))
3732 value
= LFACE_INHERIT (lface
);
3733 else if (EQ (keyword
, QCfont
))
3734 value
= LFACE_FONT (lface
);
3735 else if (EQ (keyword
, QCfontset
))
3736 value
= LFACE_FONTSET (lface
);
3738 signal_error ("Invalid face attribute name", keyword
);
3740 if (IGNORE_DEFFACE_P (value
))
3741 return Qunspecified
;
3747 DEFUN ("internal-lisp-face-attribute-values",
3748 Finternal_lisp_face_attribute_values
,
3749 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3750 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3751 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3754 Lisp_Object result
= Qnil
;
3756 CHECK_SYMBOL (attr
);
3758 if (EQ (attr
, QCunderline
))
3759 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3760 else if (EQ (attr
, QCoverline
))
3761 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3762 else if (EQ (attr
, QCstrike_through
))
3763 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3764 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3765 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3771 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3772 Sinternal_merge_in_global_face
, 2, 2, 0,
3773 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3774 Default face attributes override any local face attributes. */)
3775 (Lisp_Object face
, Lisp_Object frame
)
3778 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3779 struct frame
*f
= XFRAME (frame
);
3781 CHECK_LIVE_FRAME (frame
);
3782 global_lface
= lface_from_face_name (NULL
, face
, 1);
3783 local_lface
= lface_from_face_name (f
, face
, 0);
3784 if (NILP (local_lface
))
3785 local_lface
= Finternal_make_lisp_face (face
, frame
);
3787 /* Make every specified global attribute override the local one.
3788 BEWARE!! This is only used from `face-set-after-frame-default' where
3789 the local frame is defined from default specs in `face-defface-spec'
3790 and those should be overridden by global settings. Hence the strange
3791 "global before local" priority. */
3792 lvec
= XVECTOR (local_lface
)->contents
;
3793 gvec
= XVECTOR (global_lface
)->contents
;
3794 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3795 if (IGNORE_DEFFACE_P (gvec
[i
]))
3796 lvec
[i
] = Qunspecified
;
3797 else if (! UNSPECIFIEDP (gvec
[i
]))
3800 /* If the default face was changed, update the face cache and the
3801 `font' frame parameter. */
3802 if (EQ (face
, Qdefault
))
3804 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3805 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3806 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3808 /* This can be NULL (e.g., in batch mode). */
3811 /* Ensure that the face vector is fully specified by merging
3812 the previously-cached vector. */
3813 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3814 merge_face_vectors (f
, lvec
, attrs
, 0);
3815 memcpy (lvec
, attrs
, sizeof attrs
);
3816 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3818 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3819 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3820 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3821 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3822 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3823 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3824 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3827 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3828 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3832 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3833 Fmodify_frame_parameters (frame
,
3834 Fcons (Fcons (Qforeground_color
,
3835 gvec
[LFACE_FOREGROUND_INDEX
]),
3838 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3839 Fmodify_frame_parameters (frame
,
3840 Fcons (Fcons (Qbackground_color
,
3841 gvec
[LFACE_BACKGROUND_INDEX
]),
3850 /* The following function is implemented for compatibility with 20.2.
3851 The function is used in x-resolve-fonts when it is asked to
3852 return fonts with the same size as the font of a face. This is
3853 done in fontset.el. */
3855 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3856 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3857 The font name is, by default, for ASCII characters.
3858 If the optional argument FRAME is given, report on face FACE in that frame.
3859 If FRAME is t, report on the defaults for face FACE (for new frames).
3860 The font default for a face is either nil, or a list
3861 of the form (bold), (italic) or (bold italic).
3862 If FRAME is omitted or nil, use the selected frame. And, in this case,
3863 if the optional third argument CHARACTER is given,
3864 return the font name used for CHARACTER. */)
3865 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3869 Lisp_Object result
= Qnil
;
3870 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3872 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3873 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3874 result
= Fcons (Qbold
, result
);
3876 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3877 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3878 result
= Fcons (Qitalic
, result
);
3884 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3885 int face_id
= lookup_named_face (f
, face
, 1);
3886 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3890 #ifdef HAVE_WINDOW_SYSTEM
3891 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3893 CHECK_CHARACTER (character
);
3894 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3895 fface
= FACE_FROM_ID (f
, face_id
);
3898 ? fface
->font
->props
[FONT_NAME_INDEX
]
3900 #else /* !HAVE_WINDOW_SYSTEM */
3901 return build_string (FRAME_MSDOS_P (f
)
3903 : FRAME_W32_P (f
) ? "w32term"
3910 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3911 all attributes are `equal'. Tries to be fast because this function
3912 is called quite often. */
3915 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3917 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3918 and the other is specified. */
3919 if (XTYPE (v1
) != XTYPE (v2
))
3928 if (SBYTES (v1
) != SBYTES (v2
))
3931 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3938 return !NILP (Fequal (v1
, v2
));
3943 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3944 all attributes are `equal'. Tries to be fast because this function
3945 is called quite often. */
3948 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3952 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3953 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3959 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3960 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3961 doc
: /* True if FACE1 and FACE2 are equal.
3962 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3963 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3964 If FRAME is omitted or nil, use the selected frame. */)
3965 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3969 Lisp_Object lface1
, lface2
;
3974 /* Don't use check_x_frame here because this function is called
3975 before X frames exist. At that time, if FRAME is nil,
3976 selected_frame will be used which is the frame dumped with
3977 Emacs. That frame is not an X frame. */
3978 f
= frame_or_selected_frame (frame
, 2);
3980 lface1
= lface_from_face_name (f
, face1
, 1);
3981 lface2
= lface_from_face_name (f
, face2
, 1);
3982 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3983 XVECTOR (lface2
)->contents
);
3984 return equal_p
? Qt
: Qnil
;
3988 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3989 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3990 doc
: /* True if FACE has no attribute specified.
3991 If the optional argument FRAME is given, report on face FACE in that frame.
3992 If FRAME is t, report on the defaults for face FACE (for new frames).
3993 If FRAME is omitted or nil, use the selected frame. */)
3994 (Lisp_Object face
, Lisp_Object frame
)
4001 frame
= selected_frame
;
4002 CHECK_LIVE_FRAME (frame
);
4006 lface
= lface_from_face_name (NULL
, face
, 1);
4008 lface
= lface_from_face_name (f
, face
, 1);
4010 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4011 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4014 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4018 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4020 doc
: /* Return an alist of frame-local faces defined on FRAME.
4021 For internal use only. */)
4024 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4025 return f
->face_alist
;
4029 /* Return a hash code for Lisp string STRING with case ignored. Used
4030 below in computing a hash value for a Lisp face. */
4032 static inline unsigned
4033 hash_string_case_insensitive (Lisp_Object string
)
4035 const unsigned char *s
;
4037 xassert (STRINGP (string
));
4038 for (s
= SDATA (string
); *s
; ++s
)
4039 hash
= (hash
<< 1) ^ tolower (*s
);
4044 /* Return a hash code for face attribute vector V. */
4046 static inline unsigned
4047 lface_hash (Lisp_Object
*v
)
4049 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4050 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4051 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4052 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4053 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4054 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4055 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4056 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4060 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4061 considering charsets/registries). They do if they specify the same
4062 family, point size, weight, width, slant, and font. Both
4063 LFACE1 and LFACE2 must be fully-specified. */
4066 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4068 xassert (lface_fully_specified_p (lface1
)
4069 && lface_fully_specified_p (lface2
));
4070 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4071 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4072 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4073 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4074 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4075 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4076 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4077 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4078 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4079 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4080 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4081 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4082 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4083 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4089 /***********************************************************************
4091 ***********************************************************************/
4093 /* Allocate and return a new realized face for Lisp face attribute
4096 static struct face
*
4097 make_realized_face (Lisp_Object
*attr
)
4099 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4100 memset (face
, 0, sizeof *face
);
4101 face
->ascii_face
= face
;
4102 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4107 /* Free realized face FACE, including its X resources. FACE may
4111 free_realized_face (struct frame
*f
, struct face
*face
)
4115 #ifdef HAVE_WINDOW_SYSTEM
4116 if (FRAME_WINDOW_P (f
))
4118 /* Free fontset of FACE if it is ASCII face. */
4119 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4120 free_face_fontset (f
, face
);
4125 font_done_for_face (f
, face
);
4126 x_free_gc (f
, face
->gc
);
4131 free_face_colors (f
, face
);
4132 x_destroy_bitmap (f
, face
->stipple
);
4134 #endif /* HAVE_WINDOW_SYSTEM */
4141 /* Prepare face FACE for subsequent display on frame F. This
4142 allocated GCs if they haven't been allocated yet or have been freed
4143 by clearing the face cache. */
4146 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4148 #ifdef HAVE_WINDOW_SYSTEM
4149 xassert (FRAME_WINDOW_P (f
));
4154 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4156 xgcv
.foreground
= face
->foreground
;
4157 xgcv
.background
= face
->background
;
4158 #ifdef HAVE_X_WINDOWS
4159 xgcv
.graphics_exposures
= False
;
4163 #ifdef HAVE_X_WINDOWS
4166 xgcv
.fill_style
= FillOpaqueStippled
;
4167 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4168 mask
|= GCFillStyle
| GCStipple
;
4171 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4173 font_prepare_for_face (f
, face
);
4176 #endif /* HAVE_WINDOW_SYSTEM */
4180 /* Returns the `distance' between the colors X and Y. */
4183 color_distance (XColor
*x
, XColor
*y
)
4185 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
4186 Quoting from that paper:
4188 This formula has results that are very close to L*u*v* (with the
4189 modified lightness curve) and, more importantly, it is a more even
4190 algorithm: it does not have a range of colours where it suddenly
4191 gives far from optimal results.
4193 See <http://www.compuphase.com/cmetric.htm> for more info. */
4195 long r
= (x
->red
- y
->red
) >> 8;
4196 long g
= (x
->green
- y
->green
) >> 8;
4197 long b
= (x
->blue
- y
->blue
) >> 8;
4198 long r_mean
= (x
->red
+ y
->red
) >> 9;
4201 (((512 + r_mean
) * r
* r
) >> 8)
4203 + (((767 - r_mean
) * b
* b
) >> 8);
4207 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4208 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4209 COLOR1 and COLOR2 may be either strings containing the color name,
4210 or lists of the form (RED GREEN BLUE).
4211 If FRAME is unspecified or nil, the current frame is used. */)
4212 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4215 XColor cdef1
, cdef2
;
4218 frame
= selected_frame
;
4219 CHECK_LIVE_FRAME (frame
);
4222 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4223 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4224 signal_error ("Invalid color", color1
);
4225 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4226 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4227 signal_error ("Invalid color", color2
);
4229 return make_number (color_distance (&cdef1
, &cdef2
));
4233 /***********************************************************************
4235 ***********************************************************************/
4237 /* Return a new face cache for frame F. */
4239 static struct face_cache
*
4240 make_face_cache (struct frame
*f
)
4242 struct face_cache
*c
;
4245 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4246 memset (c
, 0, sizeof *c
);
4247 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4248 c
->buckets
= (struct face
**) xmalloc (size
);
4249 memset (c
->buckets
, 0, size
);
4251 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4253 c
->menu_face_changed_p
= menu_face_changed_default
;
4258 /* Clear out all graphics contexts for all realized faces, except for
4259 the basic faces. This should be done from time to time just to avoid
4260 keeping too many graphics contexts that are no longer needed. */
4263 clear_face_gcs (struct face_cache
*c
)
4265 if (c
&& FRAME_WINDOW_P (c
->f
))
4267 #ifdef HAVE_WINDOW_SYSTEM
4269 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4271 struct face
*face
= c
->faces_by_id
[i
];
4272 if (face
&& face
->gc
)
4276 font_done_for_face (c
->f
, face
);
4277 x_free_gc (c
->f
, face
->gc
);
4282 #endif /* HAVE_WINDOW_SYSTEM */
4287 /* Free all realized faces in face cache C, including basic faces.
4288 C may be null. If faces are freed, make sure the frame's current
4289 matrix is marked invalid, so that a display caused by an expose
4290 event doesn't try to use faces we destroyed. */
4293 free_realized_faces (struct face_cache
*c
)
4298 struct frame
*f
= c
->f
;
4300 /* We must block input here because we can't process X events
4301 safely while only some faces are freed, or when the frame's
4302 current matrix still references freed faces. */
4305 for (i
= 0; i
< c
->used
; ++i
)
4307 free_realized_face (f
, c
->faces_by_id
[i
]);
4308 c
->faces_by_id
[i
] = NULL
;
4312 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4313 memset (c
->buckets
, 0, size
);
4315 /* Must do a thorough redisplay the next time. Mark current
4316 matrices as invalid because they will reference faces freed
4317 above. This function is also called when a frame is
4318 destroyed. In this case, the root window of F is nil. */
4319 if (WINDOWP (f
->root_window
))
4321 clear_current_matrices (f
);
4322 ++windows_or_buffers_changed
;
4330 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4331 This is done after attributes of a named face have been changed,
4332 because we can't tell which realized faces depend on that face. */
4335 free_all_realized_faces (Lisp_Object frame
)
4340 FOR_EACH_FRAME (rest
, frame
)
4341 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4344 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4348 /* Free face cache C and faces in it, including their X resources. */
4351 free_face_cache (struct face_cache
*c
)
4355 free_realized_faces (c
);
4357 xfree (c
->faces_by_id
);
4363 /* Cache realized face FACE in face cache C. HASH is the hash value
4364 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4365 FACE), insert the new face to the beginning of the collision list
4366 of the face hash table of C. Otherwise, add the new face to the
4367 end of the collision list. This way, lookup_face can quickly find
4368 that a requested face is not cached. */
4371 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4373 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4377 if (face
->ascii_face
!= face
)
4379 struct face
*last
= c
->buckets
[i
];
4390 c
->buckets
[i
] = face
;
4391 face
->prev
= face
->next
= NULL
;
4397 face
->next
= c
->buckets
[i
];
4399 face
->next
->prev
= face
;
4400 c
->buckets
[i
] = face
;
4403 /* Find a free slot in C->faces_by_id and use the index of the free
4404 slot as FACE->id. */
4405 for (i
= 0; i
< c
->used
; ++i
)
4406 if (c
->faces_by_id
[i
] == NULL
)
4411 /* Check that FACE got a unique id. */
4416 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4417 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4423 #endif /* GLYPH_DEBUG */
4425 /* Maybe enlarge C->faces_by_id. */
4428 if (c
->used
== c
->size
)
4429 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4430 sizeof *c
->faces_by_id
);
4434 c
->faces_by_id
[i
] = face
;
4438 /* Remove face FACE from cache C. */
4441 uncache_face (struct face_cache
*c
, struct face
*face
)
4443 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4446 face
->prev
->next
= face
->next
;
4448 c
->buckets
[i
] = face
->next
;
4451 face
->next
->prev
= face
->prev
;
4453 c
->faces_by_id
[face
->id
] = NULL
;
4454 if (face
->id
== c
->used
)
4459 /* Look up a realized face with face attributes ATTR in the face cache
4460 of frame F. The face will be used to display ASCII characters.
4461 Value is the ID of the face found. If no suitable face is found,
4462 realize a new one. */
4465 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4467 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4472 xassert (cache
!= NULL
);
4473 check_lface_attrs (attr
);
4475 /* Look up ATTR in the face cache. */
4476 hash
= lface_hash (attr
);
4477 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4479 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4481 if (face
->ascii_face
!= face
)
4483 /* There's no more ASCII face. */
4487 if (face
->hash
== hash
4488 && lface_equal_p (face
->lface
, attr
))
4492 /* If not found, realize a new face. */
4494 face
= realize_face (cache
, attr
, -1);
4497 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4498 #endif /* GLYPH_DEBUG */
4503 #ifdef HAVE_WINDOW_SYSTEM
4504 /* Look up a realized face that has the same attributes as BASE_FACE
4505 except for the font in the face cache of frame F. If FONT-OBJECT
4506 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4507 the face has no font. Value is the ID of the face found. If no
4508 suitable face is found, realize a new one. */
4511 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4513 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4518 xassert (cache
!= NULL
);
4519 base_face
= base_face
->ascii_face
;
4520 hash
= lface_hash (base_face
->lface
);
4521 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4523 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4525 if (face
->ascii_face
== face
)
4527 if (face
->ascii_face
== base_face
4528 && face
->font
== (NILP (font_object
) ? NULL
4529 : XFONT_OBJECT (font_object
))
4530 && lface_equal_p (face
->lface
, base_face
->lface
))
4534 /* If not found, realize a new face. */
4535 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4538 #endif /* HAVE_WINDOW_SYSTEM */
4540 /* Return the face id of the realized face for named face SYMBOL on
4541 frame F suitable for displaying ASCII characters. Value is -1 if
4542 the face couldn't be determined, which might happen if the default
4543 face isn't realized and cannot be realized. */
4546 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4548 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4549 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4550 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4552 if (default_face
== NULL
)
4554 if (!realize_basic_faces (f
))
4556 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4557 if (default_face
== NULL
)
4558 abort (); /* realize_basic_faces must have set it up */
4561 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4564 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4565 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4567 return lookup_face (f
, attrs
);
4571 /* Return the display face-id of the basic face who's canonical face-id
4572 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4573 basic face has bee remapped via Vface_remapping_alist. This function is
4574 conservative: if something goes wrong, it will simply return FACE_ID
4575 rather than signal an error. */
4578 lookup_basic_face (struct frame
*f
, int face_id
)
4580 Lisp_Object name
, mapping
;
4581 int remapped_face_id
;
4583 if (NILP (Vface_remapping_alist
))
4584 return face_id
; /* Nothing to do. */
4588 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4589 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4590 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4591 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4592 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4593 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4594 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4595 case BORDER_FACE_ID
: name
= Qborder
; break;
4596 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4597 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4598 case MENU_FACE_ID
: name
= Qmenu
; break;
4601 abort (); /* the caller is supposed to pass us a basic face id */
4604 /* Do a quick scan through Vface_remapping_alist, and return immediately
4605 if there is no remapping for face NAME. This is just an optimization
4606 for the very common no-remapping case. */
4607 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4609 return face_id
; /* Give up. */
4611 /* If there is a remapping entry, lookup the face using NAME, which will
4612 handle the remapping too. */
4613 remapped_face_id
= lookup_named_face (f
, name
, 0);
4614 if (remapped_face_id
< 0)
4615 return face_id
; /* Give up. */
4617 return remapped_face_id
;
4621 /* Return a face for charset ASCII that is like the face with id
4622 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4623 STEPS < 0 means larger. Value is the id of the face. */
4626 smaller_face (struct frame
*f
, int face_id
, int steps
)
4628 #ifdef HAVE_WINDOW_SYSTEM
4630 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4631 int pt
, last_pt
, last_height
;
4634 struct face
*new_face
;
4636 /* If not called for an X frame, just return the original face. */
4637 if (FRAME_TERMCAP_P (f
))
4640 /* Try in increments of 1/2 pt. */
4641 delta
= steps
< 0 ? 5 : -5;
4642 steps
= eabs (steps
);
4644 face
= FACE_FROM_ID (f
, face_id
);
4645 memcpy (attrs
, face
->lface
, sizeof attrs
);
4646 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4647 new_face_id
= face_id
;
4648 last_height
= FONT_HEIGHT (face
->font
);
4652 /* Give up if we cannot find a font within 10pt. */
4653 && eabs (last_pt
- pt
) < 100)
4655 /* Look up a face for a slightly smaller/larger font. */
4657 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4658 new_face_id
= lookup_face (f
, attrs
);
4659 new_face
= FACE_FROM_ID (f
, new_face_id
);
4661 /* If height changes, count that as one step. */
4662 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4663 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4666 last_height
= FONT_HEIGHT (new_face
->font
);
4673 #else /* not HAVE_WINDOW_SYSTEM */
4677 #endif /* not HAVE_WINDOW_SYSTEM */
4681 /* Return a face for charset ASCII that is like the face with id
4682 FACE_ID on frame F, but has height HEIGHT. */
4685 face_with_height (struct frame
*f
, int face_id
, int height
)
4687 #ifdef HAVE_WINDOW_SYSTEM
4689 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4691 if (FRAME_TERMCAP_P (f
)
4695 face
= FACE_FROM_ID (f
, face_id
);
4696 memcpy (attrs
, face
->lface
, sizeof attrs
);
4697 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4698 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4699 face_id
= lookup_face (f
, attrs
);
4700 #endif /* HAVE_WINDOW_SYSTEM */
4706 /* Return the face id of the realized face for named face SYMBOL on
4707 frame F suitable for displaying ASCII characters, and use
4708 attributes of the face FACE_ID for attributes that aren't
4709 completely specified by SYMBOL. This is like lookup_named_face,
4710 except that the default attributes come from FACE_ID, not from the
4711 default face. FACE_ID is assumed to be already realized. */
4714 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4717 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4718 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4719 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4724 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4727 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4728 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4729 return lookup_face (f
, attrs
);
4732 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4733 Sface_attributes_as_vector
, 1, 1, 0,
4734 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4738 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4740 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4747 /***********************************************************************
4748 Face capability testing
4749 ***********************************************************************/
4752 /* If the distance (as returned by color_distance) between two colors is
4753 less than this, then they are considered the same, for determining
4754 whether a color is supported or not. The range of values is 0-65535. */
4756 #define TTY_SAME_COLOR_THRESHOLD 10000
4758 #ifdef HAVE_WINDOW_SYSTEM
4760 /* Return non-zero if all the face attributes in ATTRS are supported
4761 on the window-system frame F.
4763 The definition of `supported' is somewhat heuristic, but basically means
4764 that a face containing all the attributes in ATTRS, when merged with the
4765 default face for display, can be represented in a way that's
4767 \(1) different in appearance than the default face, and
4768 \(2) `close in spirit' to what the attributes specify, if not exact. */
4771 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4772 struct face
*def_face
)
4774 Lisp_Object
*def_attrs
= def_face
->lface
;
4776 /* Check that other specified attributes are different that the default
4778 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4779 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4780 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4781 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4782 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4783 def_attrs
[LFACE_INVERSE_INDEX
]))
4784 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4785 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4786 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4787 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4788 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4789 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4790 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4791 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4792 def_attrs
[LFACE_STIPPLE_INDEX
]))
4793 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4794 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4795 def_attrs
[LFACE_OVERLINE_INDEX
]))
4796 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4797 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4798 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4799 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4800 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4801 def_attrs
[LFACE_BOX_INDEX
])))
4804 /* Check font-related attributes, as those are the most commonly
4805 "unsupported" on a window-system (because of missing fonts). */
4806 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4807 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4808 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4809 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4810 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4811 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4815 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4818 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4820 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4822 face_id
= lookup_face (f
, merged_attrs
);
4823 face
= FACE_FROM_ID (f
, face_id
);
4826 error ("Cannot make face");
4828 /* If the font is the same, or no font is found, then not
4830 if (face
->font
== def_face
->font
4833 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4834 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4838 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4839 || face
->font
->driver
->case_sensitive
)
4841 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4842 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4843 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4844 s2
, make_number (0), Qnil
, Qt
), Qt
))
4850 /* Everything checks out, this face is supported. */
4854 #endif /* HAVE_WINDOW_SYSTEM */
4856 /* Return non-zero if all the face attributes in ATTRS are supported
4859 The definition of `supported' is somewhat heuristic, but basically means
4860 that a face containing all the attributes in ATTRS, when merged
4861 with the default face for display, can be represented in a way that's
4863 \(1) different in appearance than the default face, and
4864 \(2) `close in spirit' to what the attributes specify, if not exact.
4866 Point (2) implies that a `:weight black' attribute will be satisfied
4867 by any terminal that can display bold, and a `:foreground "yellow"' as
4868 long as the terminal can display a yellowish color, but `:slant italic'
4869 will _not_ be satisfied by the tty display code's automatic
4870 substitution of a `dim' face for italic. */
4873 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4874 struct face
*def_face
)
4877 Lisp_Object val
, fg
, bg
;
4878 XColor fg_tty_color
, fg_std_color
;
4879 XColor bg_tty_color
, bg_std_color
;
4880 unsigned test_caps
= 0;
4881 Lisp_Object
*def_attrs
= def_face
->lface
;
4884 /* First check some easy-to-check stuff; ttys support none of the
4885 following attributes, so we can just return false if any are requested
4886 (even if `nominal' values are specified, we should still return false,
4887 as that will be the same value that the default face uses). We
4888 consider :slant unsupportable on ttys, even though the face code
4889 actually `fakes' them using a dim attribute if possible. This is
4890 because the faked result is too different from what the face
4892 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4893 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4894 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4895 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4896 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4897 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4898 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4899 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4900 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
4904 /* Test for terminal `capabilities' (non-color character attributes). */
4906 /* font weight (bold/dim) */
4907 val
= attrs
[LFACE_WEIGHT_INDEX
];
4908 if (!UNSPECIFIEDP (val
)
4909 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4911 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4915 if (def_weight
> 100)
4916 return 0; /* same as default */
4917 test_caps
= TTY_CAP_BOLD
;
4919 else if (weight
< 100)
4921 if (def_weight
< 100)
4922 return 0; /* same as default */
4923 test_caps
= TTY_CAP_DIM
;
4925 else if (def_weight
== 100)
4926 return 0; /* same as default */
4930 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4931 if (!UNSPECIFIEDP (val
))
4934 return 0; /* ttys can't use colored underlines */
4935 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4936 return 0; /* same as default */
4938 test_caps
|= TTY_CAP_UNDERLINE
;
4942 val
= attrs
[LFACE_INVERSE_INDEX
];
4943 if (!UNSPECIFIEDP (val
))
4945 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4946 return 0; /* same as default */
4948 test_caps
|= TTY_CAP_INVERSE
;
4952 /* Color testing. */
4954 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4955 we use them when calling `tty_capable_p' below, even if the face
4956 specifies no colors. */
4957 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4958 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4960 /* Check if foreground color is close enough. */
4961 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4964 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4966 if (face_attr_equal_p (fg
, def_fg
))
4967 return 0; /* same as default */
4968 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4969 return 0; /* not a valid color */
4970 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4971 > TTY_SAME_COLOR_THRESHOLD
)
4972 return 0; /* displayed color is too different */
4974 /* Make sure the color is really different than the default. */
4976 XColor def_fg_color
;
4977 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
4978 && (color_distance (&fg_tty_color
, &def_fg_color
)
4979 <= TTY_SAME_COLOR_THRESHOLD
))
4984 /* Check if background color is close enough. */
4985 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
4988 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
4990 if (face_attr_equal_p (bg
, def_bg
))
4991 return 0; /* same as default */
4992 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
4993 return 0; /* not a valid color */
4994 else if (color_distance (&bg_tty_color
, &bg_std_color
)
4995 > TTY_SAME_COLOR_THRESHOLD
)
4996 return 0; /* displayed color is too different */
4998 /* Make sure the color is really different than the default. */
5000 XColor def_bg_color
;
5001 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5002 && (color_distance (&bg_tty_color
, &def_bg_color
)
5003 <= TTY_SAME_COLOR_THRESHOLD
))
5008 /* If both foreground and background are requested, see if the
5009 distance between them is OK. We just check to see if the distance
5010 between the tty's foreground and background is close enough to the
5011 distance between the standard foreground and background. */
5012 if (STRINGP (fg
) && STRINGP (bg
))
5015 = (color_distance (&fg_std_color
, &bg_std_color
)
5016 - color_distance (&fg_tty_color
, &bg_tty_color
));
5017 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5018 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5023 /* See if the capabilities we selected above are supported, with the
5025 if (test_caps
!= 0 &&
5026 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
5027 bg_tty_color
.pixel
))
5031 /* Hmmm, everything checks out, this terminal must support this face. */
5036 DEFUN ("display-supports-face-attributes-p",
5037 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5039 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5040 The optional argument DISPLAY can be a display name, a frame, or
5041 nil (meaning the selected frame's display).
5043 The definition of `supported' is somewhat heuristic, but basically means
5044 that a face containing all the attributes in ATTRIBUTES, when merged
5045 with the default face for display, can be represented in a way that's
5047 \(1) different in appearance than the default face, and
5048 \(2) `close in spirit' to what the attributes specify, if not exact.
5050 Point (2) implies that a `:weight black' attribute will be satisfied by
5051 any display that can display bold, and a `:foreground \"yellow\"' as long
5052 as it can display a yellowish color, but `:slant italic' will _not_ be
5053 satisfied by the tty display code's automatic substitution of a `dim'
5054 face for italic. */)
5055 (Lisp_Object attributes
, Lisp_Object display
)
5057 int supports
= 0, i
;
5060 struct face
*def_face
;
5061 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5063 if (noninteractive
|| !initialized
)
5064 /* We may not be able to access low-level face information in batch
5065 mode, or before being dumped, and this function is not going to
5066 be very useful in those cases anyway, so just give up. */
5070 frame
= selected_frame
;
5071 else if (FRAMEP (display
))
5075 /* Find any frame on DISPLAY. */
5076 Lisp_Object fl_tail
;
5079 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5081 frame
= XCAR (fl_tail
);
5082 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5083 XFRAME (frame
)->param_alist
)),
5089 CHECK_LIVE_FRAME (frame
);
5092 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5093 attrs
[i
] = Qunspecified
;
5094 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5096 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5097 if (def_face
== NULL
)
5099 if (! realize_basic_faces (f
))
5100 error ("Cannot realize default face");
5101 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5102 if (def_face
== NULL
)
5103 abort (); /* realize_basic_faces must have set it up */
5106 /* Dispatch to the appropriate handler. */
5107 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5108 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5109 #ifdef HAVE_WINDOW_SYSTEM
5111 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5114 return supports
? Qt
: Qnil
;
5118 /***********************************************************************
5120 ***********************************************************************/
5122 DEFUN ("internal-set-font-selection-order",
5123 Finternal_set_font_selection_order
,
5124 Sinternal_set_font_selection_order
, 1, 1, 0,
5125 doc
: /* Set font selection order for face font selection to ORDER.
5126 ORDER must be a list of length 4 containing the symbols `:width',
5127 `:height', `:weight', and `:slant'. Face attributes appearing
5128 first in ORDER are matched first, e.g. if `:height' appears before
5129 `:weight' in ORDER, font selection first tries to find a font with
5130 a suitable height, and then tries to match the font weight.
5136 int indices
[DIM (font_sort_order
)];
5139 memset (indices
, 0, sizeof indices
);
5143 CONSP (list
) && i
< DIM (indices
);
5144 list
= XCDR (list
), ++i
)
5146 Lisp_Object attr
= XCAR (list
);
5149 if (EQ (attr
, QCwidth
))
5151 else if (EQ (attr
, QCheight
))
5152 xlfd
= XLFD_POINT_SIZE
;
5153 else if (EQ (attr
, QCweight
))
5155 else if (EQ (attr
, QCslant
))
5160 if (indices
[i
] != 0)
5165 if (!NILP (list
) || i
!= DIM (indices
))
5166 signal_error ("Invalid font sort order", order
);
5167 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5168 if (indices
[i
] == 0)
5169 signal_error ("Invalid font sort order", order
);
5171 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5173 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5174 free_all_realized_faces (Qnil
);
5177 font_update_sort_order (font_sort_order
);
5183 DEFUN ("internal-set-alternative-font-family-alist",
5184 Finternal_set_alternative_font_family_alist
,
5185 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5186 doc
: /* Define alternative font families to try in face font selection.
5187 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5188 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5189 be found. Value is ALIST. */)
5192 Lisp_Object entry
, tail
, tail2
;
5195 alist
= Fcopy_sequence (alist
);
5196 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5198 entry
= XCAR (tail
);
5200 entry
= Fcopy_sequence (entry
);
5201 XSETCAR (tail
, entry
);
5202 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5203 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5206 Vface_alternative_font_family_alist
= alist
;
5207 free_all_realized_faces (Qnil
);
5212 DEFUN ("internal-set-alternative-font-registry-alist",
5213 Finternal_set_alternative_font_registry_alist
,
5214 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5215 doc
: /* Define alternative font registries to try in face font selection.
5216 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5217 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5218 be found. Value is ALIST. */)
5221 Lisp_Object entry
, tail
, tail2
;
5224 alist
= Fcopy_sequence (alist
);
5225 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5227 entry
= XCAR (tail
);
5229 entry
= Fcopy_sequence (entry
);
5230 XSETCAR (tail
, entry
);
5231 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5232 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5234 Vface_alternative_font_registry_alist
= alist
;
5235 free_all_realized_faces (Qnil
);
5240 #ifdef HAVE_WINDOW_SYSTEM
5242 /* Return the fontset id of the base fontset name or alias name given
5243 by the fontset attribute of ATTRS. Value is -1 if the fontset
5244 attribute of ATTRS doesn't name a fontset. */
5247 face_fontset (Lisp_Object
*attrs
)
5251 name
= attrs
[LFACE_FONTSET_INDEX
];
5252 if (!STRINGP (name
))
5254 return fs_query_fontset (name
, 0);
5257 #endif /* HAVE_WINDOW_SYSTEM */
5261 /***********************************************************************
5263 ***********************************************************************/
5265 /* Realize basic faces on frame F. Value is zero if frame parameters
5266 of F don't contain enough information needed to realize the default
5270 realize_basic_faces (struct frame
*f
)
5273 int count
= SPECPDL_INDEX ();
5275 /* Block input here so that we won't be surprised by an X expose
5276 event, for instance, without having the faces set up. */
5278 specbind (Qscalable_fonts_allowed
, Qt
);
5280 if (realize_default_face (f
))
5282 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5283 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5284 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5285 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5286 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5287 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5288 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5289 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5290 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5291 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5292 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5294 /* Reflect changes in the `menu' face in menu bars. */
5295 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5297 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5298 #ifdef USE_X_TOOLKIT
5299 if (FRAME_WINDOW_P (f
))
5300 x_update_menu_appearance (f
);
5307 unbind_to (count
, Qnil
);
5313 /* Realize the default face on frame F. If the face is not fully
5314 specified, make it fully-specified. Attributes of the default face
5315 that are not explicitly specified are taken from frame parameters. */
5318 realize_default_face (struct frame
*f
)
5320 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5322 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5325 /* If the `default' face is not yet known, create it. */
5326 lface
= lface_from_face_name (f
, Qdefault
, 0);
5330 XSETFRAME (frame
, f
);
5331 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5334 #ifdef HAVE_WINDOW_SYSTEM
5335 if (FRAME_WINDOW_P (f
))
5337 Lisp_Object font_object
;
5339 XSETFONT (font_object
, FRAME_FONT (f
));
5340 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5341 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5342 f
->default_face_done_p
= 1;
5344 #endif /* HAVE_WINDOW_SYSTEM */
5346 if (!FRAME_WINDOW_P (f
))
5348 LFACE_FAMILY (lface
) = build_string ("default");
5349 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5350 LFACE_SWIDTH (lface
) = Qnormal
;
5351 LFACE_HEIGHT (lface
) = make_number (1);
5352 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5353 LFACE_WEIGHT (lface
) = Qnormal
;
5354 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5355 LFACE_SLANT (lface
) = Qnormal
;
5356 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5357 LFACE_FONTSET (lface
) = Qnil
;
5360 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5361 LFACE_UNDERLINE (lface
) = Qnil
;
5363 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5364 LFACE_OVERLINE (lface
) = Qnil
;
5366 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5367 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5369 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5370 LFACE_BOX (lface
) = Qnil
;
5372 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5373 LFACE_INVERSE (lface
) = Qnil
;
5375 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5377 /* This function is called so early that colors are not yet
5378 set in the frame parameter list. */
5379 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5381 if (CONSP (color
) && STRINGP (XCDR (color
)))
5382 LFACE_FOREGROUND (lface
) = XCDR (color
);
5383 else if (FRAME_WINDOW_P (f
))
5385 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5386 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5391 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5393 /* This function is called so early that colors are not yet
5394 set in the frame parameter list. */
5395 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5396 if (CONSP (color
) && STRINGP (XCDR (color
)))
5397 LFACE_BACKGROUND (lface
) = XCDR (color
);
5398 else if (FRAME_WINDOW_P (f
))
5400 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5401 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5406 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5407 LFACE_STIPPLE (lface
) = Qnil
;
5409 /* Realize the face; it must be fully-specified now. */
5410 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5411 check_lface (lface
);
5412 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5413 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5415 #ifdef HAVE_WINDOW_SYSTEM
5416 #ifdef HAVE_X_WINDOWS
5417 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5419 /* This can happen when making a frame on a display that does
5420 not support the default font. */
5424 /* Otherwise, the font specified for the frame was not
5425 acceptable as a font for the default face (perhaps because
5426 auto-scaled fonts are rejected), so we must adjust the frame
5428 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5430 #endif /* HAVE_X_WINDOWS */
5431 #endif /* HAVE_WINDOW_SYSTEM */
5436 /* Realize basic faces other than the default face in face cache C.
5437 SYMBOL is the face name, ID is the face id the realized face must
5438 have. The default face must have been realized already. */
5441 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5443 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5444 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5445 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5446 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5448 /* The default face must exist and be fully specified. */
5449 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5450 check_lface_attrs (attrs
);
5451 xassert (lface_fully_specified_p (attrs
));
5453 /* If SYMBOL isn't know as a face, create it. */
5457 XSETFRAME (frame
, f
);
5458 lface
= Finternal_make_lisp_face (symbol
, frame
);
5461 /* Merge SYMBOL's face with the default face. */
5462 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5463 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5465 /* Realize the face. */
5466 realize_face (c
, attrs
, id
);
5470 /* Realize the fully-specified face with attributes ATTRS in face
5471 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5472 non-negative, it is an ID of face to remove before caching the new
5473 face. Value is a pointer to the newly created realized face. */
5475 static struct face
*
5476 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5480 /* LFACE must be fully specified. */
5481 xassert (cache
!= NULL
);
5482 check_lface_attrs (attrs
);
5484 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5486 /* Remove the former face. */
5487 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5488 uncache_face (cache
, former_face
);
5489 free_realized_face (cache
->f
, former_face
);
5490 SET_FRAME_GARBAGED (cache
->f
);
5493 if (FRAME_WINDOW_P (cache
->f
))
5494 face
= realize_x_face (cache
, attrs
);
5495 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5496 face
= realize_tty_face (cache
, attrs
);
5497 else if (FRAME_INITIAL_P (cache
->f
))
5499 /* Create a dummy face. */
5500 face
= make_realized_face (attrs
);
5505 /* Insert the new face. */
5506 cache_face (cache
, face
, lface_hash (attrs
));
5511 #ifdef HAVE_WINDOW_SYSTEM
5512 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5513 same attributes as BASE_FACE except for the font on frame F.
5514 FONT-OBJECT may be nil, in which case, realized a face of
5517 static struct face
*
5518 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5519 struct face
*base_face
)
5521 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5524 face
= (struct face
*) xmalloc (sizeof *face
);
5529 = (! NILP (font_object
)
5530 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5531 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5533 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5534 face
->colors_copied_bitwise_p
= 1;
5535 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5538 cache_face (cache
, face
, face
->hash
);
5542 #endif /* HAVE_WINDOW_SYSTEM */
5545 /* Realize the fully-specified face with attributes ATTRS in face
5546 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5547 the new face doesn't share font with the default face, a fontname
5548 is allocated from the heap and set in `font_name' of the new face,
5549 but it is not yet loaded here. Value is a pointer to the newly
5550 created realized face. */
5552 static struct face
*
5553 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5555 struct face
*face
= NULL
;
5556 #ifdef HAVE_WINDOW_SYSTEM
5557 struct face
*default_face
;
5559 Lisp_Object stipple
, overline
, strike_through
, box
;
5561 xassert (FRAME_WINDOW_P (cache
->f
));
5563 /* Allocate a new realized face. */
5564 face
= make_realized_face (attrs
);
5565 face
->ascii_face
= face
;
5569 /* Determine the font to use. Most of the time, the font will be
5570 the same as the font of the default face, so try that first. */
5571 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5573 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5575 face
->font
= default_face
->font
;
5577 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5581 /* If the face attribute ATTRS specifies a fontset, use it as
5582 the base of a new realized fontset. Otherwise, use the same
5583 base fontset as of the default face. The base determines
5584 registry and encoding of a font. It may also determine
5585 foundry and family. The other fields of font name pattern
5586 are constructed from ATTRS. */
5587 int fontset
= face_fontset (attrs
);
5589 /* If we are realizing the default face, ATTRS should specify a
5590 fontset. In other words, if FONTSET is -1, we are not
5591 realizing the default face, thus the default face should have
5592 already been realized. */
5596 fontset
= default_face
->fontset
;
5600 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5601 attrs
[LFACE_FONT_INDEX
]
5602 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5603 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5605 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5606 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5616 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5617 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5618 face
->overstrike
= 1;
5620 /* Load colors, and set remaining attributes. */
5622 load_face_colors (f
, face
, attrs
);
5625 box
= attrs
[LFACE_BOX_INDEX
];
5628 /* A simple box of line width 1 drawn in color given by
5630 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5632 face
->box
= FACE_SIMPLE_BOX
;
5633 face
->box_line_width
= 1;
5635 else if (INTEGERP (box
))
5637 /* Simple box of specified line width in foreground color of the
5639 xassert (XINT (box
) != 0);
5640 face
->box
= FACE_SIMPLE_BOX
;
5641 face
->box_line_width
= XINT (box
);
5642 face
->box_color
= face
->foreground
;
5643 face
->box_color_defaulted_p
= 1;
5645 else if (CONSP (box
))
5647 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5648 being one of `raised' or `sunken'. */
5649 face
->box
= FACE_SIMPLE_BOX
;
5650 face
->box_color
= face
->foreground
;
5651 face
->box_color_defaulted_p
= 1;
5652 face
->box_line_width
= 1;
5656 Lisp_Object keyword
, value
;
5658 keyword
= XCAR (box
);
5666 if (EQ (keyword
, QCline_width
))
5668 if (INTEGERP (value
) && XINT (value
) != 0)
5669 face
->box_line_width
= XINT (value
);
5671 else if (EQ (keyword
, QCcolor
))
5673 if (STRINGP (value
))
5675 face
->box_color
= load_color (f
, face
, value
,
5677 face
->use_box_color_for_shadows_p
= 1;
5680 else if (EQ (keyword
, QCstyle
))
5682 if (EQ (value
, Qreleased_button
))
5683 face
->box
= FACE_RAISED_BOX
;
5684 else if (EQ (value
, Qpressed_button
))
5685 face
->box
= FACE_SUNKEN_BOX
;
5690 /* Text underline, overline, strike-through. */
5692 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5694 /* Use default color (same as foreground color). */
5695 face
->underline_p
= 1;
5696 face
->underline_defaulted_p
= 1;
5697 face
->underline_color
= 0;
5699 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5701 /* Use specified color. */
5702 face
->underline_p
= 1;
5703 face
->underline_defaulted_p
= 0;
5704 face
->underline_color
5705 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5706 LFACE_UNDERLINE_INDEX
);
5708 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5710 face
->underline_p
= 0;
5711 face
->underline_defaulted_p
= 0;
5712 face
->underline_color
= 0;
5715 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5716 if (STRINGP (overline
))
5718 face
->overline_color
5719 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5720 LFACE_OVERLINE_INDEX
);
5721 face
->overline_p
= 1;
5723 else if (EQ (overline
, Qt
))
5725 face
->overline_color
= face
->foreground
;
5726 face
->overline_color_defaulted_p
= 1;
5727 face
->overline_p
= 1;
5730 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5731 if (STRINGP (strike_through
))
5733 face
->strike_through_color
5734 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5735 LFACE_STRIKE_THROUGH_INDEX
);
5736 face
->strike_through_p
= 1;
5738 else if (EQ (strike_through
, Qt
))
5740 face
->strike_through_color
= face
->foreground
;
5741 face
->strike_through_color_defaulted_p
= 1;
5742 face
->strike_through_p
= 1;
5745 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5746 if (!NILP (stipple
))
5747 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5748 #endif /* HAVE_WINDOW_SYSTEM */
5754 /* Map a specified color of face FACE on frame F to a tty color index.
5755 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5756 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5757 default foreground/background colors. */
5760 map_tty_color (struct frame
*f
, struct face
*face
,
5761 enum lface_attribute_index idx
, int *defaulted
)
5763 Lisp_Object frame
, color
, def
;
5764 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5765 unsigned long default_pixel
=
5766 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5767 unsigned long pixel
= default_pixel
;
5769 unsigned long default_other_pixel
=
5770 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5773 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5775 XSETFRAME (frame
, f
);
5776 color
= face
->lface
[idx
];
5780 && CONSP (Vtty_defined_color_alist
)
5781 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5784 /* Associations in tty-defined-color-alist are of the form
5785 (NAME INDEX R G B). We need the INDEX part. */
5786 pixel
= XINT (XCAR (XCDR (def
)));
5789 if (pixel
== default_pixel
&& STRINGP (color
))
5791 pixel
= load_color (f
, face
, color
, idx
);
5794 /* If the foreground of the default face is the default color,
5795 use the foreground color defined by the frame. */
5796 if (FRAME_MSDOS_P (f
))
5798 if (pixel
== default_pixel
5799 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5802 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5804 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5805 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5808 else if (pixel
== default_other_pixel
)
5811 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5813 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5814 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5822 face
->foreground
= pixel
;
5824 face
->background
= pixel
;
5828 /* Realize the fully-specified face with attributes ATTRS in face
5829 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5830 Value is a pointer to the newly created realized face. */
5832 static struct face
*
5833 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5837 int face_colors_defaulted
= 0;
5838 struct frame
*f
= cache
->f
;
5840 /* Frame must be a termcap frame. */
5841 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5843 /* Allocate a new realized face. */
5844 face
= make_realized_face (attrs
);
5846 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5849 /* Map face attributes to TTY appearances. We map slant to
5850 dimmed text because we want italic text to appear differently
5851 and because dimmed text is probably used infrequently. */
5852 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5853 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5855 face
->tty_bold_p
= 1;
5856 if (weight
< 100 || slant
!= 100)
5857 face
->tty_dim_p
= 1;
5858 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5859 face
->tty_underline_p
= 1;
5860 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5861 face
->tty_reverse_p
= 1;
5863 /* Map color names to color indices. */
5864 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5865 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5867 /* Swap colors if face is inverse-video. If the colors are taken
5868 from the frame colors, they are already inverted, since the
5869 frame-creation function calls x-handle-reverse-video. */
5870 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5872 unsigned long tem
= face
->foreground
;
5873 face
->foreground
= face
->background
;
5874 face
->background
= tem
;
5877 if (tty_suppress_bold_inverse_default_colors_p
5879 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5880 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5881 face
->tty_bold_p
= 0;
5887 DEFUN ("tty-suppress-bold-inverse-default-colors",
5888 Ftty_suppress_bold_inverse_default_colors
,
5889 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5890 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5891 SUPPRESS non-nil means suppress it.
5892 This affects bold faces on TTYs whose foreground is the default background
5893 color of the display and whose background is the default foreground color.
5894 For such faces, the bold face attribute is ignored if this variable
5896 (Lisp_Object suppress
)
5898 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5899 ++face_change_count
;
5905 /***********************************************************************
5907 ***********************************************************************/
5909 /* Return the ID of the face to use to display character CH with face
5910 property PROP on frame F in current_buffer. */
5913 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5917 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5922 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5923 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5927 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5928 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5929 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5930 merge_face_ref (f
, prop
, attrs
, 1, 0);
5931 face_id
= lookup_face (f
, attrs
);
5937 /* Return the face ID associated with buffer position POS for
5938 displaying ASCII characters. Return in *ENDPTR the position at
5939 which a different face is needed, as far as text properties and
5940 overlays are concerned. W is a window displaying current_buffer.
5942 REGION_BEG, REGION_END delimit the region, so it can be
5945 LIMIT is a position not to scan beyond. That is to limit the time
5946 this function can take.
5948 If MOUSE is non-zero, use the character's mouse-face, not its face.
5950 BASE_FACE_ID, if non-negative, specifies a base face id to use
5951 instead of DEFAULT_FACE_ID.
5953 The face returned is suitable for displaying ASCII characters. */
5956 face_at_buffer_position (struct window
*w
, EMACS_INT pos
,
5957 EMACS_INT region_beg
, EMACS_INT region_end
,
5958 EMACS_INT
*endptr
, EMACS_INT limit
,
5959 int mouse
, int base_face_id
)
5961 struct frame
*f
= XFRAME (w
->frame
);
5962 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5963 Lisp_Object prop
, position
;
5964 ptrdiff_t i
, noverlays
;
5965 Lisp_Object
*overlay_vec
;
5968 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5969 Lisp_Object limit1
, end
;
5970 struct face
*default_face
;
5972 /* W must display the current buffer. We could write this function
5973 to use the frame and buffer of W, but right now it doesn't. */
5974 /* xassert (XBUFFER (w->buffer) == current_buffer); */
5976 XSETFRAME (frame
, f
);
5977 XSETFASTINT (position
, pos
);
5980 if (pos
< region_beg
&& region_beg
< endpos
)
5981 endpos
= region_beg
;
5983 /* Get the `face' or `mouse_face' text property at POS, and
5984 determine the next position at which the property changes. */
5985 prop
= Fget_text_property (position
, propname
, w
->buffer
);
5986 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5987 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
5989 endpos
= XINT (end
);
5991 /* Look at properties from overlays. */
5993 EMACS_INT next_overlay
;
5995 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
5996 if (next_overlay
< endpos
)
5997 endpos
= next_overlay
;
6005 if (base_face_id
>= 0)
6006 face_id
= base_face_id
;
6007 else if (NILP (Vface_remapping_alist
))
6008 face_id
= DEFAULT_FACE_ID
;
6010 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6012 default_face
= FACE_FROM_ID (f
, face_id
);
6015 /* Optimize common cases where we can use the default face. */
6018 && !(pos
>= region_beg
&& pos
< region_end
))
6019 return default_face
->id
;
6021 /* Begin with attributes from the default face. */
6022 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6024 /* Merge in attributes specified via text properties. */
6026 merge_face_ref (f
, prop
, attrs
, 1, 0);
6028 /* Now merge the overlay data. */
6029 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6030 for (i
= 0; i
< noverlays
; i
++)
6035 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6037 merge_face_ref (f
, prop
, attrs
, 1, 0);
6039 oend
= OVERLAY_END (overlay_vec
[i
]);
6040 oendpos
= OVERLAY_POSITION (oend
);
6041 if (oendpos
< endpos
)
6045 /* If in the region, merge in the region face. */
6046 if (pos
>= region_beg
&& pos
< region_end
)
6048 merge_named_face (f
, Qregion
, attrs
, 0);
6050 if (region_end
< endpos
)
6051 endpos
= region_end
;
6056 /* Look up a realized face with the given face attributes,
6057 or realize a new one for ASCII characters. */
6058 return lookup_face (f
, attrs
);
6061 /* Return the face ID at buffer position POS for displaying ASCII
6062 characters associated with overlay strings for overlay OVERLAY.
6064 Like face_at_buffer_position except for OVERLAY. Currently it
6065 simply disregards the `face' properties of all overlays. */
6068 face_for_overlay_string (struct window
*w
, EMACS_INT pos
,
6069 EMACS_INT region_beg
, EMACS_INT region_end
,
6070 EMACS_INT
*endptr
, EMACS_INT limit
,
6071 int mouse
, Lisp_Object overlay
)
6073 struct frame
*f
= XFRAME (w
->frame
);
6074 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6075 Lisp_Object prop
, position
;
6078 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6079 Lisp_Object limit1
, end
;
6080 struct face
*default_face
;
6082 /* W must display the current buffer. We could write this function
6083 to use the frame and buffer of W, but right now it doesn't. */
6084 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6086 XSETFRAME (frame
, f
);
6087 XSETFASTINT (position
, pos
);
6090 if (pos
< region_beg
&& region_beg
< endpos
)
6091 endpos
= region_beg
;
6093 /* Get the `face' or `mouse_face' text property at POS, and
6094 determine the next position at which the property changes. */
6095 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6096 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6097 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6099 endpos
= XINT (end
);
6103 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6105 /* Optimize common cases where we can use the default face. */
6107 && !(pos
>= region_beg
&& pos
< region_end
))
6108 return DEFAULT_FACE_ID
;
6110 /* Begin with attributes from the default face. */
6111 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6113 /* Merge in attributes specified via text properties. */
6115 merge_face_ref (f
, prop
, attrs
, 1, 0);
6117 /* If in the region, merge in the region face. */
6118 if (pos
>= region_beg
&& pos
< region_end
)
6120 merge_named_face (f
, Qregion
, attrs
, 0);
6122 if (region_end
< endpos
)
6123 endpos
= region_end
;
6128 /* Look up a realized face with the given face attributes,
6129 or realize a new one for ASCII characters. */
6130 return lookup_face (f
, attrs
);
6134 /* Compute the face at character position POS in Lisp string STRING on
6135 window W, for ASCII characters.
6137 If STRING is an overlay string, it comes from position BUFPOS in
6138 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6139 not an overlay string. W must display the current buffer.
6140 REGION_BEG and REGION_END give the start and end positions of the
6141 region; both are -1 if no region is visible.
6143 BASE_FACE_ID is the id of a face to merge with. For strings coming
6144 from overlays or the `display' property it is the face at BUFPOS.
6146 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6148 Set *ENDPTR to the next position where to check for faces in
6149 STRING; -1 if the face is constant from POS to the end of the
6152 Value is the id of the face to use. The face returned is suitable
6153 for displaying ASCII characters. */
6156 face_at_string_position (struct window
*w
, Lisp_Object string
,
6157 EMACS_INT pos
, EMACS_INT bufpos
,
6158 EMACS_INT region_beg
, EMACS_INT region_end
,
6159 EMACS_INT
*endptr
, enum face_id base_face_id
,
6162 Lisp_Object prop
, position
, end
, limit
;
6163 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6164 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6165 struct face
*base_face
;
6166 int multibyte_p
= STRING_MULTIBYTE (string
);
6167 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6169 /* Get the value of the face property at the current position within
6170 STRING. Value is nil if there is no face property. */
6171 XSETFASTINT (position
, pos
);
6172 prop
= Fget_text_property (position
, prop_name
, string
);
6174 /* Get the next position at which to check for faces. Value of end
6175 is nil if face is constant all the way to the end of the string.
6176 Otherwise it is a string position where to check faces next.
6177 Limit is the maximum position up to which to check for property
6178 changes in Fnext_single_property_change. Strings are usually
6179 short, so set the limit to the end of the string. */
6180 XSETFASTINT (limit
, SCHARS (string
));
6181 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6183 *endptr
= XFASTINT (end
);
6187 base_face
= FACE_FROM_ID (f
, base_face_id
);
6188 xassert (base_face
);
6190 /* Optimize the default case that there is no face property and we
6191 are not in the region. */
6193 && (base_face_id
!= DEFAULT_FACE_ID
6194 /* BUFPOS <= 0 means STRING is not an overlay string, so
6195 that the region doesn't have to be taken into account. */
6197 || bufpos
< region_beg
6198 || bufpos
>= region_end
)
6200 /* We can't realize faces for different charsets differently
6201 if we don't have fonts, so we can stop here if not working
6202 on a window-system frame. */
6203 || !FRAME_WINDOW_P (f
)
6204 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6205 return base_face
->id
;
6207 /* Begin with attributes from the base face. */
6208 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6210 /* Merge in attributes specified via text properties. */
6212 merge_face_ref (f
, prop
, attrs
, 1, 0);
6214 /* If in the region, merge in the region face. */
6216 && bufpos
>= region_beg
6217 && bufpos
< region_end
)
6218 merge_named_face (f
, Qregion
, attrs
, 0);
6220 /* Look up a realized face with the given face attributes,
6221 or realize a new one for ASCII characters. */
6222 return lookup_face (f
, attrs
);
6226 /* Merge a face into a realized face.
6228 F is frame where faces are (to be) realized.
6230 FACE_NAME is named face to merge.
6232 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6234 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6236 BASE_FACE_ID is realized face to merge into.
6242 merge_faces (struct frame
*f
, Lisp_Object face_name
, EMACS_INT face_id
,
6245 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6246 struct face
*base_face
;
6248 base_face
= FACE_FROM_ID (f
, base_face_id
);
6250 return base_face_id
;
6252 if (EQ (face_name
, Qt
))
6254 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6255 return base_face_id
;
6256 face_name
= lface_id_to_name
[face_id
];
6257 /* When called during make-frame, lookup_derived_face may fail
6258 if the faces are uninitialized. Don't signal an error. */
6259 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6260 return (face_id
>= 0 ? face_id
: base_face_id
);
6263 /* Begin with attributes from the base face. */
6264 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6266 if (!NILP (face_name
))
6268 if (!merge_named_face (f
, face_name
, attrs
, 0))
6269 return base_face_id
;
6275 return base_face_id
;
6276 face
= FACE_FROM_ID (f
, face_id
);
6278 return base_face_id
;
6279 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6282 /* Look up a realized face with the given face attributes,
6283 or realize a new one for ASCII characters. */
6284 return lookup_face (f
, attrs
);
6289 #ifndef HAVE_X_WINDOWS
6290 DEFUN ("x-load-color-file", Fx_load_color_file
,
6291 Sx_load_color_file
, 1, 1, 0,
6292 doc
: /* Create an alist of color entries from an external file.
6294 The file should define one named RGB color per line like so:
6296 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6297 (Lisp_Object filename
)
6300 Lisp_Object cmap
= Qnil
;
6301 Lisp_Object abspath
;
6303 CHECK_STRING (filename
);
6304 abspath
= Fexpand_file_name (filename
, Qnil
);
6306 fp
= fopen (SDATA (abspath
), "rt");
6310 int red
, green
, blue
;
6315 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6316 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6318 char *name
= buf
+ num
;
6319 num
= strlen (name
) - 1;
6320 if (num
>= 0 && name
[num
] == '\n')
6322 cmap
= Fcons (Fcons (build_string (name
),
6324 make_number (RGB (red
, green
, blue
))),
6326 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6341 /***********************************************************************
6343 ***********************************************************************/
6347 /* Print the contents of the realized face FACE to stderr. */
6350 dump_realized_face (struct face
*face
)
6352 fprintf (stderr
, "ID: %d\n", face
->id
);
6353 #ifdef HAVE_X_WINDOWS
6354 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6356 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6358 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6359 fprintf (stderr
, "background: 0x%lx (%s)\n",
6361 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6363 fprintf (stderr
, "font_name: %s (%s)\n",
6364 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6365 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6366 #ifdef HAVE_X_WINDOWS
6367 fprintf (stderr
, "font = %p\n", face
->font
);
6369 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6370 fprintf (stderr
, "underline: %d (%s)\n",
6372 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6373 fprintf (stderr
, "hash: %d\n", face
->hash
);
6377 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6384 fprintf (stderr
, "font selection order: ");
6385 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6386 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6387 fprintf (stderr
, "\n");
6389 fprintf (stderr
, "alternative fonts: ");
6390 debug_print (Vface_alternative_font_family_alist
);
6391 fprintf (stderr
, "\n");
6393 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6394 Fdump_face (make_number (i
));
6400 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6402 error ("Not a valid face");
6403 dump_realized_face (face
);
6410 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6411 0, 0, 0, doc
: /* */)
6414 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6415 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6416 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6420 #endif /* GLYPH_DEBUG != 0 */
6424 /***********************************************************************
6426 ***********************************************************************/
6429 syms_of_xfaces (void)
6431 DEFSYM (Qface
, "face");
6432 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6433 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6434 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6436 /* Lisp face attribute keywords. */
6437 DEFSYM (QCfamily
, ":family");
6438 DEFSYM (QCheight
, ":height");
6439 DEFSYM (QCweight
, ":weight");
6440 DEFSYM (QCslant
, ":slant");
6441 DEFSYM (QCunderline
, ":underline");
6442 DEFSYM (QCinverse_video
, ":inverse-video");
6443 DEFSYM (QCreverse_video
, ":reverse-video");
6444 DEFSYM (QCforeground
, ":foreground");
6445 DEFSYM (QCbackground
, ":background");
6446 DEFSYM (QCstipple
, ":stipple");
6447 DEFSYM (QCwidth
, ":width");
6448 DEFSYM (QCfont
, ":font");
6449 DEFSYM (QCfontset
, ":fontset");
6450 DEFSYM (QCbold
, ":bold");
6451 DEFSYM (QCitalic
, ":italic");
6452 DEFSYM (QCoverline
, ":overline");
6453 DEFSYM (QCstrike_through
, ":strike-through");
6454 DEFSYM (QCbox
, ":box");
6455 DEFSYM (QCinherit
, ":inherit");
6457 /* Symbols used for Lisp face attribute values. */
6458 DEFSYM (QCcolor
, ":color");
6459 DEFSYM (QCline_width
, ":line-width");
6460 DEFSYM (QCstyle
, ":style");
6461 DEFSYM (Qreleased_button
, "released-button");
6462 DEFSYM (Qpressed_button
, "pressed-button");
6463 DEFSYM (Qnormal
, "normal");
6464 DEFSYM (Qultra_light
, "ultra-light");
6465 DEFSYM (Qextra_light
, "extra-light");
6466 DEFSYM (Qlight
, "light");
6467 DEFSYM (Qsemi_light
, "semi-light");
6468 DEFSYM (Qsemi_bold
, "semi-bold");
6469 DEFSYM (Qbold
, "bold");
6470 DEFSYM (Qextra_bold
, "extra-bold");
6471 DEFSYM (Qultra_bold
, "ultra-bold");
6472 DEFSYM (Qoblique
, "oblique");
6473 DEFSYM (Qitalic
, "italic");
6474 DEFSYM (Qreverse_oblique
, "reverse-oblique");
6475 DEFSYM (Qreverse_italic
, "reverse-italic");
6476 DEFSYM (Qultra_condensed
, "ultra-condensed");
6477 DEFSYM (Qextra_condensed
, "extra-condensed");
6478 DEFSYM (Qcondensed
, "condensed");
6479 DEFSYM (Qsemi_condensed
, "semi-condensed");
6480 DEFSYM (Qsemi_expanded
, "semi-expanded");
6481 DEFSYM (Qexpanded
, "expanded");
6482 DEFSYM (Qextra_expanded
, "extra-expanded");
6483 DEFSYM (Qultra_expanded
, "ultra-expanded");
6484 DEFSYM (Qbackground_color
, "background-color");
6485 DEFSYM (Qforeground_color
, "foreground-color");
6486 DEFSYM (Qunspecified
, "unspecified");
6487 DEFSYM (QCignore_defface
, ":ignore-defface");
6489 DEFSYM (Qface_alias
, "face-alias");
6490 DEFSYM (Qdefault
, "default");
6491 DEFSYM (Qtool_bar
, "tool-bar");
6492 DEFSYM (Qregion
, "region");
6493 DEFSYM (Qfringe
, "fringe");
6494 DEFSYM (Qheader_line
, "header-line");
6495 DEFSYM (Qscroll_bar
, "scroll-bar");
6496 DEFSYM (Qmenu
, "menu");
6497 DEFSYM (Qcursor
, "cursor");
6498 DEFSYM (Qborder
, "border");
6499 DEFSYM (Qmouse
, "mouse");
6500 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6501 DEFSYM (Qvertical_border
, "vertical-border");
6502 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6503 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6504 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6505 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6506 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6508 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6509 staticpro (&Vparam_value_alist
);
6510 Vface_alternative_font_family_alist
= Qnil
;
6511 staticpro (&Vface_alternative_font_family_alist
);
6512 Vface_alternative_font_registry_alist
= Qnil
;
6513 staticpro (&Vface_alternative_font_registry_alist
);
6515 defsubr (&Sinternal_make_lisp_face
);
6516 defsubr (&Sinternal_lisp_face_p
);
6517 defsubr (&Sinternal_set_lisp_face_attribute
);
6518 #ifdef HAVE_WINDOW_SYSTEM
6519 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6521 defsubr (&Scolor_gray_p
);
6522 defsubr (&Scolor_supported_p
);
6523 #ifndef HAVE_X_WINDOWS
6524 defsubr (&Sx_load_color_file
);
6526 defsubr (&Sface_attribute_relative_p
);
6527 defsubr (&Smerge_face_attribute
);
6528 defsubr (&Sinternal_get_lisp_face_attribute
);
6529 defsubr (&Sinternal_lisp_face_attribute_values
);
6530 defsubr (&Sinternal_lisp_face_equal_p
);
6531 defsubr (&Sinternal_lisp_face_empty_p
);
6532 defsubr (&Sinternal_copy_lisp_face
);
6533 defsubr (&Sinternal_merge_in_global_face
);
6534 defsubr (&Sface_font
);
6535 defsubr (&Sframe_face_alist
);
6536 defsubr (&Sdisplay_supports_face_attributes_p
);
6537 defsubr (&Scolor_distance
);
6538 defsubr (&Sinternal_set_font_selection_order
);
6539 defsubr (&Sinternal_set_alternative_font_family_alist
);
6540 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6541 defsubr (&Sface_attributes_as_vector
);
6543 defsubr (&Sdump_face
);
6544 defsubr (&Sshow_face_resources
);
6545 #endif /* GLYPH_DEBUG */
6546 defsubr (&Sclear_face_cache
);
6547 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6549 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6550 defsubr (&Sdump_colors
);
6553 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6554 doc
: /* *Limit for font matching.
6555 If an integer > 0, font matching functions won't load more than
6556 that number of fonts when searching for a matching font. */);
6557 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6559 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6560 doc
: /* List of global face definitions (for internal use only.) */);
6561 Vface_new_frame_defaults
= Qnil
;
6563 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6564 doc
: /* *Default stipple pattern used on monochrome displays.
6565 This stipple pattern is used on monochrome displays
6566 instead of shades of gray for a face background color.
6567 See `set-face-stipple' for possible values for this variable. */);
6568 Vface_default_stipple
= make_pure_c_string ("gray3");
6570 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6571 doc
: /* An alist of defined terminal colors and their RGB values.
6572 See the docstring of `tty-color-alist' for the details. */);
6573 Vtty_defined_color_alist
= Qnil
;
6575 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6576 doc
: /* Allowed scalable fonts.
6577 A value of nil means don't allow any scalable fonts.
6578 A value of t means allow any scalable font.
6579 Otherwise, value must be a list of regular expressions. A font may be
6580 scaled if its name matches a regular expression in the list.
6581 Note that if value is nil, a scalable font might still be used, if no
6582 other font of the appropriate family and registry is available. */);
6583 Vscalable_fonts_allowed
= Qnil
;
6585 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6586 doc
: /* List of ignored fonts.
6587 Each element is a regular expression that matches names of fonts to
6589 Vface_ignored_fonts
= Qnil
;
6591 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6592 doc
: /* Alist of face remappings.
6593 Each element is of the form:
6595 (FACE REPLACEMENT...),
6597 which causes display of the face FACE to use REPLACEMENT... instead.
6598 REPLACEMENT... is interpreted the same way as the value of a `face'
6599 text property: it may be (1) A face name, (2) A list of face names,
6600 (3) A property-list of face attribute/value pairs, or (4) A list of
6601 face names or lists containing face attribute/value pairs.
6603 Multiple entries in REPLACEMENT... are merged together to form the final
6604 result, with faces or attributes earlier in the list taking precedence
6605 over those that are later.
6607 Face-name remapping cycles are suppressed; recursive references use the
6608 underlying face instead of the remapped face. So a remapping of the form:
6610 (FACE EXTRA-FACE... FACE)
6614 (FACE (FACE-ATTR VAL ...) FACE)
6616 will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6617 existing definition of FACE. Note that for the default face, this isn't
6618 necessary, as every face inherits from the default face.
6620 Making this variable buffer-local is a good way to allow buffer-specific
6621 face definitions. For instance, the mode my-mode could define a face
6622 `my-mode-default', and then in the mode setup function, do:
6624 (set (make-local-variable 'face-remapping-alist)
6625 '((default my-mode-default)))).
6627 Because Emacs normally only redraws screen areas when the underlying
6628 buffer contents change, you may need to call `redraw-display' after
6629 changing this variable for it to take effect. */);
6630 Vface_remapping_alist
= Qnil
;
6632 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6633 doc
: /* Alist of fonts vs the rescaling factors.
6634 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6635 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6636 RESCALE-RATIO is a floating point number to specify how much larger
6637 \(or smaller) font we should use. For instance, if a face requests
6638 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6639 Vface_font_rescale_alist
= Qnil
;
6641 #ifdef HAVE_WINDOW_SYSTEM
6642 defsubr (&Sbitmap_spec_p
);
6643 defsubr (&Sx_list_fonts
);
6644 defsubr (&Sinternal_face_x_get_resource
);
6645 defsubr (&Sx_family_fonts
);