1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2018 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 (at
10 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 <https://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
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 corresponding 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 you 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 the 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 "sysstdio.h"
205 #include <sys/types.h>
206 #include <sys/stat.h>
209 #include "character.h"
214 #include <Xm/XmStrDefs.h>
215 #endif /* USE_MOTIF */
221 #ifdef HAVE_WINDOW_SYSTEM
225 #define GCGraphicsExposures 0
226 #endif /* HAVE_NTGUI */
229 #define GCGraphicsExposures 0
231 #endif /* HAVE_WINDOW_SYSTEM */
234 #include "dispextern.h"
235 #include "blockinput.h"
237 #include "termchar.h"
241 #ifdef HAVE_X_WINDOWS
243 /* Compensate for a bug in Xos.h on some systems, on which it requires
244 time.h. On some such systems, Xos.h tries to redefine struct
245 timeval and struct timezone if USG is #defined while it is
248 #ifdef XOS_NEEDS_TIME_H
254 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
256 #else /* not XOS_NEEDS_TIME_H */
258 #endif /* not XOS_NEEDS_TIME_H */
260 #endif /* HAVE_X_WINDOWS */
264 /* True if face attribute ATTR is unspecified. */
266 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
268 /* True if face attribute ATTR is `ignore-defface'. */
270 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
272 /* Size of hash table of realized faces in face caches (should be a
275 #define FACE_CACHE_BUCKETS_SIZE 1001
277 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
279 /* Alist of alternative font families. Each element is of the form
280 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
281 try FAMILY1, then FAMILY2, ... */
283 Lisp_Object Vface_alternative_font_family_alist
;
285 /* Alist of alternative font registries. Each element is of the form
286 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
287 loaded, try REGISTRY1, then REGISTRY2, ... */
289 Lisp_Object Vface_alternative_font_registry_alist
;
291 /* The next ID to assign to Lisp faces. */
293 static int next_lface_id
;
295 /* A vector mapping Lisp face Id's to face names. */
297 static Lisp_Object
*lface_id_to_name
;
298 static ptrdiff_t lface_id_to_name_size
;
300 #ifdef HAVE_WINDOW_SYSTEM
302 /* Counter for calls to clear_face_cache. If this counter reaches
303 CLEAR_FONT_TABLE_COUNT, and a frame has more than
304 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
306 static int clear_font_table_count
;
307 #define CLEAR_FONT_TABLE_COUNT 100
308 #define CLEAR_FONT_TABLE_NFONTS 10
310 #endif /* HAVE_WINDOW_SYSTEM */
312 /* True means face attributes have been changed since the last
313 redisplay. Used in redisplay_internal. */
317 /* True means don't display bold text if a face's foreground
318 and background colors are the inverse of the default colors of the
319 display. This is a kluge to suppress `bold black' foreground text
320 which is hard to read on an LCD monitor. */
322 static bool tty_suppress_bold_inverse_default_colors_p
;
324 /* A list of the form `((x . y))' used to avoid consing in
325 Finternal_set_lisp_face_attribute. */
327 static Lisp_Object Vparam_value_alist
;
329 /* The total number of colors currently allocated. */
332 static int ncolors_allocated
;
333 static int npixmaps_allocated
;
337 /* True means the definition of the `menu' face for new frames has
340 static bool menu_face_changed_default
;
342 struct named_merge_point
;
344 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
346 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
347 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
348 static bool realize_basic_faces (struct frame
*);
349 static bool realize_default_face (struct frame
*);
350 static void realize_named_face (struct frame
*, Lisp_Object
, int);
351 static struct face_cache
*make_face_cache (struct frame
*);
352 static void free_face_cache (struct face_cache
*);
353 static bool merge_face_ref (struct window
*w
,
354 struct frame
*, Lisp_Object
, Lisp_Object
*,
355 bool, struct named_merge_point
*);
356 static int color_distance (XColor
*x
, XColor
*y
);
358 #ifdef HAVE_WINDOW_SYSTEM
359 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
360 static void clear_face_gcs (struct face_cache
*);
361 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
363 #endif /* HAVE_WINDOW_SYSTEM */
365 /***********************************************************************
367 ***********************************************************************/
369 #ifdef HAVE_X_WINDOWS
371 #ifdef DEBUG_X_COLORS
373 /* The following is a poor mans infrastructure for debugging X color
374 allocation problems on displays with PseudoColor-8. Some X servers
375 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
376 color reference counts completely so that they don't signal an
377 error when a color is freed whose reference count is already 0.
378 Other X servers do. To help me debug this, the following code
379 implements a simple reference counting schema of its own, for a
380 single display/screen. --gerd. */
382 /* Reference counts for pixel colors. */
384 int color_count
[256];
386 /* Register color PIXEL as allocated. */
389 register_color (unsigned long pixel
)
391 eassert (pixel
< 256);
392 ++color_count
[pixel
];
396 /* Register color PIXEL as deallocated. */
399 unregister_color (unsigned long pixel
)
401 eassert (pixel
< 256);
402 if (color_count
[pixel
] > 0)
403 --color_count
[pixel
];
409 /* Register N colors from PIXELS as deallocated. */
412 unregister_colors (unsigned long *pixels
, int n
)
415 for (i
= 0; i
< n
; ++i
)
416 unregister_color (pixels
[i
]);
420 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
421 doc
: /* Dump currently allocated colors to stderr. */)
426 fputc ('\n', stderr
);
428 for (i
= n
= 0; i
< ARRAYELTS (color_count
); ++i
)
431 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
434 fputc ('\n', stderr
);
436 fputc ('\t', stderr
);
440 fputc ('\n', stderr
);
444 #endif /* DEBUG_X_COLORS */
447 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
448 color values. Interrupt input must be blocked when this function
452 x_free_colors (struct frame
*f
, unsigned long *pixels
, int npixels
)
454 /* If display has an immutable color map, freeing colors is not
455 necessary and some servers don't allow it. So don't do it. */
456 if (x_mutable_colormap (FRAME_X_VISUAL (f
)))
458 #ifdef DEBUG_X_COLORS
459 unregister_colors (pixels
, npixels
);
461 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
469 /* Free colors used on display DPY. PIXELS is an array of NPIXELS pixel
470 color values. Interrupt input must be blocked when this function
474 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
475 unsigned long *pixels
, int npixels
)
477 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
479 /* If display has an immutable color map, freeing colors is not
480 necessary and some servers don't allow it. So don't do it. */
481 if (x_mutable_colormap (dpyinfo
->visual
))
483 #ifdef DEBUG_X_COLORS
484 unregister_colors (pixels
, npixels
);
486 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
489 #endif /* USE_X_TOOLKIT */
491 /* Create and return a GC for use on frame F. GC values and mask
492 are given by XGCV and MASK. */
495 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
499 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_DRAWABLE (f
), mask
, xgcv
);
506 /* Free GC which was used on frame F. */
509 x_free_gc (struct frame
*f
, GC gc
)
511 eassert (input_blocked_p ());
512 IF_DEBUG ((--ngcs
, eassert (ngcs
>= 0)));
513 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
516 #endif /* HAVE_X_WINDOWS */
519 /* W32 emulation of GCs */
522 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
526 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
533 /* Free GC which was used on frame F. */
536 x_free_gc (struct frame
*f
, GC gc
)
538 IF_DEBUG ((--ngcs
, eassert (ngcs
>= 0)));
542 #endif /* HAVE_NTGUI */
545 /* NS emulation of GCs */
548 x_create_gc (struct frame
*f
,
552 GC gc
= xmalloc (sizeof *gc
);
558 x_free_gc (struct frame
*f
, GC gc
)
564 /***********************************************************************
566 ***********************************************************************/
568 /* Initialize face cache and basic faces for frame F. */
571 init_frame_faces (struct frame
*f
)
573 /* Make a face cache, if F doesn't have one. */
574 if (FRAME_FACE_CACHE (f
) == NULL
)
575 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
577 #ifdef HAVE_WINDOW_SYSTEM
578 /* Make the image cache. */
579 if (FRAME_WINDOW_P (f
))
581 /* We initialize the image cache when creating the first frame
582 on a terminal, and not during terminal creation. This way,
583 `x-open-connection' on a tty won't create an image cache. */
584 if (FRAME_IMAGE_CACHE (f
) == NULL
)
585 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
586 ++FRAME_IMAGE_CACHE (f
)->refcount
;
588 #endif /* HAVE_WINDOW_SYSTEM */
590 /* Realize faces early (Bug#17889). */
591 if (!realize_basic_faces (f
))
596 /* Free face cache of frame F. Called from frame-dependent
597 resource freeing function, e.g. (x|tty)_free_frame_resources. */
600 free_frame_faces (struct frame
*f
)
602 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
606 free_face_cache (face_cache
);
607 FRAME_FACE_CACHE (f
) = NULL
;
610 #ifdef HAVE_WINDOW_SYSTEM
611 if (FRAME_WINDOW_P (f
))
613 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
616 --image_cache
->refcount
;
617 if (image_cache
->refcount
== 0)
618 free_image_cache (f
);
621 #endif /* HAVE_WINDOW_SYSTEM */
625 /* Clear face caches, and recompute basic faces for frame F. Call
626 this after changing frame parameters on which those faces depend,
627 or when realized faces have been freed due to changing attributes
631 recompute_basic_faces (struct frame
*f
)
633 if (FRAME_FACE_CACHE (f
))
635 clear_face_cache (false);
636 if (!realize_basic_faces (f
))
642 /* Clear the face caches of all frames. CLEAR_FONTS_P means
643 try to free unused fonts, too. */
646 clear_face_cache (bool clear_fonts_p
)
648 #ifdef HAVE_WINDOW_SYSTEM
649 Lisp_Object tail
, frame
;
652 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
654 /* From time to time see if we can unload some fonts. This also
655 frees all realized faces on all frames. Fonts needed by
656 faces will be loaded again when faces are realized again. */
657 clear_font_table_count
= 0;
659 FOR_EACH_FRAME (tail
, frame
)
661 struct frame
*f
= XFRAME (frame
);
662 if (FRAME_WINDOW_P (f
)
663 && FRAME_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
665 clear_font_cache (f
);
666 free_all_realized_faces (frame
);
672 /* Clear GCs of realized faces. */
673 FOR_EACH_FRAME (tail
, frame
)
675 struct frame
*f
= XFRAME (frame
);
676 if (FRAME_WINDOW_P (f
))
677 clear_face_gcs (FRAME_FACE_CACHE (f
));
679 clear_image_caches (Qnil
);
681 #endif /* HAVE_WINDOW_SYSTEM */
684 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
685 doc
: /* Clear face caches on all frames.
686 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
687 (Lisp_Object thoroughly
)
689 clear_face_cache (!NILP (thoroughly
));
691 windows_or_buffers_changed
= 53;
696 /***********************************************************************
698 ***********************************************************************/
700 #ifdef HAVE_WINDOW_SYSTEM
702 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
703 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
704 A bitmap specification is either a string, a file name, or a list
705 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
706 HEIGHT is its height, and DATA is a string containing the bits of
707 the pixmap. Bits are stored row by row, each row occupies
708 \(WIDTH + 7)/8 bytes. */)
711 bool pixmap_p
= false;
713 if (STRINGP (object
))
714 /* If OBJECT is a string, it's a file name. */
716 else if (CONSP (object
))
718 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
719 HEIGHT must be ints > 0, and DATA must be string large
720 enough to hold a bitmap of the specified size. */
721 Lisp_Object width
, height
, data
;
723 height
= width
= data
= Qnil
;
727 width
= XCAR (object
);
728 object
= XCDR (object
);
731 height
= XCAR (object
);
732 object
= XCDR (object
);
734 data
= XCAR (object
);
739 && RANGED_INTEGERP (1, width
, INT_MAX
)
740 && RANGED_INTEGERP (1, height
, INT_MAX
))
742 int bytes_per_row
= (XINT (width
) + CHAR_BIT
- 1) / CHAR_BIT
;
743 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
748 return pixmap_p
? Qt
: Qnil
;
752 /* Load a bitmap according to NAME (which is either a file name or a
753 pixmap spec) for use on frame F. Value is the bitmap_id (see
754 xfns.c). If NAME is nil, return with a bitmap id of zero. If
755 bitmap cannot be loaded, display a message saying so, and return
759 load_pixmap (struct frame
*f
, Lisp_Object name
)
766 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
771 /* Decode a bitmap spec into a bitmap. */
776 w
= XINT (Fcar (name
));
777 h
= XINT (Fcar (Fcdr (name
)));
778 bits
= Fcar (Fcdr (Fcdr (name
)));
780 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
785 /* It must be a string -- a file name. */
786 bitmap_id
= x_create_bitmap_from_file (f
, name
);
792 add_to_log ("Invalid or undefined bitmap `%s'", name
);
798 ++npixmaps_allocated
;
805 #endif /* HAVE_WINDOW_SYSTEM */
809 /***********************************************************************
811 ***********************************************************************/
813 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
814 RGB_LIST should contain (at least) 3 lisp integers.
815 Return true iff RGB_LIST is OK. */
818 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
820 #define PARSE_RGB_LIST_FIELD(field) \
821 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
823 color->field = XINT (XCAR (rgb_list)); \
824 rgb_list = XCDR (rgb_list); \
829 PARSE_RGB_LIST_FIELD (red
);
830 PARSE_RGB_LIST_FIELD (green
);
831 PARSE_RGB_LIST_FIELD (blue
);
837 /* Lookup on frame F the color described by the lisp string COLOR.
838 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
839 non-zero, then the `standard' definition of the same color is
843 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
846 Lisp_Object frame
, color_desc
;
848 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
851 XSETFRAME (frame
, f
);
853 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
854 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
858 if (! INTEGERP (XCAR (XCDR (color_desc
))))
861 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
863 rgb
= XCDR (XCDR (color_desc
));
864 if (! parse_rgb_list (rgb
, tty_color
))
867 /* Should we fill in STD_COLOR too? */
870 /* Default STD_COLOR to the same as TTY_COLOR. */
871 *std_color
= *tty_color
;
873 /* Do a quick check to see if the returned descriptor is
874 actually _exactly_ equal to COLOR, otherwise we have to
875 lookup STD_COLOR separately. If it's impossible to lookup
876 a standard color, we just give up and use TTY_COLOR. */
877 if ((!STRINGP (XCAR (color_desc
))
878 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
879 && !NILP (Ffboundp (Qtty_color_standard_values
)))
881 /* Look up STD_COLOR separately. */
882 rgb
= call1 (Qtty_color_standard_values
, color
);
883 if (! parse_rgb_list (rgb
, std_color
))
890 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
891 /* We were called early during startup, and the colors are not
892 yet set up in tty-defined-color-alist. Don't return a failure
893 indication, since this produces the annoying "Unable to
894 load color" messages in the *Messages* buffer. */
897 /* tty-color-desc seems to have returned a bad value. */
901 /* A version of defined_color for non-X frames. */
904 tty_defined_color (struct frame
*f
, const char *color_name
,
905 XColor
*color_def
, bool alloc
)
910 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
913 color_def
->green
= 0;
916 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
918 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
920 if (strcmp (color_name
, "unspecified-fg") == 0)
921 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
922 else if (strcmp (color_name
, "unspecified-bg") == 0)
923 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
926 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
933 /* Decide if color named COLOR_NAME is valid for the display
934 associated with the frame F; if so, return the rgb values in
935 COLOR_DEF. If ALLOC, allocate a new colormap cell.
937 This does the right thing for any type of frame. */
940 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
943 if (!FRAME_WINDOW_P (f
))
944 return tty_defined_color (f
, color_name
, color_def
, alloc
);
945 #ifdef HAVE_X_WINDOWS
946 else if (FRAME_X_P (f
))
947 return x_defined_color (f
, color_name
, color_def
, alloc
);
950 else if (FRAME_W32_P (f
))
951 return w32_defined_color (f
, color_name
, color_def
, alloc
);
954 else if (FRAME_NS_P (f
))
955 return ns_defined_color (f
, color_name
, color_def
, alloc
, true);
962 /* Given the index IDX of a tty color on frame F, return its name, a
966 tty_color_name (struct frame
*f
, int idx
)
968 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
973 XSETFRAME (frame
, f
);
974 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
977 return XCAR (coldesc
);
980 /* We can have an MS-DOS frame under -nw for a short window of
981 opportunity before internal_terminal_init is called. DTRT. */
982 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
983 return msdos_stdcolor_name (idx
);
986 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
987 return build_string (unspecified_fg
);
988 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
989 return build_string (unspecified_bg
);
995 /* Return true if COLOR_NAME is a shade of gray (or white or
998 The criterion implemented here is not a terribly sophisticated one. */
1001 face_color_gray_p (struct frame
*f
, const char *color_name
)
1006 if (defined_color (f
, color_name
, &color
, false))
1007 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1008 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1010 ((eabs (color
.red
- color
.green
)
1011 < max (color
.red
, color
.green
) / 20)
1012 && (eabs (color
.green
- color
.blue
)
1013 < max (color
.green
, color
.blue
) / 20)
1014 && (eabs (color
.blue
- color
.red
)
1015 < max (color
.blue
, color
.red
) / 20)));
1023 /* Return true if color COLOR_NAME can be displayed on frame F.
1024 BACKGROUND_P means the color will be used as background color. */
1027 face_color_supported_p (struct frame
*f
, const char *color_name
,
1033 XSETFRAME (frame
, f
);
1035 #ifdef HAVE_WINDOW_SYSTEM
1037 ? (!NILP (Fxw_display_color_p (frame
))
1038 || xstrcasecmp (color_name
, "black") == 0
1039 || xstrcasecmp (color_name
, "white") == 0
1041 && face_color_gray_p (f
, color_name
))
1042 || (!NILP (Fx_display_grayscale_p (frame
))
1043 && face_color_gray_p (f
, color_name
)))
1046 tty_defined_color (f
, color_name
, ¬_used
, false);
1050 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1051 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1052 FRAME specifies the frame and thus the display for interpreting COLOR.
1053 If FRAME is nil or omitted, use the selected frame. */)
1054 (Lisp_Object color
, Lisp_Object frame
)
1056 CHECK_STRING (color
);
1057 return (face_color_gray_p (decode_any_frame (frame
), SSDATA (color
))
1062 DEFUN ("color-supported-p", Fcolor_supported_p
,
1063 Scolor_supported_p
, 1, 3, 0,
1064 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1065 BACKGROUND-P non-nil means COLOR is used as a background.
1066 Otherwise, this function tells whether it can be used as a foreground.
1067 If FRAME is nil or omitted, use the selected frame.
1068 COLOR must be a valid color name. */)
1069 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1071 CHECK_STRING (color
);
1072 return (face_color_supported_p (decode_any_frame (frame
),
1073 SSDATA (color
), !NILP (background_p
))
1078 static unsigned long
1079 load_color2 (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1080 enum lface_attribute_index target_index
, XColor
*color
)
1082 eassert (STRINGP (name
));
1083 eassert (target_index
== LFACE_FOREGROUND_INDEX
1084 || target_index
== LFACE_BACKGROUND_INDEX
1085 || target_index
== LFACE_UNDERLINE_INDEX
1086 || target_index
== LFACE_OVERLINE_INDEX
1087 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1088 || target_index
== LFACE_BOX_INDEX
);
1090 /* if the color map is full, defined_color will return a best match
1091 to the values in an existing cell. */
1092 if (!defined_color (f
, SSDATA (name
), color
, true))
1094 add_to_log ("Unable to load color \"%s\"", name
);
1096 switch (target_index
)
1098 case LFACE_FOREGROUND_INDEX
:
1099 face
->foreground_defaulted_p
= true;
1100 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1103 case LFACE_BACKGROUND_INDEX
:
1104 face
->background_defaulted_p
= true;
1105 color
->pixel
= FRAME_BACKGROUND_PIXEL (f
);
1108 case LFACE_UNDERLINE_INDEX
:
1109 face
->underline_defaulted_p
= true;
1110 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1113 case LFACE_OVERLINE_INDEX
:
1114 face
->overline_color_defaulted_p
= true;
1115 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1118 case LFACE_STRIKE_THROUGH_INDEX
:
1119 face
->strike_through_color_defaulted_p
= true;
1120 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1123 case LFACE_BOX_INDEX
:
1124 face
->box_color_defaulted_p
= true;
1125 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1134 ++ncolors_allocated
;
1137 return color
->pixel
;
1140 /* Load color with name NAME for use by face FACE on frame F.
1141 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1142 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1143 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1144 pixel color. If color cannot be loaded, display a message, and
1145 return the foreground, background or underline color of F, but
1146 record that fact in flags of the face so that we don't try to free
1150 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1151 enum lface_attribute_index target_index
)
1154 return load_color2 (f
, face
, name
, target_index
, &color
);
1158 #ifdef HAVE_WINDOW_SYSTEM
1160 #define NEAR_SAME_COLOR_THRESHOLD 30000
1162 /* Load colors for face FACE which is used on frame F. Colors are
1163 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1164 of ATTRS. If the background color specified is not supported on F,
1165 try to emulate gray colors with a stipple from Vface_default_stipple. */
1168 load_face_colors (struct frame
*f
, struct face
*face
,
1169 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1171 Lisp_Object fg
, bg
, dfg
;
1174 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1175 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1177 /* Swap colors if face is inverse-video. */
1178 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1186 /* Check for support for foreground, not for background because
1187 face_color_supported_p is smart enough to know that grays are
1188 "supported" as background because we are supposed to use stipple
1190 if (!face_color_supported_p (f
, SSDATA (bg
), false)
1191 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1193 x_destroy_bitmap (f
, face
->stipple
);
1194 face
->stipple
= load_pixmap (f
, Vface_default_stipple
);
1197 face
->background
= load_color2 (f
, face
, bg
, LFACE_BACKGROUND_INDEX
, &xbg
);
1198 face
->foreground
= load_color2 (f
, face
, fg
, LFACE_FOREGROUND_INDEX
, &xfg
);
1200 dfg
= attrs
[LFACE_DISTANT_FOREGROUND_INDEX
];
1201 if (!NILP (dfg
) && !UNSPECIFIEDP (dfg
)
1202 && color_distance (&xbg
, &xfg
) < NEAR_SAME_COLOR_THRESHOLD
)
1204 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1205 face
->background
= load_color (f
, face
, dfg
, LFACE_BACKGROUND_INDEX
);
1207 face
->foreground
= load_color (f
, face
, dfg
, LFACE_FOREGROUND_INDEX
);
1211 #ifdef HAVE_X_WINDOWS
1213 /* Free color PIXEL on frame F. */
1216 unload_color (struct frame
*f
, unsigned long pixel
)
1221 x_free_colors (f
, &pixel
, 1);
1226 /* Free colors allocated for FACE. */
1229 free_face_colors (struct frame
*f
, struct face
*face
)
1231 /* PENDING(NS): need to do something here? */
1233 if (face
->colors_copied_bitwise_p
)
1238 if (!face
->foreground_defaulted_p
)
1240 x_free_colors (f
, &face
->foreground
, 1);
1241 IF_DEBUG (--ncolors_allocated
);
1244 if (!face
->background_defaulted_p
)
1246 x_free_colors (f
, &face
->background
, 1);
1247 IF_DEBUG (--ncolors_allocated
);
1250 if (face
->underline_p
1251 && !face
->underline_defaulted_p
)
1253 x_free_colors (f
, &face
->underline_color
, 1);
1254 IF_DEBUG (--ncolors_allocated
);
1257 if (face
->overline_p
1258 && !face
->overline_color_defaulted_p
)
1260 x_free_colors (f
, &face
->overline_color
, 1);
1261 IF_DEBUG (--ncolors_allocated
);
1264 if (face
->strike_through_p
1265 && !face
->strike_through_color_defaulted_p
)
1267 x_free_colors (f
, &face
->strike_through_color
, 1);
1268 IF_DEBUG (--ncolors_allocated
);
1271 if (face
->box
!= FACE_NO_BOX
1272 && !face
->box_color_defaulted_p
)
1274 x_free_colors (f
, &face
->box_color
, 1);
1275 IF_DEBUG (--ncolors_allocated
);
1281 #endif /* HAVE_X_WINDOWS */
1283 #endif /* HAVE_WINDOW_SYSTEM */
1287 /***********************************************************************
1289 ***********************************************************************/
1291 /* An enumerator for each field of an XLFD font name. */
1312 /* An enumerator for each possible slant value of a font. Taken from
1313 the XLFD specification. */
1321 XLFD_SLANT_REVERSE_ITALIC
,
1322 XLFD_SLANT_REVERSE_OBLIQUE
,
1326 /* Relative font weight according to XLFD documentation. */
1330 XLFD_WEIGHT_UNKNOWN
,
1331 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1332 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1333 XLFD_WEIGHT_LIGHT
, /* 30 */
1334 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1335 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1336 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1337 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1338 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1339 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1342 /* Relative proportionate width. */
1346 XLFD_SWIDTH_UNKNOWN
,
1347 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1348 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1349 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1350 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1351 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1352 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1353 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1354 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1355 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1358 /* Order by which font selection chooses fonts. The default values
1359 mean `first, find a best match for the font width, then for the
1360 font height, then for weight, then for slant.' This variable can be
1361 set via set-face-font-sort-order. */
1363 static int font_sort_order
[4];
1365 #ifdef HAVE_WINDOW_SYSTEM
1367 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1370 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1372 Lisp_Object
const *p1
= v1
;
1373 Lisp_Object
const *p2
= v2
;
1374 Lisp_Object font1
= *p1
;
1375 Lisp_Object font2
= *p2
;
1378 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1380 enum font_property_index idx
= font_props_for_sorting
[i
];
1381 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1384 if (idx
<= FONT_REGISTRY_INDEX
)
1387 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1389 result
= STRINGP (val2
) ? 1 : 0;
1393 if (INTEGERP (val1
))
1394 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1395 ? XINT (val1
) > XINT (val2
)
1398 result
= INTEGERP (val2
) ? 1 : 0;
1406 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1407 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1408 If FAMILY is omitted or nil, list all families.
1409 Otherwise, FAMILY must be a string, possibly containing wildcards
1411 If FRAME is omitted or nil, use the selected frame.
1412 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1413 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1414 FAMILY is the font family name. POINT-SIZE is the size of the
1415 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1416 width, weight and slant of the font. These symbols are the same as for
1417 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1418 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1419 giving the registry and encoding of the font.
1420 The result list is sorted according to the current setting of
1421 the face font sort order. */)
1422 (Lisp_Object family
, Lisp_Object frame
)
1424 Lisp_Object font_spec
, list
, *drivers
, vec
;
1425 struct frame
*f
= decode_live_frame (frame
);
1426 ptrdiff_t i
, nfonts
;
1431 font_spec
= Ffont_spec (0, NULL
);
1434 CHECK_STRING (family
);
1435 font_parse_family_registry (family
, Qnil
, font_spec
);
1438 list
= font_list_entities (f
, font_spec
);
1442 /* Sort the font entities. */
1443 for (i
= 0; i
< 4; i
++)
1444 switch (font_sort_order
[i
])
1447 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1448 case XLFD_POINT_SIZE
:
1449 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1451 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1453 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1455 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1456 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1457 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1458 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1460 ndrivers
= XINT (Flength (list
));
1461 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1462 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1463 drivers
[i
] = XCAR (list
);
1464 vec
= Fvconcat (ndrivers
, drivers
);
1465 nfonts
= ASIZE (vec
);
1467 qsort (XVECTOR (vec
)->contents
, nfonts
, word_size
,
1468 compare_fonts_by_sort_order
);
1471 for (i
= nfonts
- 1; i
>= 0; --i
)
1473 Lisp_Object font
= AREF (vec
, i
);
1474 Lisp_Object v
= make_uninit_vector (8);
1476 Lisp_Object spacing
;
1478 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1479 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1480 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1482 ASET (v
, 2, make_number (point
));
1483 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1484 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1485 spacing
= Ffont_get (font
, QCspacing
);
1486 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1487 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1488 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1490 result
= Fcons (v
, result
);
1497 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1498 doc
: /* Return a list of the names of available fonts matching PATTERN.
1499 If optional arguments FACE and FRAME are specified, return only fonts
1500 the same size as FACE on FRAME.
1502 PATTERN should be a string containing a font name in the XLFD,
1503 Fontconfig, or GTK format. A font name given in the XLFD format may
1504 contain wildcard characters:
1505 the * character matches any substring, and
1506 the ? character matches any single character.
1507 PATTERN is case-insensitive.
1509 The return value is a list of strings, suitable as arguments to
1512 Fonts Emacs can't use may or may not be excluded
1513 even if they match PATTERN and FACE.
1514 The optional fourth argument MAXIMUM sets a limit on how many
1515 fonts to match. The first MAXIMUM fonts are reported.
1516 The optional fifth argument WIDTH, if specified, is a number of columns
1517 occupied by a character of a font. In that case, return only fonts
1518 the WIDTH times as wide as FACE on FRAME. */)
1519 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1520 Lisp_Object maximum
, Lisp_Object width
)
1525 check_window_system (NULL
);
1526 CHECK_STRING (pattern
);
1528 if (! NILP (maximum
))
1529 CHECK_NATNUM (maximum
);
1532 CHECK_NUMBER (width
);
1534 /* We can't simply call decode_window_system_frame because
1535 this function may be called before any frame is created. */
1536 f
= decode_live_frame (frame
);
1537 if (! FRAME_WINDOW_P (f
))
1539 /* Perhaps we have not yet created any frame. */
1545 XSETFRAME (frame
, f
);
1547 /* Determine the width standard for comparison with the fonts we find. */
1553 /* This is of limited utility since it works with character
1554 widths. Keep it for compatibility. --gerd. */
1555 int face_id
= lookup_named_face (NULL
, f
, face
, false);
1556 struct face
*width_face
= FACE_FROM_ID_OR_NULL (f
, face_id
);
1558 if (width_face
&& width_face
->font
)
1560 size
= width_face
->font
->pixel_size
;
1561 avgwidth
= width_face
->font
->average_width
;
1565 size
= FRAME_FONT (f
)->pixel_size
;
1566 avgwidth
= FRAME_FONT (f
)->average_width
;
1569 avgwidth
*= XINT (width
);
1572 Lisp_Object font_spec
= font_spec_from_name (pattern
);
1573 if (!FONTP (font_spec
))
1574 signal_error ("Invalid font name", pattern
);
1578 Ffont_put (font_spec
, QCsize
, make_number (size
));
1579 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1581 Lisp_Object fonts
= Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1582 for (Lisp_Object tail
= fonts
; CONSP (tail
); tail
= XCDR (tail
))
1584 Lisp_Object font_entity
;
1586 font_entity
= XCAR (tail
);
1587 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1588 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1589 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1591 /* This is a scalable font. For backward compatibility,
1592 we set the specified size. */
1593 font_entity
= copy_font_spec (font_entity
);
1594 ASET (font_entity
, FONT_SIZE_INDEX
,
1595 AREF (font_spec
, FONT_SIZE_INDEX
));
1597 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1600 /* We don't have to check fontsets. */
1602 Lisp_Object fontsets
= list_fontsets (f
, pattern
, size
);
1603 return CALLN (Fnconc
, fonts
, fontsets
);
1606 #endif /* HAVE_WINDOW_SYSTEM */
1609 /***********************************************************************
1611 ***********************************************************************/
1613 /* Access face attributes of face LFACE, a Lisp vector. */
1615 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1616 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1617 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1618 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1619 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1620 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1621 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1622 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1623 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1624 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1625 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1626 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1627 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1628 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1629 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1630 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1631 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1632 #define LFACE_DISTANT_FOREGROUND(LFACE) \
1633 AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX)
1635 /* True if LFACE is a Lisp face. A Lisp face is a vector of size
1636 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1638 #define LFACEP(LFACE) \
1640 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1641 && EQ (AREF (LFACE, 0), Qface))
1646 /* Check consistency of Lisp face attribute vector ATTRS. */
1649 check_lface_attrs (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1651 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1652 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1653 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1654 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1655 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1656 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1657 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1658 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1659 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1660 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1661 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1662 || NUMBERP (attrs
[LFACE_HEIGHT_INDEX
])
1663 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1664 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1665 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1666 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1667 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1668 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1669 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1670 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1671 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1672 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1673 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1674 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1675 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1676 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1677 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1678 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1679 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1680 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1681 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1682 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1683 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1684 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1685 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1686 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1687 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1688 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1689 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1690 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1691 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1692 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1693 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1694 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1695 eassert (UNSPECIFIEDP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
1696 || IGNORE_DEFFACE_P (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
1697 || STRINGP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
]));
1698 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1699 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1700 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1701 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1702 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1703 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1704 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1705 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1706 #ifdef HAVE_WINDOW_SYSTEM
1707 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1708 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1709 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1710 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1711 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1712 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1713 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1714 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1715 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1716 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1721 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1724 check_lface (Lisp_Object lface
)
1728 eassert (LFACEP (lface
));
1729 check_lface_attrs (XVECTOR (lface
)->contents
);
1733 #else /* not GLYPH_DEBUG */
1735 #define check_lface_attrs(attrs) (void) 0
1736 #define check_lface(lface) (void) 0
1738 #endif /* GLYPH_DEBUG */
1742 /* Face-merge cycle checking. */
1744 enum named_merge_point_kind
1746 NAMED_MERGE_POINT_NORMAL
,
1747 NAMED_MERGE_POINT_REMAP
1750 /* A `named merge point' is simply a point during face-merging where we
1751 look up a face by name. We keep a stack of which named lookups we're
1752 currently processing so that we can easily detect cycles, using a
1753 linked- list of struct named_merge_point structures, typically
1754 allocated on the stack frame of the named lookup functions which are
1755 active (so no consing is required). */
1756 struct named_merge_point
1758 Lisp_Object face_name
;
1759 enum named_merge_point_kind named_merge_point_kind
;
1760 struct named_merge_point
*prev
;
1764 /* If a face merging cycle is detected for FACE_NAME, return false,
1765 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1766 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1767 pointed to by NAMED_MERGE_POINTS, and return true. */
1770 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1771 Lisp_Object face_name
,
1772 enum named_merge_point_kind named_merge_point_kind
,
1773 struct named_merge_point
**named_merge_points
)
1775 struct named_merge_point
*prev
;
1777 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1778 if (EQ (face_name
, prev
->face_name
))
1780 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1781 /* A cycle, so fail. */
1783 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1784 /* A remap `hides ' any previous normal merge points
1785 (because the remap means that it's actually different face),
1786 so as we know the current merge point must be normal, we
1787 can just assume it's OK. */
1791 new_named_merge_point
->face_name
= face_name
;
1792 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1793 new_named_merge_point
->prev
= *named_merge_points
;
1795 *named_merge_points
= new_named_merge_point
;
1801 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1802 to make it a symbol. If FACE_NAME is an alias for another face,
1803 return that face's name.
1805 Return default face in case of errors. */
1808 resolve_face_name (Lisp_Object face_name
, bool signal_p
)
1810 Lisp_Object orig_face
;
1811 Lisp_Object tortoise
, hare
;
1813 if (STRINGP (face_name
))
1814 face_name
= Fintern (face_name
, Qnil
);
1816 if (NILP (face_name
) || !SYMBOLP (face_name
))
1819 orig_face
= face_name
;
1820 tortoise
= hare
= face_name
;
1825 hare
= Fget (hare
, Qface_alias
);
1826 if (NILP (hare
) || !SYMBOLP (hare
))
1830 hare
= Fget (hare
, Qface_alias
);
1831 if (NILP (hare
) || !SYMBOLP (hare
))
1834 tortoise
= Fget (tortoise
, Qface_alias
);
1835 if (EQ (hare
, tortoise
))
1838 xsignal1 (Qcircular_list
, orig_face
);
1847 /* Return the face definition of FACE_NAME on frame F. F null means
1848 return the definition for new frames. FACE_NAME may be a string or
1849 a symbol (apparently Emacs 20.2 allowed strings as face names in
1850 face text properties; Ediff uses that).
1851 If SIGNAL_P, signal an error if FACE_NAME is not a valid face name.
1852 Otherwise, value is nil if FACE_NAME is not a valid face name. */
1854 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
1860 lface
= assq_no_quit (face_name
, f
->face_alist
);
1862 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
1865 lface
= XCDR (lface
);
1867 signal_error ("Invalid face", face_name
);
1869 check_lface (lface
);
1874 /* Return the face definition of FACE_NAME on frame F. F null means
1875 return the definition for new frames. FACE_NAME may be a string or
1876 a symbol (apparently Emacs 20.2 allowed strings as face names in
1877 face text properties; Ediff uses that). If FACE_NAME is an alias
1878 for another face, return that face's definition.
1879 If SIGNAL_P, signal an error if FACE_NAME is not a valid face name.
1880 Otherwise, value is nil if FACE_NAME is not a valid face name. */
1882 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, bool signal_p
)
1884 face_name
= resolve_face_name (face_name
, signal_p
);
1885 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
1889 /* Get face attributes of face FACE_NAME from frame-local faces on
1890 frame F. Store the resulting attributes in ATTRS which must point
1891 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE.
1892 If SIGNAL_P, signal an error if FACE_NAME does not name a face.
1893 Otherwise, return true iff FACE_NAME is a face. */
1896 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
1897 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
1902 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
1905 memcpy (attrs
, XVECTOR (lface
)->contents
,
1906 LFACE_VECTOR_SIZE
* sizeof *attrs
);
1908 return !NILP (lface
);
1911 /* Get face attributes of face FACE_NAME from frame-local faces on
1912 frame F. Store the resulting attributes in ATTRS which must point
1913 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE.
1914 If FACE_NAME is an alias for another face, use that face's
1915 definition. If SIGNAL_P, signal an error if FACE_NAME does not
1916 name a face. Otherwise, return true iff FACE_NAME is a face. If W
1917 is non-NULL, also consider remappings attached to the window.
1920 get_lface_attributes (struct window
*w
,
1921 struct frame
*f
, Lisp_Object face_name
,
1922 Lisp_Object attrs
[LFACE_VECTOR_SIZE
], bool signal_p
,
1923 struct named_merge_point
*named_merge_points
)
1925 Lisp_Object face_remapping
;
1926 eassert (w
== NULL
|| WINDOW_XFRAME (w
) == f
);
1928 face_name
= resolve_face_name (face_name
, signal_p
);
1930 /* See if SYMBOL has been remapped to some other face (usually this
1931 is done buffer-locally). */
1932 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
1933 if (CONSP (face_remapping
))
1935 struct named_merge_point named_merge_point
;
1937 if (push_named_merge_point (&named_merge_point
,
1938 face_name
, NAMED_MERGE_POINT_REMAP
,
1939 &named_merge_points
))
1943 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
1944 attrs
[i
] = Qunspecified
;
1946 return merge_face_ref (w
, f
, XCDR (face_remapping
), attrs
,
1947 signal_p
, named_merge_points
);
1951 /* Default case, no remapping. */
1952 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
1956 /* True iff all attributes in face attribute vector ATTRS are
1957 specified, i.e. are non-nil. */
1960 lface_fully_specified_p (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1964 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
1965 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
1966 && i
!= LFACE_DISTANT_FOREGROUND_INDEX
)
1967 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
1970 return i
== LFACE_VECTOR_SIZE
;
1973 #ifdef HAVE_WINDOW_SYSTEM
1975 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
1976 If FORCE_P, set only unspecified attributes of LFACE. The
1977 exception is `font' attribute. It is set to FONT_OBJECT regardless
1981 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
1982 Lisp_Object font_object
, bool force_p
)
1985 struct font
*font
= XFONT_OBJECT (font_object
);
1987 /* Set attributes only if unspecified, otherwise face defaults for
1988 new frames would never take effect. If the font doesn't have a
1989 specific property, set a normal value for that. */
1991 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
1993 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
1995 ASET (lface
, LFACE_FAMILY_INDEX
, SYMBOL_NAME (family
));
1998 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2000 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2002 ASET (lface
, LFACE_FOUNDRY_INDEX
, SYMBOL_NAME (foundry
));
2005 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2007 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, FRAME_RES_Y (f
));
2010 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (pt
));
2013 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2015 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2016 ASET (lface
, LFACE_WEIGHT_INDEX
, ! NILP (val
) ? val
:Qnormal
);
2018 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2020 val
= FONT_SLANT_FOR_FACE (font_object
);
2021 ASET (lface
, LFACE_SLANT_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2023 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2025 val
= FONT_WIDTH_FOR_FACE (font_object
);
2026 ASET (lface
, LFACE_SWIDTH_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2029 ASET (lface
, LFACE_FONT_INDEX
, font_object
);
2032 #endif /* HAVE_WINDOW_SYSTEM */
2035 /* Merges the face height FROM with the face height TO, and returns the
2036 merged height. If FROM is an invalid height, then INVALID is
2037 returned instead. FROM and TO may be either absolute face heights or
2038 `relative' heights; the returned value is always an absolute height
2039 unless both FROM and TO are relative. */
2042 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2044 Lisp_Object result
= invalid
;
2046 if (INTEGERP (from
))
2047 /* FROM is absolute, just use it as is. */
2049 else if (FLOATP (from
))
2050 /* FROM is a scale, use it to adjust TO. */
2053 /* relative X absolute => absolute */
2054 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2055 else if (FLOATP (to
))
2056 /* relative X relative => relative */
2057 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2058 else if (UNSPECIFIEDP (to
))
2061 else if (FUNCTIONP (from
))
2062 /* FROM is a function, which use to adjust TO. */
2064 /* Call function with current height as argument.
2065 From is the new height. */
2066 result
= safe_call1 (from
, to
);
2068 /* Ensure that if TO was absolute, so is the result. */
2069 if (INTEGERP (to
) && !INTEGERP (result
))
2077 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2078 store the resulting attributes in TO, which must be already be
2079 completely specified and contain only absolute attributes.
2080 Every specified attribute of FROM overrides the corresponding
2081 attribute of TO; relative attributes in FROM are merged with the
2082 absolute value in TO and replace it. NAMED_MERGE_POINTS is used
2083 internally to detect loops in face inheritance/remapping; it should
2084 be 0 when called from other places. If window W is non-NULL, use W
2085 to interpret face specifications. */
2087 merge_face_vectors (struct window
*w
,
2088 struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2089 struct named_merge_point
*named_merge_points
)
2092 Lisp_Object font
= Qnil
;
2094 /* If FROM inherits from some other faces, merge their attributes into
2095 TO before merging FROM's direct attributes. Note that an :inherit
2096 attribute of `unspecified' is the same as one of nil; we never
2097 merge :inherit attributes, so nil is more correct, but lots of
2098 other code uses `unspecified' as a generic value for face attributes. */
2099 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2100 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2101 merge_face_ref (w
, f
, from
[LFACE_INHERIT_INDEX
],
2102 to
, false, named_merge_points
);
2104 if (FONT_SPEC_P (from
[LFACE_FONT_INDEX
]))
2106 if (!UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2107 font
= merge_font_spec (from
[LFACE_FONT_INDEX
], to
[LFACE_FONT_INDEX
]);
2109 font
= copy_font_spec (from
[LFACE_FONT_INDEX
]);
2110 to
[LFACE_FONT_INDEX
] = font
;
2113 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2114 if (!UNSPECIFIEDP (from
[i
]))
2116 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2118 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2119 font_clear_prop (to
, FONT_SIZE_INDEX
);
2121 else if (i
!= LFACE_FONT_INDEX
&& ! EQ (to
[i
], from
[i
]))
2124 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2125 font_clear_prop (to
,
2126 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2127 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2128 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2129 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2130 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2131 : FONT_SLANT_INDEX
));
2135 /* If FROM specifies a font spec, make its contents take precedence
2136 over :family and other attributes. This is needed for face
2137 remapping using :font to work. */
2141 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
2142 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
));
2143 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
2144 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
));
2145 if (! NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
2146 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (font
);
2147 if (! NILP (AREF (font
, FONT_SLANT_INDEX
)))
2148 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (font
);
2149 if (! NILP (AREF (font
, FONT_WIDTH_INDEX
)))
2150 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (font
);
2151 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2154 /* TO is always an absolute face, which should inherit from nothing.
2155 We blindly copy the :inherit attribute above and fix it up here. */
2156 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2159 /* Merge the named face FACE_NAME on frame F, into the vector of face
2160 attributes TO. Use NAMED_MERGE_POINTS to detect loops in face
2161 inheritance. Return true if FACE_NAME is a valid face name and
2162 merging succeeded. Window W, if non-NULL, is used to filter face
2166 merge_named_face (struct window
*w
,
2167 struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2168 struct named_merge_point
*named_merge_points
)
2170 struct named_merge_point named_merge_point
;
2172 if (push_named_merge_point (&named_merge_point
,
2173 face_name
, NAMED_MERGE_POINT_NORMAL
,
2174 &named_merge_points
))
2176 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2177 bool ok
= get_lface_attributes (w
, f
, face_name
, from
, false,
2178 named_merge_points
);
2181 merge_face_vectors (w
, f
, from
, to
, named_merge_points
);
2189 /* Determine whether the face filter FILTER evaluated in window W
2190 matches. W can be NULL if the window context is unknown.
2192 A face filter is either nil, which always matches, or a list
2193 (:window PARAMETER VALUE), which matches if the current window has
2194 a PARAMETER EQ to VALUE.
2196 This function returns true if the face filter matches, and false if
2197 it doesn't or if the function encountered an error. If the filter
2198 is invalid, set *OK to false and, if ERR_MSGS is true, log an error
2199 message. On success, *OK is untouched. */
2201 evaluate_face_filter (Lisp_Object filter
, struct window
*w
,
2202 bool *ok
, bool err_msgs
)
2204 Lisp_Object orig_filter
= filter
;
2206 /* Inner braces keep compiler happy about the goto skipping variable
2212 if (face_filters_always_match
)
2215 if (!CONSP (filter
))
2218 if (!EQ (XCAR (filter
), QCwindow
))
2220 filter
= XCDR (filter
);
2222 Lisp_Object parameter
= XCAR (filter
);
2223 filter
= XCDR (filter
);
2224 if (!CONSP (filter
))
2227 Lisp_Object value
= XCAR (filter
);
2228 filter
= XCDR (filter
);
2235 Lisp_Object found
= assq_no_quit (parameter
, w
->window_parameters
);
2236 if (!NILP (found
) && EQ (XCDR (found
), value
))
2245 add_to_log ("Invalid face filter %S", orig_filter
);
2250 /* Determine whether FACE_REF is a "filter" face specification (case
2251 #4 in merge_face_ref). If it is, evaluate the filter, and if the
2252 filter matches, return the filtered face spec. If the filter does
2253 not match, return `nil'. If FACE_REF is not a filtered face
2254 specification, return FACE_REF.
2256 On error, set *OK to false, having logged an error message if
2257 ERR_MSGS is true, and return `nil'. Otherwise, *OK is not touched.
2259 W is either NULL or a window used to evaluate filters. If W is
2260 NULL, no window-based face specification filter matches.
2263 filter_face_ref (Lisp_Object face_ref
,
2268 Lisp_Object orig_face_ref
= face_ref
;
2269 if (!CONSP (face_ref
))
2272 /* Inner braces keep compiler happy about the goto skipping variable
2275 if (!EQ (XCAR (face_ref
), QCfiltered
))
2277 face_ref
= XCDR (face_ref
);
2279 if (!CONSP (face_ref
))
2281 Lisp_Object filter
= XCAR (face_ref
);
2282 face_ref
= XCDR (face_ref
);
2284 if (!CONSP (face_ref
))
2286 Lisp_Object filtered_face_ref
= XCAR (face_ref
);
2287 face_ref
= XCDR (face_ref
);
2289 if (!NILP (face_ref
))
2292 return evaluate_face_filter (filter
, w
, ok
, err_msgs
)
2293 ? filtered_face_ref
: Qnil
;
2298 add_to_log ("Invalid face ref %S", orig_face_ref
);
2303 /* Merge face attributes from the lisp `face reference' FACE_REF on
2304 frame F into the face attribute vector TO. If ERR_MSGS,
2305 problems with FACE_REF cause an error message to be shown. Return
2306 true if no errors occurred (regardless of the value of ERR_MSGS).
2307 Use NAMED_MERGE_POINTS to detect loops in face inheritance or
2308 list structure; it may be 0 for most callers.
2310 FACE_REF may be a single face specification or a list of such
2311 specifications. Each face specification can be:
2313 1. A symbol or string naming a Lisp face.
2315 2. A property list of the form (KEYWORD VALUE ...) where each
2316 KEYWORD is a face attribute name, and value is an appropriate value
2319 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2320 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2321 for compatibility with 20.2.
2323 4. Conses of the form
2324 (:filtered (:window PARAMETER VALUE) FACE-SPECIFICATION),
2325 which applies FACE-SPECIFICATION only if the
2326 given face attributes are being evaluated in the context of a
2327 window with a parameter named PARAMETER being EQ VALUE.
2329 5. nil, which means to merge nothing.
2331 Face specifications earlier in lists take precedence over later
2335 merge_face_ref (struct window
*w
,
2336 struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2337 bool err_msgs
, struct named_merge_point
*named_merge_points
)
2339 bool ok
= true; /* Succeed without an error? */
2340 Lisp_Object filtered_face_ref
;
2342 filtered_face_ref
= face_ref
;
2345 face_ref
= filtered_face_ref
;
2346 filtered_face_ref
= filter_face_ref (face_ref
, w
, &ok
, err_msgs
);
2348 while (ok
&& !EQ (face_ref
, filtered_face_ref
));
2353 if (NILP (face_ref
))
2356 if (CONSP (face_ref
))
2358 Lisp_Object first
= XCAR (face_ref
);
2360 if (EQ (first
, Qforeground_color
)
2361 || EQ (first
, Qbackground_color
))
2363 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2364 . COLOR). COLOR must be a string. */
2365 Lisp_Object color_name
= XCDR (face_ref
);
2366 Lisp_Object color
= first
;
2368 if (STRINGP (color_name
))
2370 if (EQ (color
, Qforeground_color
))
2371 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2373 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2378 add_to_log ("Invalid face color %S", color_name
);
2382 else if (SYMBOLP (first
)
2383 && *SDATA (SYMBOL_NAME (first
)) == ':')
2385 /* Assume this is the property list form. */
2386 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2388 Lisp_Object keyword
= XCAR (face_ref
);
2389 Lisp_Object value
= XCAR (XCDR (face_ref
));
2392 /* Specifying `unspecified' is a no-op. */
2393 if (EQ (value
, Qunspecified
))
2395 else if (EQ (keyword
, QCfamily
))
2397 if (STRINGP (value
))
2399 to
[LFACE_FAMILY_INDEX
] = value
;
2400 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2405 else if (EQ (keyword
, QCfoundry
))
2407 if (STRINGP (value
))
2409 to
[LFACE_FOUNDRY_INDEX
] = value
;
2410 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2415 else if (EQ (keyword
, QCheight
))
2417 Lisp_Object new_height
=
2418 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2420 if (! NILP (new_height
))
2422 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2423 font_clear_prop (to
, FONT_SIZE_INDEX
);
2428 else if (EQ (keyword
, QCweight
))
2430 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2432 to
[LFACE_WEIGHT_INDEX
] = value
;
2433 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2438 else if (EQ (keyword
, QCslant
))
2440 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2442 to
[LFACE_SLANT_INDEX
] = value
;
2443 font_clear_prop (to
, FONT_SLANT_INDEX
);
2448 else if (EQ (keyword
, QCunderline
))
2454 to
[LFACE_UNDERLINE_INDEX
] = value
;
2458 else if (EQ (keyword
, QCoverline
))
2463 to
[LFACE_OVERLINE_INDEX
] = value
;
2467 else if (EQ (keyword
, QCstrike_through
))
2472 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2476 else if (EQ (keyword
, QCbox
))
2479 value
= make_number (1);
2480 if (INTEGERP (value
)
2484 to
[LFACE_BOX_INDEX
] = value
;
2488 else if (EQ (keyword
, QCinverse_video
)
2489 || EQ (keyword
, QCreverse_video
))
2491 if (EQ (value
, Qt
) || NILP (value
))
2492 to
[LFACE_INVERSE_INDEX
] = value
;
2496 else if (EQ (keyword
, QCforeground
))
2498 if (STRINGP (value
))
2499 to
[LFACE_FOREGROUND_INDEX
] = value
;
2503 else if (EQ (keyword
, QCdistant_foreground
))
2505 if (STRINGP (value
))
2506 to
[LFACE_DISTANT_FOREGROUND_INDEX
] = value
;
2510 else if (EQ (keyword
, QCbackground
))
2512 if (STRINGP (value
))
2513 to
[LFACE_BACKGROUND_INDEX
] = value
;
2517 else if (EQ (keyword
, QCstipple
))
2519 #if defined (HAVE_WINDOW_SYSTEM)
2520 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2521 if (!NILP (pixmap_p
))
2522 to
[LFACE_STIPPLE_INDEX
] = value
;
2525 #endif /* HAVE_WINDOW_SYSTEM */
2527 else if (EQ (keyword
, QCwidth
))
2529 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2531 to
[LFACE_SWIDTH_INDEX
] = value
;
2532 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2537 else if (EQ (keyword
, QCfont
))
2540 to
[LFACE_FONT_INDEX
] = value
;
2544 else if (EQ (keyword
, QCinherit
))
2546 /* This is not really very useful; it's just like a
2547 normal face reference. */
2548 if (! merge_face_ref (w
, f
, value
, to
,
2549 err_msgs
, named_merge_points
))
2557 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2561 face_ref
= XCDR (XCDR (face_ref
));
2566 /* This is a list of face refs. Those at the beginning of the
2567 list take precedence over what follows, so we have to merge
2568 from the end backwards. */
2569 Lisp_Object next
= XCDR (face_ref
);
2572 ok
= merge_face_ref (w
, f
, next
, to
, err_msgs
, named_merge_points
);
2574 if (! merge_face_ref (w
, f
, first
, to
, err_msgs
, named_merge_points
))
2580 /* FACE_REF ought to be a face name. */
2581 ok
= merge_named_face (w
, f
, face_ref
, to
, named_merge_points
);
2582 if (!ok
&& err_msgs
)
2583 add_to_log ("Invalid face reference: %s", face_ref
);
2590 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2591 Sinternal_make_lisp_face
, 1, 2, 0,
2592 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2593 If FACE was not known as a face before, create a new one.
2594 If optional argument FRAME is specified, make a frame-local face
2595 for that frame. Otherwise operate on the global face definition.
2596 Value is a vector of face attributes. */)
2597 (Lisp_Object face
, Lisp_Object frame
)
2599 Lisp_Object global_lface
, lface
;
2603 CHECK_SYMBOL (face
);
2604 global_lface
= lface_from_face_name (NULL
, face
, false);
2608 CHECK_LIVE_FRAME (frame
);
2610 lface
= lface_from_face_name (f
, face
, false);
2613 f
= NULL
, lface
= Qnil
;
2615 /* Add a global definition if there is none. */
2616 if (NILP (global_lface
))
2618 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2620 ASET (global_lface
, 0, Qface
);
2621 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2622 Vface_new_frame_defaults
);
2624 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2625 face id to Lisp face is given by the vector lface_id_to_name.
2626 The mapping from Lisp face to Lisp face id is given by the
2627 property `face' of the Lisp face name. */
2628 if (next_lface_id
== lface_id_to_name_size
)
2630 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2631 sizeof *lface_id_to_name
);
2633 lface_id_to_name
[next_lface_id
] = face
;
2634 Fput (face
, Qface
, make_number (next_lface_id
));
2638 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2639 ASET (global_lface
, i
, Qunspecified
);
2641 /* Add a frame-local definition. */
2646 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2648 ASET (lface
, 0, Qface
);
2649 fset_face_alist (f
, Fcons (Fcons (face
, lface
), f
->face_alist
));
2652 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2653 ASET (lface
, i
, Qunspecified
);
2656 lface
= global_lface
;
2658 /* Changing a named face means that all realized faces depending on
2659 that face are invalid. Since we cannot tell which realized faces
2660 depend on the face, make sure they are all removed. This is done
2661 by setting face_change. The next call to init_iterator will then
2662 free realized faces. */
2663 if (NILP (Fget (face
, Qface_no_inherit
)))
2667 f
->face_change
= true;
2673 windows_or_buffers_changed
= 54;
2677 eassert (LFACEP (lface
));
2678 check_lface (lface
);
2683 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2684 Sinternal_lisp_face_p
, 1, 2, 0,
2685 doc
: /* Return non-nil if FACE names a face.
2686 FACE should be a symbol or string.
2687 If optional second argument FRAME is non-nil, check for the
2688 existence of a frame-local face with name FACE on that frame.
2689 Otherwise check for the existence of a global face. */)
2690 (Lisp_Object face
, Lisp_Object frame
)
2694 face
= resolve_face_name (face
, true);
2698 CHECK_LIVE_FRAME (frame
);
2699 lface
= lface_from_face_name (XFRAME (frame
), face
, false);
2702 lface
= lface_from_face_name (NULL
, face
, false);
2708 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2709 Sinternal_copy_lisp_face
, 4, 4, 0,
2710 doc
: /* Copy face FROM to TO.
2711 If FRAME is t, copy the global face definition of FROM.
2712 Otherwise, copy the frame-local definition of FROM on FRAME.
2713 If NEW-FRAME is a frame, copy that data into the frame-local
2714 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2715 FRAME controls where the data is copied to.
2717 The value is TO. */)
2718 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2720 Lisp_Object lface
, copy
;
2723 CHECK_SYMBOL (from
);
2728 /* Copy global definition of FROM. We don't make copies of
2729 strings etc. because 20.2 didn't do it either. */
2730 lface
= lface_from_face_name (NULL
, from
, true);
2731 copy
= Finternal_make_lisp_face (to
, Qnil
);
2736 /* Copy frame-local definition of FROM. */
2737 if (NILP (new_frame
))
2739 CHECK_LIVE_FRAME (frame
);
2740 CHECK_LIVE_FRAME (new_frame
);
2741 lface
= lface_from_face_name (XFRAME (frame
), from
, true);
2742 copy
= Finternal_make_lisp_face (to
, new_frame
);
2743 f
= XFRAME (new_frame
);
2746 vcopy (copy
, 0, XVECTOR (lface
)->contents
, LFACE_VECTOR_SIZE
);
2748 /* Changing a named face means that all realized faces depending on
2749 that face are invalid. Since we cannot tell which realized faces
2750 depend on the face, make sure they are all removed. This is done
2751 by setting face_change. The next call to init_iterator will then
2752 free realized faces. */
2753 if (NILP (Fget (to
, Qface_no_inherit
)))
2757 f
->face_change
= true;
2763 windows_or_buffers_changed
= 55;
2771 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2772 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2773 doc
: /* Set attribute ATTR of FACE to VALUE.
2774 FRAME being a frame means change the face on that frame.
2775 FRAME nil means change the face of the selected frame.
2776 FRAME t means change the default for new frames.
2777 FRAME 0 means change the face on all frames, and change the default
2779 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2782 Lisp_Object old_value
= Qnil
;
2783 /* Set one of enum font_property_index (> 0) if ATTR is one of
2784 font-related attributes other than QCfont and QCfontset. */
2785 enum font_property_index prop_index
= 0;
2788 CHECK_SYMBOL (face
);
2789 CHECK_SYMBOL (attr
);
2791 face
= resolve_face_name (face
, true);
2793 /* If FRAME is 0, change face on all frames, and change the
2794 default for new frames. */
2795 if (INTEGERP (frame
) && XINT (frame
) == 0)
2798 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2799 FOR_EACH_FRAME (tail
, frame
)
2800 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2804 /* Set lface to the Lisp attribute vector of FACE. */
2808 lface
= lface_from_face_name (NULL
, face
, true);
2810 /* When updating face-new-frame-defaults, we put :ignore-defface
2811 where the caller wants `unspecified'. This forces the frame
2812 defaults to ignore the defface value. Otherwise, the defface
2813 will take effect, which is generally not what is intended.
2814 The value of that attribute will be inherited from some other
2815 face during face merging. See internal_merge_in_global_face. */
2816 if (UNSPECIFIEDP (value
))
2817 value
= QCignore_defface
;
2822 frame
= selected_frame
;
2824 CHECK_LIVE_FRAME (frame
);
2827 lface
= lface_from_face_name (f
, face
, false);
2829 /* If a frame-local face doesn't exist yet, create one. */
2831 lface
= Finternal_make_lisp_face (face
, frame
);
2834 if (EQ (attr
, QCfamily
))
2836 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2838 CHECK_STRING (value
);
2839 if (SCHARS (value
) == 0)
2840 signal_error ("Invalid face family", value
);
2842 old_value
= LFACE_FAMILY (lface
);
2843 ASET (lface
, LFACE_FAMILY_INDEX
, value
);
2844 prop_index
= FONT_FAMILY_INDEX
;
2846 else if (EQ (attr
, QCfoundry
))
2848 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2850 CHECK_STRING (value
);
2851 if (SCHARS (value
) == 0)
2852 signal_error ("Invalid face foundry", value
);
2854 old_value
= LFACE_FOUNDRY (lface
);
2855 ASET (lface
, LFACE_FOUNDRY_INDEX
, value
);
2856 prop_index
= FONT_FOUNDRY_INDEX
;
2858 else if (EQ (attr
, QCheight
))
2860 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2862 if (EQ (face
, Qdefault
))
2864 /* The default face must have an absolute size. */
2865 if (!INTEGERP (value
) || XINT (value
) <= 0)
2866 signal_error ("Default face height not absolute and positive",
2871 /* For non-default faces, do a test merge with a random
2872 height to see if VALUE's ok. */
2873 Lisp_Object test
= merge_face_heights (value
,
2876 if (!INTEGERP (test
) || XINT (test
) <= 0)
2877 signal_error ("Face height does not produce a positive integer",
2882 old_value
= LFACE_HEIGHT (lface
);
2883 ASET (lface
, LFACE_HEIGHT_INDEX
, value
);
2884 prop_index
= FONT_SIZE_INDEX
;
2886 else if (EQ (attr
, QCweight
))
2888 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2890 CHECK_SYMBOL (value
);
2891 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2892 signal_error ("Invalid face weight", value
);
2894 old_value
= LFACE_WEIGHT (lface
);
2895 ASET (lface
, LFACE_WEIGHT_INDEX
, value
);
2896 prop_index
= FONT_WEIGHT_INDEX
;
2898 else if (EQ (attr
, QCslant
))
2900 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2902 CHECK_SYMBOL (value
);
2903 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2904 signal_error ("Invalid face slant", value
);
2906 old_value
= LFACE_SLANT (lface
);
2907 ASET (lface
, LFACE_SLANT_INDEX
, value
);
2908 prop_index
= FONT_SLANT_INDEX
;
2910 else if (EQ (attr
, QCunderline
))
2912 bool valid_p
= false;
2914 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2916 else if (NILP (value
) || EQ (value
, Qt
))
2918 else if (STRINGP (value
) && SCHARS (value
) > 0)
2920 else if (CONSP (value
))
2922 Lisp_Object key
, val
, list
;
2925 /* FIXME? This errs on the side of acceptance. Eg it accepts:
2926 (defface foo '((t :underline 'foo) "doc")
2927 Maybe this is intentional, maybe it isn't.
2928 Non-nil symbols other than t are not documented as being valid.
2929 Eg compare with inverse-video, which explicitly rejects them.
2933 while (!NILP (CAR_SAFE(list
)))
2935 key
= CAR_SAFE (list
);
2936 list
= CDR_SAFE (list
);
2937 val
= CAR_SAFE (list
);
2938 list
= CDR_SAFE (list
);
2940 if (NILP (key
) || NILP (val
))
2946 else if (EQ (key
, QCcolor
)
2947 && !(EQ (val
, Qforeground_color
)
2948 || (STRINGP (val
) && SCHARS (val
) > 0)))
2954 else if (EQ (key
, QCstyle
)
2955 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2964 signal_error ("Invalid face underline", value
);
2966 old_value
= LFACE_UNDERLINE (lface
);
2967 ASET (lface
, LFACE_UNDERLINE_INDEX
, value
);
2969 else if (EQ (attr
, QCoverline
))
2971 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2972 if ((SYMBOLP (value
)
2974 && !EQ (value
, Qnil
))
2975 /* Overline color. */
2977 && SCHARS (value
) == 0))
2978 signal_error ("Invalid face overline", value
);
2980 old_value
= LFACE_OVERLINE (lface
);
2981 ASET (lface
, LFACE_OVERLINE_INDEX
, value
);
2983 else if (EQ (attr
, QCstrike_through
))
2985 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2986 if ((SYMBOLP (value
)
2988 && !EQ (value
, Qnil
))
2989 /* Strike-through color. */
2991 && SCHARS (value
) == 0))
2992 signal_error ("Invalid face strike-through", value
);
2994 old_value
= LFACE_STRIKE_THROUGH (lface
);
2995 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, value
);
2997 else if (EQ (attr
, QCbox
))
3001 /* Allow t meaning a simple box of width 1 in foreground color
3004 value
= make_number (1);
3006 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3008 else if (NILP (value
))
3010 else if (INTEGERP (value
))
3011 valid_p
= XINT (value
) != 0;
3012 else if (STRINGP (value
))
3013 valid_p
= SCHARS (value
) > 0;
3014 else if (CONSP (value
))
3030 if (EQ (k
, QCline_width
))
3032 if (!INTEGERP (v
) || XINT (v
) == 0)
3035 else if (EQ (k
, QCcolor
))
3037 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3040 else if (EQ (k
, QCstyle
))
3042 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3049 valid_p
= NILP (tem
);
3055 signal_error ("Invalid face box", value
);
3057 old_value
= LFACE_BOX (lface
);
3058 ASET (lface
, LFACE_BOX_INDEX
, value
);
3060 else if (EQ (attr
, QCinverse_video
)
3061 || EQ (attr
, QCreverse_video
))
3063 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3065 CHECK_SYMBOL (value
);
3066 if (!EQ (value
, Qt
) && !NILP (value
))
3067 signal_error ("Invalid inverse-video face attribute value", value
);
3069 old_value
= LFACE_INVERSE (lface
);
3070 ASET (lface
, LFACE_INVERSE_INDEX
, value
);
3072 else if (EQ (attr
, QCforeground
))
3074 /* Compatibility with 20.x. */
3076 value
= Qunspecified
;
3077 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3079 /* Don't check for valid color names here because it depends
3080 on the frame (display) whether the color will be valid
3081 when the face is realized. */
3082 CHECK_STRING (value
);
3083 if (SCHARS (value
) == 0)
3084 signal_error ("Empty foreground color value", value
);
3086 old_value
= LFACE_FOREGROUND (lface
);
3087 ASET (lface
, LFACE_FOREGROUND_INDEX
, value
);
3089 else if (EQ (attr
, QCdistant_foreground
))
3091 /* Compatibility with 20.x. */
3093 value
= Qunspecified
;
3094 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3096 /* Don't check for valid color names here because it depends
3097 on the frame (display) whether the color will be valid
3098 when the face is realized. */
3099 CHECK_STRING (value
);
3100 if (SCHARS (value
) == 0)
3101 signal_error ("Empty distant-foreground color value", value
);
3103 old_value
= LFACE_DISTANT_FOREGROUND (lface
);
3104 ASET (lface
, LFACE_DISTANT_FOREGROUND_INDEX
, value
);
3106 else if (EQ (attr
, QCbackground
))
3108 /* Compatibility with 20.x. */
3110 value
= Qunspecified
;
3111 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3113 /* Don't check for valid color names here because it depends
3114 on the frame (display) whether the color will be valid
3115 when the face is realized. */
3116 CHECK_STRING (value
);
3117 if (SCHARS (value
) == 0)
3118 signal_error ("Empty background color value", value
);
3120 old_value
= LFACE_BACKGROUND (lface
);
3121 ASET (lface
, LFACE_BACKGROUND_INDEX
, value
);
3123 else if (EQ (attr
, QCstipple
))
3125 #if defined (HAVE_WINDOW_SYSTEM)
3126 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3128 && NILP (Fbitmap_spec_p (value
)))
3129 signal_error ("Invalid stipple attribute", value
);
3130 old_value
= LFACE_STIPPLE (lface
);
3131 ASET (lface
, LFACE_STIPPLE_INDEX
, value
);
3132 #endif /* HAVE_WINDOW_SYSTEM */
3134 else if (EQ (attr
, QCwidth
))
3136 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3138 CHECK_SYMBOL (value
);
3139 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3140 signal_error ("Invalid face width", value
);
3142 old_value
= LFACE_SWIDTH (lface
);
3143 ASET (lface
, LFACE_SWIDTH_INDEX
, value
);
3144 prop_index
= FONT_WIDTH_INDEX
;
3146 else if (EQ (attr
, QCfont
))
3148 #ifdef HAVE_WINDOW_SYSTEM
3149 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (f
))
3151 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3155 old_value
= LFACE_FONT (lface
);
3156 if (! FONTP (value
))
3158 if (STRINGP (value
))
3160 Lisp_Object name
= value
;
3161 int fontset
= fs_query_fontset (name
, 0);
3164 name
= fontset_ascii (fontset
);
3165 value
= font_spec_from_name (name
);
3167 signal_error ("Invalid font name", name
);
3170 signal_error ("Invalid font or font-spec", value
);
3173 f1
= XFRAME (selected_frame
);
3175 f1
= XFRAME (frame
);
3178 If frame is t, and selected frame is a tty frame, the font
3179 can't be realized. An improvement would be to loop over frames
3180 for a non-tty frame and use that. See discussion in Bug#18573.
3181 For a daemon, frame may be an initial frame (Bug#18869). */
3182 if (FRAME_WINDOW_P (f1
))
3184 if (! FONT_OBJECT_P (value
))
3186 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3187 Lisp_Object font_object
;
3189 font_object
= font_load_for_lface (f1
, attrs
, value
);
3190 if (NILP (font_object
))
3191 signal_error ("Font not available", value
);
3192 value
= font_object
;
3194 set_lface_from_font (f1
, lface
, value
, true);
3195 f1
->face_change
= 1;
3199 ASET (lface
, LFACE_FONT_INDEX
, value
);
3201 #endif /* HAVE_WINDOW_SYSTEM */
3203 else if (EQ (attr
, QCfontset
))
3205 #ifdef HAVE_WINDOW_SYSTEM
3206 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (f
))
3210 old_value
= LFACE_FONTSET (lface
);
3211 tmp
= Fquery_fontset (value
, Qnil
);
3213 signal_error ("Invalid fontset name", value
);
3214 ASET (lface
, LFACE_FONTSET_INDEX
, value
= tmp
);
3216 #endif /* HAVE_WINDOW_SYSTEM */
3218 else if (EQ (attr
, QCinherit
))
3221 if (SYMBOLP (value
))
3224 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3225 if (!SYMBOLP (XCAR (tail
)))
3228 ASET (lface
, LFACE_INHERIT_INDEX
, value
);
3230 signal_error ("Invalid face inheritance", value
);
3232 else if (EQ (attr
, QCbold
))
3234 old_value
= LFACE_WEIGHT (lface
);
3235 ASET (lface
, LFACE_WEIGHT_INDEX
, NILP (value
) ? Qnormal
: Qbold
);
3236 prop_index
= FONT_WEIGHT_INDEX
;
3238 else if (EQ (attr
, QCitalic
))
3241 old_value
= LFACE_SLANT (lface
);
3242 ASET (lface
, LFACE_SLANT_INDEX
, NILP (value
) ? Qnormal
: Qitalic
);
3243 prop_index
= FONT_SLANT_INDEX
;
3246 signal_error ("Invalid face attribute name", attr
);
3250 /* If a font-related attribute other than QCfont and QCfontset
3251 is specified, and if the original QCfont attribute has a font
3252 (font-spec or font-object), set the corresponding property in
3253 the font to nil so that the font selector doesn't think that
3254 the attribute is mandatory. Also, clear the average
3256 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3259 /* Changing a named face means that all realized faces depending on
3260 that face are invalid. Since we cannot tell which realized faces
3261 depend on the face, make sure they are all removed. This is done
3262 by setting face_change. The next call to init_iterator will then
3263 free realized faces. */
3265 && NILP (Fget (face
, Qface_no_inherit
))
3266 && NILP (Fequal (old_value
, value
)))
3268 f
->face_change
= true;
3272 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3273 && NILP (Fequal (old_value
, value
)))
3279 if (EQ (face
, Qdefault
))
3281 #ifdef HAVE_WINDOW_SYSTEM
3282 /* Changed font-related attributes of the `default' face are
3283 reflected in changed `font' frame parameters. */
3285 && (prop_index
|| EQ (attr
, QCfont
))
3286 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3287 set_font_frame_param (frame
, lface
);
3289 #endif /* HAVE_WINDOW_SYSTEM */
3291 if (EQ (attr
, QCforeground
))
3292 param
= Qforeground_color
;
3293 else if (EQ (attr
, QCbackground
))
3294 param
= Qbackground_color
;
3296 #ifdef HAVE_WINDOW_SYSTEM
3298 else if (EQ (face
, Qscroll_bar
))
3300 /* Changing the colors of `scroll-bar' sets frame parameters
3301 `scroll-bar-foreground' and `scroll-bar-background'. */
3302 if (EQ (attr
, QCforeground
))
3303 param
= Qscroll_bar_foreground
;
3304 else if (EQ (attr
, QCbackground
))
3305 param
= Qscroll_bar_background
;
3307 #endif /* not HAVE_NTGUI */
3308 else if (EQ (face
, Qborder
))
3310 /* Changing background color of `border' sets frame parameter
3312 if (EQ (attr
, QCbackground
))
3313 param
= Qborder_color
;
3315 else if (EQ (face
, Qcursor
))
3317 /* Changing background color of `cursor' sets frame parameter
3319 if (EQ (attr
, QCbackground
))
3320 param
= Qcursor_color
;
3322 else if (EQ (face
, Qmouse
))
3324 /* Changing background color of `mouse' sets frame parameter
3326 if (EQ (attr
, QCbackground
))
3327 param
= Qmouse_color
;
3329 #endif /* HAVE_WINDOW_SYSTEM */
3330 else if (EQ (face
, Qmenu
))
3332 /* Indicate that we have to update the menu bar when realizing
3333 faces on FRAME. FRAME t change the default for new frames.
3334 We do this by setting the flag in new face caches. */
3337 struct frame
*f
= XFRAME (frame
);
3338 if (FRAME_FACE_CACHE (f
) == NULL
)
3339 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3340 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= true;
3343 menu_face_changed_default
= true;
3349 /* Update `default-frame-alist', which is used for new frames. */
3351 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3354 /* Update the current frame's parameters. */
3357 cons
= XCAR (Vparam_value_alist
);
3358 XSETCAR (cons
, param
);
3359 XSETCDR (cons
, value
);
3360 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3369 /* Update the corresponding face when frame parameter PARAM on frame F
3370 has been assigned the value NEW_VALUE. */
3373 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3374 Lisp_Object new_value
)
3376 Lisp_Object face
= Qnil
;
3379 /* If there are no faces yet, give up. This is the case when called
3380 from Fx_create_frame, and we do the necessary things later in
3381 face-set-after-frame-defaults. */
3382 if (NILP (f
->face_alist
))
3385 if (EQ (param
, Qforeground_color
))
3388 lface
= lface_from_face_name (f
, face
, true);
3389 ASET (lface
, LFACE_FOREGROUND_INDEX
,
3390 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3391 realize_basic_faces (f
);
3393 else if (EQ (param
, Qbackground_color
))
3397 /* Changing the background color might change the background
3398 mode, so that we have to load new defface specs.
3399 Call frame-set-background-mode to do that. */
3400 XSETFRAME (frame
, f
);
3401 call1 (Qframe_set_background_mode
, frame
);
3404 lface
= lface_from_face_name (f
, face
, true);
3405 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3406 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3407 realize_basic_faces (f
);
3409 #ifdef HAVE_WINDOW_SYSTEM
3410 else if (EQ (param
, Qborder_color
))
3413 lface
= lface_from_face_name (f
, face
, true);
3414 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3415 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3417 else if (EQ (param
, Qcursor_color
))
3420 lface
= lface_from_face_name (f
, face
, true);
3421 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3422 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3424 else if (EQ (param
, Qmouse_color
))
3427 lface
= lface_from_face_name (f
, face
, true);
3428 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3429 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3433 /* Changing a named face means that all realized faces depending on
3434 that face are invalid. Since we cannot tell which realized faces
3435 depend on the face, make sure they are all removed. This is done
3436 by setting face_change. The next call to init_iterator will then
3437 free realized faces. */
3439 && NILP (Fget (face
, Qface_no_inherit
)))
3441 f
->face_change
= true;
3447 #ifdef HAVE_WINDOW_SYSTEM
3449 /* Set the `font' frame parameter of FRAME determined from the
3450 font-object set in `default' face attributes LFACE. */
3453 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3455 struct frame
*f
= XFRAME (frame
);
3458 if (FRAME_WINDOW_P (f
)
3459 /* Don't do anything if the font is `unspecified'. This can
3460 happen during frame creation. */
3461 && (font
= LFACE_FONT (lface
),
3462 ! UNSPECIFIEDP (font
)))
3464 if (FONT_SPEC_P (font
))
3466 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3469 ASET (lface
, LFACE_FONT_INDEX
, font
);
3471 f
->default_face_done_p
= false;
3472 AUTO_FRAME_ARG (arg
, Qfont
, font
);
3473 Fmodify_frame_parameters (frame
, arg
);
3477 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3478 Sinternal_face_x_get_resource
, 2, 3, 0,
3479 doc
: /* Get the value of X resource RESOURCE, class CLASS.
3480 Returned value is for the display of frame FRAME. If FRAME is not
3481 specified or nil, use selected frame. This function exists because
3482 ordinary `x-get-resource' doesn't take a frame argument. */)
3483 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3485 Lisp_Object value
= Qnil
;
3488 CHECK_STRING (resource
);
3489 CHECK_STRING (class);
3490 f
= decode_live_frame (frame
);
3492 value
= display_x_get_resource (FRAME_DISPLAY_INFO (f
),
3493 resource
, class, Qnil
, Qnil
);
3499 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3500 If VALUE is "on" or "true", return t. If VALUE is "off" or
3501 "false", return nil. Otherwise, if SIGNAL_P, signal an
3502 error; if !SIGNAL_P, return 0. */
3505 face_boolean_x_resource_value (Lisp_Object value
, bool signal_p
)
3507 Lisp_Object result
= make_number (0);
3509 eassert (STRINGP (value
));
3511 if (xstrcasecmp (SSDATA (value
), "on") == 0
3512 || xstrcasecmp (SSDATA (value
), "true") == 0)
3514 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3515 || xstrcasecmp (SSDATA (value
), "false") == 0)
3517 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3518 result
= Qunspecified
;
3520 signal_error ("Invalid face attribute value from X resource", value
);
3526 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3527 Finternal_set_lisp_face_attribute_from_resource
,
3528 Sinternal_set_lisp_face_attribute_from_resource
,
3529 3, 4, 0, doc
: /* */)
3530 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3532 CHECK_SYMBOL (face
);
3533 CHECK_SYMBOL (attr
);
3534 CHECK_STRING (value
);
3536 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3537 value
= Qunspecified
;
3538 else if (EQ (attr
, QCheight
))
3540 value
= Fstring_to_number (value
, Qnil
);
3541 if (!INTEGERP (value
) || XINT (value
) <= 0)
3542 signal_error ("Invalid face height from X resource", value
);
3544 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3545 value
= face_boolean_x_resource_value (value
, true);
3546 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3547 value
= intern (SSDATA (value
));
3548 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3549 value
= face_boolean_x_resource_value (value
, true);
3550 else if (EQ (attr
, QCunderline
)
3551 || EQ (attr
, QCoverline
)
3552 || EQ (attr
, QCstrike_through
))
3554 Lisp_Object boolean_value
;
3556 /* If the result of face_boolean_x_resource_value is t or nil,
3557 VALUE does NOT specify a color. */
3558 boolean_value
= face_boolean_x_resource_value (value
, false);
3559 if (SYMBOLP (boolean_value
))
3560 value
= boolean_value
;
3562 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3563 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3565 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3568 #endif /* HAVE_WINDOW_SYSTEM */
3571 /***********************************************************************
3573 ***********************************************************************/
3575 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3577 /* Make menus on frame F appear as specified by the `menu' face. */
3580 x_update_menu_appearance (struct frame
*f
)
3582 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
3586 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3591 ptrdiff_t bufsize
= sizeof line
;
3592 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, true);
3593 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3594 const char *myname
= SSDATA (Vx_resource_name
);
3595 bool changed_p
= false;
3597 const char *popup_path
= "popup_menu";
3599 const char *popup_path
= "menu.popup";
3602 if (STRINGP (LFACE_FOREGROUND (lface
)))
3604 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3606 SDATA (LFACE_FOREGROUND (lface
)));
3607 XrmPutLineResource (&rdb
, line
);
3608 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3609 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3610 XrmPutLineResource (&rdb
, line
);
3614 if (STRINGP (LFACE_BACKGROUND (lface
)))
3616 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3618 SDATA (LFACE_BACKGROUND (lface
)));
3619 XrmPutLineResource (&rdb
, line
);
3621 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3622 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3623 XrmPutLineResource (&rdb
, line
);
3628 /* On Solaris 5.8, it's been reported that the `menu' face
3629 can be unspecified here, during startup. Why this
3630 happens remains unknown. -- cyd */
3631 && FONTP (LFACE_FONT (lface
))
3632 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3633 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3634 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3635 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3636 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3637 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3639 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3641 const char *suffix
= "List";
3644 #if defined HAVE_X_I18N
3646 const char *suffix
= "Set";
3648 const char *suffix
= "";
3655 #if defined HAVE_X_I18N
3656 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3658 char *fontsetname
= SSDATA (xlfd
);
3660 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3661 myname
, suffix
, fontsetname
);
3662 XrmPutLineResource (&rdb
, line
);
3664 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3665 myname
, popup_path
, suffix
, fontsetname
);
3666 XrmPutLineResource (&rdb
, line
);
3668 if (fontsetname
!= SSDATA (xlfd
))
3669 xfree (fontsetname
);
3673 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3674 free_frame_menubar (f
);
3681 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3684 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3685 Sface_attribute_relative_p
,
3687 doc
: /* Check whether a face attribute value is relative.
3688 Specifically, this function returns t if the attribute ATTRIBUTE
3689 with the value VALUE is relative.
3691 A relative value is one that doesn't entirely override whatever is
3692 inherited from another face. For most possible attributes,
3693 the only relative value that users see is `unspecified'.
3694 However, for :height, floating point values are also relative. */
3696 (Lisp_Object attribute
, Lisp_Object value
)
3698 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3700 else if (EQ (attribute
, QCheight
))
3701 return INTEGERP (value
) ? Qnil
: Qt
;
3706 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3708 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3709 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3710 the result will be absolute, otherwise it will be relative. */)
3711 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3713 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3715 else if (EQ (attribute
, QCheight
))
3716 return merge_face_heights (value1
, value2
, value1
);
3722 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3723 Sinternal_get_lisp_face_attribute
,
3725 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3726 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3727 face attribute name, signal an error.
3728 If the optional argument FRAME is given, report on face SYMBOL in that
3729 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3730 frames). If FRAME is omitted or nil, use the selected frame. */)
3731 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3733 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3734 Lisp_Object lface
= lface_from_face_name (f
, symbol
, true), value
= Qnil
;
3736 CHECK_SYMBOL (symbol
);
3737 CHECK_SYMBOL (keyword
);
3739 if (EQ (keyword
, QCfamily
))
3740 value
= LFACE_FAMILY (lface
);
3741 else if (EQ (keyword
, QCfoundry
))
3742 value
= LFACE_FOUNDRY (lface
);
3743 else if (EQ (keyword
, QCheight
))
3744 value
= LFACE_HEIGHT (lface
);
3745 else if (EQ (keyword
, QCweight
))
3746 value
= LFACE_WEIGHT (lface
);
3747 else if (EQ (keyword
, QCslant
))
3748 value
= LFACE_SLANT (lface
);
3749 else if (EQ (keyword
, QCunderline
))
3750 value
= LFACE_UNDERLINE (lface
);
3751 else if (EQ (keyword
, QCoverline
))
3752 value
= LFACE_OVERLINE (lface
);
3753 else if (EQ (keyword
, QCstrike_through
))
3754 value
= LFACE_STRIKE_THROUGH (lface
);
3755 else if (EQ (keyword
, QCbox
))
3756 value
= LFACE_BOX (lface
);
3757 else if (EQ (keyword
, QCinverse_video
)
3758 || EQ (keyword
, QCreverse_video
))
3759 value
= LFACE_INVERSE (lface
);
3760 else if (EQ (keyword
, QCforeground
))
3761 value
= LFACE_FOREGROUND (lface
);
3762 else if (EQ (keyword
, QCdistant_foreground
))
3763 value
= LFACE_DISTANT_FOREGROUND (lface
);
3764 else if (EQ (keyword
, QCbackground
))
3765 value
= LFACE_BACKGROUND (lface
);
3766 else if (EQ (keyword
, QCstipple
))
3767 value
= LFACE_STIPPLE (lface
);
3768 else if (EQ (keyword
, QCwidth
))
3769 value
= LFACE_SWIDTH (lface
);
3770 else if (EQ (keyword
, QCinherit
))
3771 value
= LFACE_INHERIT (lface
);
3772 else if (EQ (keyword
, QCfont
))
3773 value
= LFACE_FONT (lface
);
3774 else if (EQ (keyword
, QCfontset
))
3775 value
= LFACE_FONTSET (lface
);
3777 signal_error ("Invalid face attribute name", keyword
);
3779 if (IGNORE_DEFFACE_P (value
))
3780 return Qunspecified
;
3786 DEFUN ("internal-lisp-face-attribute-values",
3787 Finternal_lisp_face_attribute_values
,
3788 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3789 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3790 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3793 Lisp_Object result
= Qnil
;
3795 CHECK_SYMBOL (attr
);
3797 if (EQ (attr
, QCunderline
) || EQ (attr
, QCoverline
)
3798 || EQ (attr
, QCstrike_through
)
3799 || EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3800 result
= list2 (Qt
, Qnil
);
3806 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3807 Sinternal_merge_in_global_face
, 2, 2, 0,
3808 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3809 Default face attributes override any local face attributes. */)
3810 (Lisp_Object face
, Lisp_Object frame
)
3813 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3814 struct frame
*f
= XFRAME (frame
);
3816 CHECK_LIVE_FRAME (frame
);
3817 global_lface
= lface_from_face_name (NULL
, face
, true);
3818 local_lface
= lface_from_face_name (f
, face
, false);
3819 if (NILP (local_lface
))
3820 local_lface
= Finternal_make_lisp_face (face
, frame
);
3822 /* Make every specified global attribute override the local one.
3823 BEWARE!! This is only used from `face-set-after-frame-default' where
3824 the local frame is defined from default specs in `face-defface-spec'
3825 and those should be overridden by global settings. Hence the strange
3826 "global before local" priority. */
3827 lvec
= XVECTOR (local_lface
)->contents
;
3828 gvec
= XVECTOR (global_lface
)->contents
;
3829 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3830 if (IGNORE_DEFFACE_P (gvec
[i
]))
3831 ASET (local_lface
, i
, Qunspecified
);
3832 else if (! UNSPECIFIEDP (gvec
[i
]))
3833 ASET (local_lface
, i
, AREF (global_lface
, i
));
3835 /* If the default face was changed, update the face cache and the
3836 `font' frame parameter. */
3837 if (EQ (face
, Qdefault
))
3839 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3840 struct face
*newface
, *oldface
= FACE_FROM_ID_OR_NULL (f
, DEFAULT_FACE_ID
);
3841 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3843 /* This can be NULL (e.g., in batch mode). */
3846 /* Ensure that the face vector is fully specified by merging
3847 the previously-cached vector. */
3848 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3849 merge_face_vectors (NULL
, f
, lvec
, attrs
, 0);
3850 vcopy (local_lface
, 0, attrs
, LFACE_VECTOR_SIZE
);
3851 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3853 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3854 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3855 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3856 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3857 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3858 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3859 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3862 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3863 AUTO_FRAME_ARG (arg
, Qfont
, name
);
3864 Fmodify_frame_parameters (frame
, arg
);
3867 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3869 AUTO_FRAME_ARG (arg
, Qforeground_color
,
3870 gvec
[LFACE_FOREGROUND_INDEX
]);
3871 Fmodify_frame_parameters (frame
, arg
);
3874 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3876 AUTO_FRAME_ARG (arg
, Qbackground_color
,
3877 gvec
[LFACE_BACKGROUND_INDEX
]);
3878 Fmodify_frame_parameters (frame
, arg
);
3887 /* The following function is implemented for compatibility with 20.2.
3888 The function is used in x-resolve-fonts when it is asked to
3889 return fonts with the same size as the font of a face. This is
3890 done in fontset.el. */
3892 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3893 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3894 The font name is, by default, for ASCII characters.
3895 If the optional argument FRAME is given, report on face FACE in that frame.
3896 If FRAME is t, report on the defaults for face FACE (for new frames).
3897 The font default for a face is either nil, or a list
3898 of the form (bold), (italic) or (bold italic).
3899 If FRAME is omitted or nil, use the selected frame. And, in this case,
3900 if the optional third argument CHARACTER is given,
3901 return the font name used for CHARACTER. */)
3902 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3906 Lisp_Object result
= Qnil
;
3907 Lisp_Object lface
= lface_from_face_name (NULL
, face
, true);
3909 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3910 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3911 result
= Fcons (Qbold
, result
);
3913 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3914 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3915 result
= Fcons (Qitalic
, result
);
3921 struct frame
*f
= decode_live_frame (frame
);
3922 int face_id
= lookup_named_face (NULL
, f
, face
, true);
3923 struct face
*fface
= FACE_FROM_ID_OR_NULL (f
, face_id
);
3927 #ifdef HAVE_WINDOW_SYSTEM
3928 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3930 CHECK_CHARACTER (character
);
3931 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3932 fface
= FACE_FROM_ID_OR_NULL (f
, face_id
);
3934 return ((fface
&& fface
->font
)
3935 ? fface
->font
->props
[FONT_NAME_INDEX
]
3937 #else /* !HAVE_WINDOW_SYSTEM */
3938 return build_string (FRAME_MSDOS_P (f
)
3940 : FRAME_W32_P (f
) ? "w32term"
3947 /* Compare face-attribute values v1 and v2 for equality. Value is true if
3948 all attributes are `equal'. Tries to be fast because this function
3949 is called quite often. */
3952 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3954 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3955 and the other is specified. */
3956 if (XTYPE (v1
) != XTYPE (v2
))
3965 if (SBYTES (v1
) != SBYTES (v2
))
3968 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3975 return !NILP (Fequal (v1
, v2
));
3980 /* Compare face vectors V1 and V2 for equality. Value is true if
3981 all attributes are `equal'. Tries to be fast because this function
3982 is called quite often. */
3985 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3988 bool equal_p
= true;
3990 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3991 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3997 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3998 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3999 doc
: /* True if FACE1 and FACE2 are equal.
4000 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
4001 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
4002 If FRAME is omitted or nil, use the selected frame. */)
4003 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
4007 Lisp_Object lface1
, lface2
;
4009 /* Don't use decode_window_system_frame here because this function
4010 is called before X frames exist. At that time, if FRAME is nil,
4011 selected_frame will be used which is the frame dumped with
4012 Emacs. That frame is not an X frame. */
4013 f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
4015 lface1
= lface_from_face_name (f
, face1
, true);
4016 lface2
= lface_from_face_name (f
, face2
, true);
4017 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4018 XVECTOR (lface2
)->contents
);
4019 return equal_p
? Qt
: Qnil
;
4023 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4024 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4025 doc
: /* True if FACE has no attribute specified.
4026 If the optional argument FRAME is given, report on face FACE in that frame.
4027 If FRAME is t, report on the defaults for face FACE (for new frames).
4028 If FRAME is omitted or nil, use the selected frame. */)
4029 (Lisp_Object face
, Lisp_Object frame
)
4031 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
4032 Lisp_Object lface
= lface_from_face_name (f
, face
, true);
4035 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4036 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4039 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4043 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4045 doc
: /* Return an alist of frame-local faces defined on FRAME.
4046 For internal use only. */)
4049 return decode_live_frame (frame
)->face_alist
;
4053 /* Return a hash code for Lisp string STRING with case ignored. Used
4054 below in computing a hash value for a Lisp face. */
4057 hash_string_case_insensitive (Lisp_Object string
)
4059 const unsigned char *s
;
4061 eassert (STRINGP (string
));
4062 for (s
= SDATA (string
); *s
; ++s
)
4063 hash
= (hash
<< 1) ^ c_tolower (*s
);
4068 /* Return a hash code for face attribute vector V. */
4071 lface_hash (Lisp_Object
*v
)
4073 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4074 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4075 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4076 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4077 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4078 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4079 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4080 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4083 #ifdef HAVE_WINDOW_SYSTEM
4085 /* Return true if LFACE1 and LFACE2 specify the same font (without
4086 considering charsets/registries). They do if they specify the same
4087 family, point size, weight, width, slant, and font. Both
4088 LFACE1 and LFACE2 must be fully-specified. */
4091 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4093 eassert (lface_fully_specified_p (lface1
)
4094 && lface_fully_specified_p (lface2
));
4095 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4096 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4097 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4098 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4099 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4100 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4101 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4102 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4103 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4104 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4105 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4106 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4107 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4108 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4112 #endif /* HAVE_WINDOW_SYSTEM */
4114 /***********************************************************************
4116 ***********************************************************************/
4118 /* Allocate and return a new realized face for Lisp face attribute
4121 static struct face
*
4122 make_realized_face (Lisp_Object
*attr
)
4124 enum { off
= offsetof (struct face
, id
) };
4125 struct face
*face
= xmalloc (sizeof *face
);
4127 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4128 memset (&face
->id
, 0, sizeof *face
- off
);
4129 face
->ascii_face
= face
;
4135 /* Free realized face FACE, including its X resources. FACE may
4139 free_realized_face (struct frame
*f
, struct face
*face
)
4143 #ifdef HAVE_WINDOW_SYSTEM
4144 if (FRAME_WINDOW_P (f
))
4146 /* Free fontset of FACE if it is ASCII face. */
4147 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4148 free_face_fontset (f
, face
);
4153 font_done_for_face (f
, face
);
4154 x_free_gc (f
, face
->gc
);
4158 #ifdef HAVE_X_WINDOWS
4159 free_face_colors (f
, face
);
4160 #endif /* HAVE_X_WINDOWS */
4161 x_destroy_bitmap (f
, face
->stipple
);
4163 #endif /* HAVE_WINDOW_SYSTEM */
4169 #ifdef HAVE_WINDOW_SYSTEM
4171 /* Prepare face FACE for subsequent display on frame F. This must be called
4172 before using X resources of FACE to allocate GCs if they haven't been
4173 allocated yet or have been freed by clearing the face cache. */
4176 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4178 eassert (FRAME_WINDOW_P (f
));
4183 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4185 xgcv
.foreground
= face
->foreground
;
4186 xgcv
.background
= face
->background
;
4187 #ifdef HAVE_X_WINDOWS
4188 xgcv
.graphics_exposures
= False
;
4192 #ifdef HAVE_X_WINDOWS
4195 xgcv
.fill_style
= FillOpaqueStippled
;
4196 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4197 mask
|= GCFillStyle
| GCStipple
;
4200 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4202 font_prepare_for_face (f
, face
);
4207 #endif /* HAVE_WINDOW_SYSTEM */
4209 /* Returns the `distance' between the colors X and Y. */
4212 color_distance (XColor
*x
, XColor
*y
)
4214 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4215 Quoting from that paper:
4217 This formula has results that are very close to L*u*v* (with the
4218 modified lightness curve) and, more importantly, it is a more even
4219 algorithm: it does not have a range of colors where it suddenly
4220 gives far from optimal results.
4222 See <http://www.compuphase.com/cmetric.htm> for more info. */
4224 long r
= (x
->red
- y
->red
) >> 8;
4225 long g
= (x
->green
- y
->green
) >> 8;
4226 long b
= (x
->blue
- y
->blue
) >> 8;
4227 long r_mean
= (x
->red
+ y
->red
) >> 9;
4230 (((512 + r_mean
) * r
* r
) >> 8)
4232 + (((767 - r_mean
) * b
* b
) >> 8);
4236 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 4, 0,
4237 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4238 COLOR1 and COLOR2 may be either strings containing the color name,
4239 or lists of the form (RED GREEN BLUE), each in the range 0 to 65535 inclusive.
4240 If FRAME is unspecified or nil, the current frame is used.
4241 If METRIC is specified, it should be a function that accepts
4242 two lists of the form (RED GREEN BLUE) aforementioned. */)
4243 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
,
4246 struct frame
*f
= decode_live_frame (frame
);
4247 XColor cdef1
, cdef2
;
4249 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4250 && !(STRINGP (color1
)
4251 && defined_color (f
, SSDATA (color1
), &cdef1
, false)))
4252 signal_error ("Invalid color", color1
);
4253 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4254 && !(STRINGP (color2
)
4255 && defined_color (f
, SSDATA (color2
), &cdef2
, false)))
4256 signal_error ("Invalid color", color2
);
4259 return make_number (color_distance (&cdef1
, &cdef2
));
4261 return call2 (metric
,
4262 list3 (make_number (cdef1
.red
),
4263 make_number (cdef1
.green
),
4264 make_number (cdef1
.blue
)),
4265 list3 (make_number (cdef2
.red
),
4266 make_number (cdef2
.green
),
4267 make_number (cdef2
.blue
)));
4271 /***********************************************************************
4273 ***********************************************************************/
4275 /* Return a new face cache for frame F. */
4277 static struct face_cache
*
4278 make_face_cache (struct frame
*f
)
4280 struct face_cache
*c
= xmalloc (sizeof *c
);
4282 c
->buckets
= xzalloc (FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
);
4285 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4287 c
->menu_face_changed_p
= menu_face_changed_default
;
4291 #ifdef HAVE_WINDOW_SYSTEM
4293 /* Clear out all graphics contexts for all realized faces, except for
4294 the basic faces. This should be done from time to time just to avoid
4295 keeping too many graphics contexts that are no longer needed. */
4298 clear_face_gcs (struct face_cache
*c
)
4300 if (c
&& FRAME_WINDOW_P (c
->f
))
4303 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4305 struct face
*face
= c
->faces_by_id
[i
];
4306 if (face
&& face
->gc
)
4310 font_done_for_face (c
->f
, face
);
4311 x_free_gc (c
->f
, face
->gc
);
4319 #endif /* HAVE_WINDOW_SYSTEM */
4321 /* Free all realized faces in face cache C, including basic faces.
4322 C may be null. If faces are freed, make sure the frame's current
4323 matrix is marked invalid, so that a display caused by an expose
4324 event doesn't try to use faces we destroyed. */
4327 free_realized_faces (struct face_cache
*c
)
4332 struct frame
*f
= c
->f
;
4334 /* We must block input here because we can't process X events
4335 safely while only some faces are freed, or when the frame's
4336 current matrix still references freed faces. */
4339 for (i
= 0; i
< c
->used
; ++i
)
4341 free_realized_face (f
, c
->faces_by_id
[i
]);
4342 c
->faces_by_id
[i
] = NULL
;
4345 /* Forget the escape-glyph and glyphless-char faces. */
4346 forget_escape_and_glyphless_faces ();
4348 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4349 memset (c
->buckets
, 0, size
);
4351 /* Must do a thorough redisplay the next time. Mark current
4352 matrices as invalid because they will reference faces freed
4353 above. This function is also called when a frame is
4354 destroyed. In this case, the root window of F is nil. */
4355 if (WINDOWP (f
->root_window
))
4357 clear_current_matrices (f
);
4366 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4367 This is done after attributes of a named face have been changed,
4368 because we can't tell which realized faces depend on that face. */
4371 free_all_realized_faces (Lisp_Object frame
)
4376 FOR_EACH_FRAME (rest
, frame
)
4377 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4378 windows_or_buffers_changed
= 58;
4381 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4385 /* Free face cache C and faces in it, including their X resources. */
4388 free_face_cache (struct face_cache
*c
)
4392 free_realized_faces (c
);
4394 xfree (c
->faces_by_id
);
4400 /* Cache realized face FACE in face cache C. HASH is the hash value
4401 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4402 FACE), insert the new face to the beginning of the collision list
4403 of the face hash table of C. Otherwise, add the new face to the
4404 end of the collision list. This way, lookup_face can quickly find
4405 that a requested face is not cached. */
4408 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4410 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4414 if (face
->ascii_face
!= face
)
4416 struct face
*last
= c
->buckets
[i
];
4427 c
->buckets
[i
] = face
;
4428 face
->prev
= face
->next
= NULL
;
4434 face
->next
= c
->buckets
[i
];
4436 face
->next
->prev
= face
;
4437 c
->buckets
[i
] = face
;
4440 /* Find a free slot in C->faces_by_id and use the index of the free
4441 slot as FACE->id. */
4442 for (i
= 0; i
< c
->used
; ++i
)
4443 if (c
->faces_by_id
[i
] == NULL
)
4448 /* Check that FACE got a unique id. */
4453 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4454 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4460 #endif /* GLYPH_DEBUG */
4462 /* Maybe enlarge C->faces_by_id. */
4465 if (c
->used
== c
->size
)
4466 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4467 sizeof *c
->faces_by_id
);
4471 c
->faces_by_id
[i
] = face
;
4475 /* Remove face FACE from cache C. */
4478 uncache_face (struct face_cache
*c
, struct face
*face
)
4480 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4483 face
->prev
->next
= face
->next
;
4485 c
->buckets
[i
] = face
->next
;
4488 face
->next
->prev
= face
->prev
;
4490 c
->faces_by_id
[face
->id
] = NULL
;
4491 if (face
->id
== c
->used
)
4496 /* Look up a realized face with face attributes ATTR in the face cache
4497 of frame F. The face will be used to display ASCII characters.
4498 Value is the ID of the face found. If no suitable face is found,
4499 realize a new one. */
4502 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4504 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4509 eassert (cache
!= NULL
);
4510 check_lface_attrs (attr
);
4512 /* Look up ATTR in the face cache. */
4513 hash
= lface_hash (attr
);
4514 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4516 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4518 if (face
->ascii_face
!= face
)
4520 /* There's no more ASCII face. */
4524 if (face
->hash
== hash
4525 && lface_equal_p (face
->lface
, attr
))
4529 /* If not found, realize a new face. */
4531 face
= realize_face (cache
, attr
, -1);
4534 eassert (face
== FACE_FROM_ID_OR_NULL (f
, face
->id
));
4535 #endif /* GLYPH_DEBUG */
4540 #ifdef HAVE_WINDOW_SYSTEM
4541 /* Look up a realized face that has the same attributes as BASE_FACE
4542 except for the font in the face cache of frame F. If FONT-OBJECT
4543 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4544 the face has no font. Value is the ID of the face found. If no
4545 suitable face is found, realize a new one. */
4548 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4550 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4555 eassert (cache
!= NULL
);
4556 base_face
= base_face
->ascii_face
;
4557 hash
= lface_hash (base_face
->lface
);
4558 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4560 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4562 if (face
->ascii_face
== face
)
4564 if (face
->ascii_face
== base_face
4565 && face
->font
== (NILP (font_object
) ? NULL
4566 : XFONT_OBJECT (font_object
))
4567 && lface_equal_p (face
->lface
, base_face
->lface
))
4571 /* If not found, realize a new face. */
4572 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4575 #endif /* HAVE_WINDOW_SYSTEM */
4577 /* Return the face id of the realized face for named face SYMBOL on
4578 frame F suitable for displaying ASCII characters. Value is -1 if
4579 the face couldn't be determined, which might happen if the default
4580 face isn't realized and cannot be realized. If window W is given,
4581 consider face remappings specified for W or for W's buffer. If W
4582 is NULL, consider only frame-level face configuration. */
4584 lookup_named_face (struct window
*w
, struct frame
*f
,
4585 Lisp_Object symbol
, bool signal_p
)
4587 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4588 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4589 struct face
*default_face
= FACE_FROM_ID_OR_NULL (f
, DEFAULT_FACE_ID
);
4591 if (default_face
== NULL
)
4593 if (!realize_basic_faces (f
))
4595 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4598 if (! get_lface_attributes (w
, f
, symbol
, symbol_attrs
, signal_p
, 0))
4601 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4602 merge_face_vectors (w
, f
, symbol_attrs
, attrs
, 0);
4604 return lookup_face (f
, attrs
);
4608 /* Return the display face-id of the basic face whose canonical face-id
4609 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4610 basic face has bee remapped via Vface_remapping_alist. This function is
4611 conservative: if something goes wrong, it will simply return FACE_ID
4612 rather than signal an error. Window W, if non-NULL, is used to filter
4613 face specifications for remapping. */
4615 lookup_basic_face (struct window
*w
, struct frame
*f
, int face_id
)
4617 Lisp_Object name
, mapping
;
4618 int remapped_face_id
;
4620 if (NILP (Vface_remapping_alist
))
4621 return face_id
; /* Nothing to do. */
4625 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4626 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4627 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4628 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4629 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4630 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4631 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4632 case BORDER_FACE_ID
: name
= Qborder
; break;
4633 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4634 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4635 case MENU_FACE_ID
: name
= Qmenu
; break;
4636 case WINDOW_DIVIDER_FACE_ID
: name
= Qwindow_divider
; break;
4637 case VERTICAL_BORDER_FACE_ID
: name
= Qvertical_border
; break;
4638 case WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID
: name
= Qwindow_divider_first_pixel
; break;
4639 case WINDOW_DIVIDER_LAST_PIXEL_FACE_ID
: name
= Qwindow_divider_last_pixel
; break;
4640 case INTERNAL_BORDER_FACE_ID
: name
= Qinternal_border
; break;
4643 emacs_abort (); /* the caller is supposed to pass us a basic face id */
4646 /* Do a quick scan through Vface_remapping_alist, and return immediately
4647 if there is no remapping for face NAME. This is just an optimization
4648 for the very common no-remapping case. */
4649 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4651 return face_id
; /* Give up. */
4653 /* If there is a remapping entry, lookup the face using NAME, which will
4654 handle the remapping too. */
4655 remapped_face_id
= lookup_named_face (w
, f
, name
, false);
4656 if (remapped_face_id
< 0)
4657 return face_id
; /* Give up. */
4659 return remapped_face_id
;
4663 /* Return a face for charset ASCII that is like the face with id
4664 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4665 STEPS < 0 means larger. Value is the id of the face. */
4668 smaller_face (struct frame
*f
, int face_id
, int steps
)
4670 #ifdef HAVE_WINDOW_SYSTEM
4672 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4673 int pt
, last_pt
, last_height
;
4676 struct face
*new_face
;
4678 /* If not called for an X frame, just return the original face. */
4679 if (FRAME_TERMCAP_P (f
))
4682 /* Try in increments of 1/2 pt. */
4683 delta
= steps
< 0 ? 5 : -5;
4684 steps
= eabs (steps
);
4686 face
= FACE_FROM_ID (f
, face_id
);
4687 memcpy (attrs
, face
->lface
, sizeof attrs
);
4688 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4689 new_face_id
= face_id
;
4690 last_height
= FONT_HEIGHT (face
->font
);
4694 /* Give up if we cannot find a font within 10pt. */
4695 && eabs (last_pt
- pt
) < 100)
4697 /* Look up a face for a slightly smaller/larger font. */
4699 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4700 new_face_id
= lookup_face (f
, attrs
);
4701 new_face
= FACE_FROM_ID (f
, new_face_id
);
4703 /* If height changes, count that as one step. */
4704 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4705 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4708 last_height
= FONT_HEIGHT (new_face
->font
);
4715 #else /* not HAVE_WINDOW_SYSTEM */
4719 #endif /* not HAVE_WINDOW_SYSTEM */
4723 /* Return a face for charset ASCII that is like the face with id
4724 FACE_ID on frame F, but has height HEIGHT. */
4727 face_with_height (struct frame
*f
, int face_id
, int height
)
4729 #ifdef HAVE_WINDOW_SYSTEM
4731 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4733 if (FRAME_TERMCAP_P (f
)
4737 face
= FACE_FROM_ID (f
, face_id
);
4738 memcpy (attrs
, face
->lface
, sizeof attrs
);
4739 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4740 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4741 face_id
= lookup_face (f
, attrs
);
4742 #endif /* HAVE_WINDOW_SYSTEM */
4748 /* Return the face id of the realized face for named face SYMBOL on
4749 frame F suitable for displaying ASCII characters, and use
4750 attributes of the face FACE_ID for attributes that aren't
4751 completely specified by SYMBOL. This is like lookup_named_face,
4752 except that the default attributes come from FACE_ID, not from the
4753 default face. FACE_ID is assumed to be already realized.
4754 Window W, if non-NULL, filters face specifications. */
4756 lookup_derived_face (struct window
*w
,
4757 struct frame
*f
, Lisp_Object symbol
, int face_id
,
4760 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4761 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4762 struct face
*default_face
;
4764 if (!get_lface_attributes (w
, f
, symbol
, symbol_attrs
, signal_p
, 0))
4767 default_face
= FACE_FROM_ID (f
, face_id
);
4768 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4769 merge_face_vectors (w
, f
, symbol_attrs
, attrs
, 0);
4770 return lookup_face (f
, attrs
);
4773 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4774 Sface_attributes_as_vector
, 1, 1, 0,
4775 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4779 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4781 merge_face_ref (NULL
, XFRAME (selected_frame
),
4782 plist
, XVECTOR (lface
)->contents
,
4789 /***********************************************************************
4790 Face capability testing
4791 ***********************************************************************/
4794 /* If the distance (as returned by color_distance) between two colors is
4795 less than this, then they are considered the same, for determining
4796 whether a color is supported or not. The range of values is 0-65535. */
4798 #define TTY_SAME_COLOR_THRESHOLD 10000
4800 #ifdef HAVE_WINDOW_SYSTEM
4802 /* Return true if all the face attributes in ATTRS are supported
4803 on the window-system frame F.
4805 The definition of `supported' is somewhat heuristic, but basically means
4806 that a face containing all the attributes in ATTRS, when merged with the
4807 default face for display, can be represented in a way that's
4809 (1) different in appearance than the default face, and
4810 (2) `close in spirit' to what the attributes specify, if not exact. */
4813 x_supports_face_attributes_p (struct frame
*f
,
4814 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4815 struct face
*def_face
)
4817 Lisp_Object
*def_attrs
= def_face
->lface
;
4819 /* Check that other specified attributes are different that the default
4821 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4822 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4823 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4824 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4825 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4826 def_attrs
[LFACE_INVERSE_INDEX
]))
4827 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4828 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4829 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4830 || (!UNSPECIFIEDP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
4831 && face_attr_equal_p (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
],
4832 def_attrs
[LFACE_DISTANT_FOREGROUND_INDEX
]))
4833 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4834 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4835 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4836 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4837 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4838 def_attrs
[LFACE_STIPPLE_INDEX
]))
4839 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4840 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4841 def_attrs
[LFACE_OVERLINE_INDEX
]))
4842 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4843 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4844 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4845 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4846 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4847 def_attrs
[LFACE_BOX_INDEX
])))
4850 /* Check font-related attributes, as those are the most commonly
4851 "unsupported" on a window-system (because of missing fonts). */
4852 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4853 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4854 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4855 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4856 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4857 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4861 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4864 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4866 merge_face_vectors (NULL
, f
, attrs
, merged_attrs
, 0);
4868 face_id
= lookup_face (f
, merged_attrs
);
4869 face
= FACE_FROM_ID_OR_NULL (f
, face_id
);
4872 error ("Cannot make face");
4874 /* If the font is the same, or no font is found, then not
4876 if (face
->font
== def_face
->font
4879 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4880 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4884 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4885 || face
->font
->driver
->case_sensitive
)
4887 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4888 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4889 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4890 s2
, make_number (0), Qnil
, Qt
), Qt
))
4896 /* Everything checks out, this face is supported. */
4900 #endif /* HAVE_WINDOW_SYSTEM */
4902 /* Return true if all the face attributes in ATTRS are supported
4905 The definition of `supported' is somewhat heuristic, but basically means
4906 that a face containing all the attributes in ATTRS, when merged
4907 with the default face for display, can be represented in a way that's
4909 (1) different in appearance than the default face, and
4910 (2) `close in spirit' to what the attributes specify, if not exact.
4912 Point (2) implies that a `:weight black' attribute will be satisfied
4913 by any terminal that can display bold, and a `:foreground "yellow"' as
4914 long as the terminal can display a yellowish color, but `:slant italic'
4915 will _not_ be satisfied by the tty display code's automatic
4916 substitution of a `dim' face for italic. */
4919 tty_supports_face_attributes_p (struct frame
*f
,
4920 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4921 struct face
*def_face
)
4924 Lisp_Object val
, fg
, bg
;
4925 XColor fg_tty_color
, fg_std_color
;
4926 XColor bg_tty_color
, bg_std_color
;
4927 unsigned test_caps
= 0;
4928 Lisp_Object
*def_attrs
= def_face
->lface
;
4930 /* First check some easy-to-check stuff; ttys support none of the
4931 following attributes, so we can just return false if any are requested
4932 (even if `nominal' values are specified, we should still return false,
4933 as that will be the same value that the default face uses). We
4934 consider :slant unsupportable on ttys, even though the face code
4935 actually `fakes' them using a dim attribute if possible. This is
4936 because the faked result is too different from what the face
4938 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4939 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4940 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4941 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4942 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4943 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4944 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4945 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4948 /* Test for terminal `capabilities' (non-color character attributes). */
4950 /* font weight (bold/dim) */
4951 val
= attrs
[LFACE_WEIGHT_INDEX
];
4952 if (!UNSPECIFIEDP (val
)
4953 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4955 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4959 if (def_weight
> 100)
4960 return false; /* same as default */
4961 test_caps
= TTY_CAP_BOLD
;
4963 else if (weight
< 100)
4965 if (def_weight
< 100)
4966 return false; /* same as default */
4967 test_caps
= TTY_CAP_DIM
;
4969 else if (def_weight
== 100)
4970 return false; /* same as default */
4974 val
= attrs
[LFACE_SLANT_INDEX
];
4975 if (!UNSPECIFIEDP (val
)
4976 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4978 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4979 if (slant
== 100 || slant
== def_slant
)
4980 return false; /* same as default */
4982 test_caps
|= TTY_CAP_ITALIC
;
4986 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4987 if (!UNSPECIFIEDP (val
))
4990 return false; /* ttys can't use colored underlines */
4991 else if (EQ (CAR_SAFE (val
), QCstyle
) && EQ (CAR_SAFE (CDR_SAFE (val
)), Qwave
))
4992 return false; /* ttys can't use wave underlines */
4993 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4994 return false; /* same as default */
4996 test_caps
|= TTY_CAP_UNDERLINE
;
5000 val
= attrs
[LFACE_INVERSE_INDEX
];
5001 if (!UNSPECIFIEDP (val
))
5003 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
5004 return false; /* same as default */
5006 test_caps
|= TTY_CAP_INVERSE
;
5010 /* Color testing. */
5012 /* Check if foreground color is close enough. */
5013 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5016 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
5018 if (face_attr_equal_p (fg
, def_fg
))
5019 return false; /* same as default */
5020 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5021 return false; /* not a valid color */
5022 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5023 > TTY_SAME_COLOR_THRESHOLD
)
5024 return false; /* displayed color is too different */
5026 /* Make sure the color is really different than the default. */
5028 XColor def_fg_color
;
5029 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5030 && (color_distance (&fg_tty_color
, &def_fg_color
)
5031 <= TTY_SAME_COLOR_THRESHOLD
))
5036 /* Check if background color is close enough. */
5037 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5040 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5042 if (face_attr_equal_p (bg
, def_bg
))
5043 return false; /* same as default */
5044 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5045 return false; /* not a valid color */
5046 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5047 > TTY_SAME_COLOR_THRESHOLD
)
5048 return false; /* displayed color is too different */
5050 /* Make sure the color is really different than the default. */
5052 XColor def_bg_color
;
5053 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5054 && (color_distance (&bg_tty_color
, &def_bg_color
)
5055 <= TTY_SAME_COLOR_THRESHOLD
))
5060 /* If both foreground and background are requested, see if the
5061 distance between them is OK. We just check to see if the distance
5062 between the tty's foreground and background is close enough to the
5063 distance between the standard foreground and background. */
5064 if (STRINGP (fg
) && STRINGP (bg
))
5067 = (color_distance (&fg_std_color
, &bg_std_color
)
5068 - color_distance (&fg_tty_color
, &bg_tty_color
));
5069 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5070 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5075 /* See if the capabilities we selected above are supported, with the
5077 return tty_capable_p (FRAME_TTY (f
), test_caps
);
5081 DEFUN ("display-supports-face-attributes-p",
5082 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5084 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5085 The optional argument DISPLAY can be a display name, a frame, or
5086 nil (meaning the selected frame's display).
5088 The definition of `supported' is somewhat heuristic, but basically means
5089 that a face containing all the attributes in ATTRIBUTES, when merged
5090 with the default face for display, can be represented in a way that's
5092 (1) different in appearance than the default face, and
5093 (2) `close in spirit' to what the attributes specify, if not exact.
5095 Point (2) implies that a `:weight black' attribute will be satisfied by
5096 any display that can display bold, and a `:foreground \"yellow\"' as long
5097 as it can display a yellowish color, but `:slant italic' will _not_ be
5098 satisfied by the tty display code's automatic substitution of a `dim'
5099 face for italic. */)
5100 (Lisp_Object attributes
, Lisp_Object display
)
5102 bool supports
= false;
5106 struct face
*def_face
;
5107 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5109 if (noninteractive
|| !initialized
)
5110 /* We may not be able to access low-level face information in batch
5111 mode, or before being dumped, and this function is not going to
5112 be very useful in those cases anyway, so just give up. */
5116 frame
= selected_frame
;
5117 else if (FRAMEP (display
))
5121 /* Find any frame on DISPLAY. */
5125 FOR_EACH_FRAME (tail
, frame
)
5126 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5127 XFRAME (frame
)->param_alist
)),
5132 CHECK_LIVE_FRAME (frame
);
5135 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5136 attrs
[i
] = Qunspecified
;
5137 merge_face_ref (NULL
, f
, attributes
, attrs
, true, 0);
5139 def_face
= FACE_FROM_ID_OR_NULL (f
, DEFAULT_FACE_ID
);
5140 if (def_face
== NULL
)
5142 if (! realize_basic_faces (f
))
5143 error ("Cannot realize default face");
5144 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5147 /* Dispatch to the appropriate handler. */
5148 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5149 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5150 #ifdef HAVE_WINDOW_SYSTEM
5152 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5155 return supports
? Qt
: Qnil
;
5159 /***********************************************************************
5161 ***********************************************************************/
5163 DEFUN ("internal-set-font-selection-order",
5164 Finternal_set_font_selection_order
,
5165 Sinternal_set_font_selection_order
, 1, 1, 0,
5166 doc
: /* Set font selection order for face font selection to ORDER.
5167 ORDER must be a list of length 4 containing the symbols `:width',
5168 `:height', `:weight', and `:slant'. Face attributes appearing
5169 first in ORDER are matched first, e.g. if `:height' appears before
5170 `:weight' in ORDER, font selection first tries to find a font with
5171 a suitable height, and then tries to match the font weight.
5177 int indices
[ARRAYELTS (font_sort_order
)];
5180 memset (indices
, 0, sizeof indices
);
5184 CONSP (list
) && i
< ARRAYELTS (indices
);
5185 list
= XCDR (list
), ++i
)
5187 Lisp_Object attr
= XCAR (list
);
5190 if (EQ (attr
, QCwidth
))
5192 else if (EQ (attr
, QCheight
))
5193 xlfd
= XLFD_POINT_SIZE
;
5194 else if (EQ (attr
, QCweight
))
5196 else if (EQ (attr
, QCslant
))
5201 if (indices
[i
] != 0)
5206 if (!NILP (list
) || i
!= ARRAYELTS (indices
))
5207 signal_error ("Invalid font sort order", order
);
5208 for (i
= 0; i
< ARRAYELTS (font_sort_order
); ++i
)
5209 if (indices
[i
] == 0)
5210 signal_error ("Invalid font sort order", order
);
5212 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5214 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5215 free_all_realized_faces (Qnil
);
5218 font_update_sort_order (font_sort_order
);
5224 DEFUN ("internal-set-alternative-font-family-alist",
5225 Finternal_set_alternative_font_family_alist
,
5226 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5227 doc
: /* Define alternative font families to try in face font selection.
5228 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5229 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5230 be found. Value is ALIST. */)
5233 Lisp_Object entry
, tail
, tail2
;
5236 alist
= Fcopy_sequence (alist
);
5237 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5239 entry
= XCAR (tail
);
5241 entry
= Fcopy_sequence (entry
);
5242 XSETCAR (tail
, entry
);
5243 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5244 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5247 Vface_alternative_font_family_alist
= alist
;
5248 free_all_realized_faces (Qnil
);
5253 DEFUN ("internal-set-alternative-font-registry-alist",
5254 Finternal_set_alternative_font_registry_alist
,
5255 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5256 doc
: /* Define alternative font registries to try in face font selection.
5257 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5258 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5259 be found. Value is ALIST. */)
5262 Lisp_Object entry
, tail
, tail2
;
5265 alist
= Fcopy_sequence (alist
);
5266 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5268 entry
= XCAR (tail
);
5270 entry
= Fcopy_sequence (entry
);
5271 XSETCAR (tail
, entry
);
5272 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5273 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5275 Vface_alternative_font_registry_alist
= alist
;
5276 free_all_realized_faces (Qnil
);
5281 #ifdef HAVE_WINDOW_SYSTEM
5283 /* Return the fontset id of the base fontset name or alias name given
5284 by the fontset attribute of ATTRS. Value is -1 if the fontset
5285 attribute of ATTRS doesn't name a fontset. */
5288 face_fontset (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5292 name
= attrs
[LFACE_FONTSET_INDEX
];
5293 if (!STRINGP (name
))
5295 return fs_query_fontset (name
, 0);
5298 #endif /* HAVE_WINDOW_SYSTEM */
5302 /***********************************************************************
5304 ***********************************************************************/
5306 /* Realize basic faces on frame F. Value is zero if frame parameters
5307 of F don't contain enough information needed to realize the default
5311 realize_basic_faces (struct frame
*f
)
5313 bool success_p
= false;
5315 /* Block input here so that we won't be surprised by an X expose
5316 event, for instance, without having the faces set up. */
5319 if (realize_default_face (f
))
5321 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5322 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5323 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5324 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5325 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5326 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5327 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5328 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5329 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5330 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5331 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5332 realize_named_face (f
, Qwindow_divider
, WINDOW_DIVIDER_FACE_ID
);
5333 realize_named_face (f
, Qwindow_divider_first_pixel
,
5334 WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID
);
5335 realize_named_face (f
, Qwindow_divider_last_pixel
,
5336 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID
);
5337 realize_named_face (f
, Qinternal_border
, INTERNAL_BORDER_FACE_ID
);
5339 /* Reflect changes in the `menu' face in menu bars. */
5340 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5342 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= false;
5343 #ifdef USE_X_TOOLKIT
5344 if (FRAME_WINDOW_P (f
))
5345 x_update_menu_appearance (f
);
5357 /* Realize the default face on frame F. If the face is not fully
5358 specified, make it fully-specified. Attributes of the default face
5359 that are not explicitly specified are taken from frame parameters. */
5362 realize_default_face (struct frame
*f
)
5364 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5366 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5368 /* If the `default' face is not yet known, create it. */
5369 lface
= lface_from_face_name (f
, Qdefault
, false);
5373 XSETFRAME (frame
, f
);
5374 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5377 #ifdef HAVE_WINDOW_SYSTEM
5378 if (FRAME_WINDOW_P (f
))
5380 Lisp_Object font_object
;
5382 XSETFONT (font_object
, FRAME_FONT (f
));
5383 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5384 ASET (lface
, LFACE_FONTSET_INDEX
, fontset_name (FRAME_FONTSET (f
)));
5385 f
->default_face_done_p
= true;
5387 #endif /* HAVE_WINDOW_SYSTEM */
5389 if (!FRAME_WINDOW_P (f
))
5391 ASET (lface
, LFACE_FAMILY_INDEX
, build_string ("default"));
5392 ASET (lface
, LFACE_FOUNDRY_INDEX
, LFACE_FAMILY (lface
));
5393 ASET (lface
, LFACE_SWIDTH_INDEX
, Qnormal
);
5394 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (1));
5395 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5396 ASET (lface
, LFACE_WEIGHT_INDEX
, Qnormal
);
5397 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5398 ASET (lface
, LFACE_SLANT_INDEX
, Qnormal
);
5399 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5400 ASET (lface
, LFACE_FONTSET_INDEX
, Qnil
);
5403 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5404 ASET (lface
, LFACE_UNDERLINE_INDEX
, Qnil
);
5406 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5407 ASET (lface
, LFACE_OVERLINE_INDEX
, Qnil
);
5409 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5410 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, Qnil
);
5412 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5413 ASET (lface
, LFACE_BOX_INDEX
, Qnil
);
5415 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5416 ASET (lface
, LFACE_INVERSE_INDEX
, Qnil
);
5418 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5420 /* This function is called so early that colors are not yet
5421 set in the frame parameter list. */
5422 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5424 if (CONSP (color
) && STRINGP (XCDR (color
)))
5425 ASET (lface
, LFACE_FOREGROUND_INDEX
, XCDR (color
));
5426 else if (FRAME_WINDOW_P (f
))
5428 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5429 ASET (lface
, LFACE_FOREGROUND_INDEX
, build_string (unspecified_fg
));
5434 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5436 /* This function is called so early that colors are not yet
5437 set in the frame parameter list. */
5438 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5439 if (CONSP (color
) && STRINGP (XCDR (color
)))
5440 ASET (lface
, LFACE_BACKGROUND_INDEX
, XCDR (color
));
5441 else if (FRAME_WINDOW_P (f
))
5443 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5444 ASET (lface
, LFACE_BACKGROUND_INDEX
, build_string (unspecified_bg
));
5449 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5450 ASET (lface
, LFACE_STIPPLE_INDEX
, Qnil
);
5452 /* Realize the face; it must be fully-specified now. */
5453 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5454 check_lface (lface
);
5455 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5456 struct face
*face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5458 #ifndef HAVE_WINDOW_SYSTEM
5461 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5463 /* This can happen when making a frame on a display that does
5464 not support the default font. */
5468 /* Otherwise, the font specified for the frame was not
5469 acceptable as a font for the default face (perhaps because
5470 auto-scaled fonts are rejected), so we must adjust the frame
5472 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5479 /* Realize basic faces other than the default face in face cache C.
5480 SYMBOL is the face name, ID is the face id the realized face must
5481 have. The default face must have been realized already. */
5484 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5486 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5487 Lisp_Object lface
= lface_from_face_name (f
, symbol
, false);
5488 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5489 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5491 /* The default face must exist and be fully specified. */
5492 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, true);
5493 check_lface_attrs (attrs
);
5494 eassert (lface_fully_specified_p (attrs
));
5496 /* If SYMBOL isn't know as a face, create it. */
5500 XSETFRAME (frame
, f
);
5501 lface
= Finternal_make_lisp_face (symbol
, frame
);
5504 /* Merge SYMBOL's face with the default face. */
5505 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, true);
5506 merge_face_vectors (NULL
, f
, symbol_attrs
, attrs
, 0);
5508 /* Realize the face. */
5509 realize_face (c
, attrs
, id
);
5513 /* Realize the fully-specified face with attributes ATTRS in face
5514 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5515 non-negative, it is an ID of face to remove before caching the new
5516 face. Value is a pointer to the newly created realized face. */
5518 static struct face
*
5519 realize_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
5524 /* LFACE must be fully specified. */
5525 eassert (cache
!= NULL
);
5526 check_lface_attrs (attrs
);
5528 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5530 /* Remove the former face. */
5531 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5532 uncache_face (cache
, former_face
);
5533 free_realized_face (cache
->f
, former_face
);
5534 SET_FRAME_GARBAGED (cache
->f
);
5537 if (FRAME_WINDOW_P (cache
->f
))
5538 face
= realize_x_face (cache
, attrs
);
5539 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5540 face
= realize_tty_face (cache
, attrs
);
5541 else if (FRAME_INITIAL_P (cache
->f
))
5543 /* Create a dummy face. */
5544 face
= make_realized_face (attrs
);
5549 /* Insert the new face. */
5550 cache_face (cache
, face
, lface_hash (attrs
));
5555 #ifdef HAVE_WINDOW_SYSTEM
5556 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5557 same attributes as BASE_FACE except for the font on frame F.
5558 FONT-OBJECT may be nil, in which case, realized a face of
5561 static struct face
*
5562 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5563 struct face
*base_face
)
5565 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5568 face
= xmalloc (sizeof *face
);
5572 = (! NILP (font_object
)
5573 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5574 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5576 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5577 face
->colors_copied_bitwise_p
= true;
5578 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5581 cache_face (cache
, face
, face
->hash
);
5585 #endif /* HAVE_WINDOW_SYSTEM */
5588 /* Realize the fully-specified face with attributes ATTRS in face
5589 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5590 the new face doesn't share font with the default face, a fontname
5591 is allocated from the heap and set in `font_name' of the new face,
5592 but it is not yet loaded here. Value is a pointer to the newly
5593 created realized face. */
5595 static struct face
*
5596 realize_x_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5598 struct face
*face
= NULL
;
5599 #ifdef HAVE_WINDOW_SYSTEM
5600 struct face
*default_face
;
5602 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5604 eassert (FRAME_WINDOW_P (cache
->f
));
5606 /* Allocate a new realized face. */
5607 face
= make_realized_face (attrs
);
5608 face
->ascii_face
= face
;
5612 /* Determine the font to use. Most of the time, the font will be
5613 the same as the font of the default face, so try that first. */
5614 default_face
= FACE_FROM_ID_OR_NULL (f
, DEFAULT_FACE_ID
);
5616 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5618 face
->font
= default_face
->font
;
5620 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5624 /* If the face attribute ATTRS specifies a fontset, use it as
5625 the base of a new realized fontset. Otherwise, use the same
5626 base fontset as of the default face. The base determines
5627 registry and encoding of a font. It may also determine
5628 foundry and family. The other fields of font name pattern
5629 are constructed from ATTRS. */
5630 int fontset
= face_fontset (attrs
);
5632 /* If we are realizing the default face, ATTRS should specify a
5633 fontset. In other words, if FONTSET is -1, we are not
5634 realizing the default face, thus the default face should have
5635 already been realized. */
5639 fontset
= default_face
->fontset
;
5643 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5644 attrs
[LFACE_FONT_INDEX
]
5645 = font_load_for_lface (f
, attrs
, Ffont_spec (0, NULL
));
5646 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5648 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5649 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5659 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5660 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5661 face
->overstrike
= true;
5663 /* Load colors, and set remaining attributes. */
5665 load_face_colors (f
, face
, attrs
);
5668 box
= attrs
[LFACE_BOX_INDEX
];
5671 /* A simple box of line width 1 drawn in color given by
5673 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5675 face
->box
= FACE_SIMPLE_BOX
;
5676 face
->box_line_width
= 1;
5678 else if (INTEGERP (box
))
5680 /* Simple box of specified line width in foreground color of the
5682 eassert (XINT (box
) != 0);
5683 face
->box
= FACE_SIMPLE_BOX
;
5684 face
->box_line_width
= XINT (box
);
5685 face
->box_color
= face
->foreground
;
5686 face
->box_color_defaulted_p
= true;
5688 else if (CONSP (box
))
5690 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5691 being one of `raised' or `sunken'. */
5692 face
->box
= FACE_SIMPLE_BOX
;
5693 face
->box_color
= face
->foreground
;
5694 face
->box_color_defaulted_p
= true;
5695 face
->box_line_width
= 1;
5699 Lisp_Object keyword
, value
;
5701 keyword
= XCAR (box
);
5709 if (EQ (keyword
, QCline_width
))
5711 if (INTEGERP (value
) && XINT (value
) != 0)
5712 face
->box_line_width
= XINT (value
);
5714 else if (EQ (keyword
, QCcolor
))
5716 if (STRINGP (value
))
5718 face
->box_color
= load_color (f
, face
, value
,
5720 face
->use_box_color_for_shadows_p
= true;
5723 else if (EQ (keyword
, QCstyle
))
5725 if (EQ (value
, Qreleased_button
))
5726 face
->box
= FACE_RAISED_BOX
;
5727 else if (EQ (value
, Qpressed_button
))
5728 face
->box
= FACE_SUNKEN_BOX
;
5733 /* Text underline, overline, strike-through. */
5735 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5736 if (EQ (underline
, Qt
))
5738 /* Use default color (same as foreground color). */
5739 face
->underline_p
= true;
5740 face
->underline_type
= FACE_UNDER_LINE
;
5741 face
->underline_defaulted_p
= true;
5742 face
->underline_color
= 0;
5744 else if (STRINGP (underline
))
5746 /* Use specified color. */
5747 face
->underline_p
= true;
5748 face
->underline_type
= FACE_UNDER_LINE
;
5749 face
->underline_defaulted_p
= false;
5750 face
->underline_color
5751 = load_color (f
, face
, underline
,
5752 LFACE_UNDERLINE_INDEX
);
5754 else if (NILP (underline
))
5756 face
->underline_p
= false;
5757 face
->underline_defaulted_p
= false;
5758 face
->underline_color
= 0;
5760 else if (CONSP (underline
))
5762 /* `(:color COLOR :style STYLE)'.
5763 STYLE being one of `line' or `wave'. */
5764 face
->underline_p
= true;
5765 face
->underline_color
= 0;
5766 face
->underline_defaulted_p
= true;
5767 face
->underline_type
= FACE_UNDER_LINE
;
5769 /* FIXME? This is also not robust about checking the precise form.
5770 See comments in Finternal_set_lisp_face_attribute. */
5771 while (CONSP (underline
))
5773 Lisp_Object keyword
, value
;
5775 keyword
= XCAR (underline
);
5776 underline
= XCDR (underline
);
5778 if (!CONSP (underline
))
5780 value
= XCAR (underline
);
5781 underline
= XCDR (underline
);
5783 if (EQ (keyword
, QCcolor
))
5785 if (EQ (value
, Qforeground_color
))
5787 face
->underline_defaulted_p
= true;
5788 face
->underline_color
= 0;
5790 else if (STRINGP (value
))
5792 face
->underline_defaulted_p
= false;
5793 face
->underline_color
= load_color (f
, face
, value
,
5794 LFACE_UNDERLINE_INDEX
);
5797 else if (EQ (keyword
, QCstyle
))
5799 if (EQ (value
, Qline
))
5800 face
->underline_type
= FACE_UNDER_LINE
;
5801 else if (EQ (value
, Qwave
))
5802 face
->underline_type
= FACE_UNDER_WAVE
;
5807 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5808 if (STRINGP (overline
))
5810 face
->overline_color
5811 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5812 LFACE_OVERLINE_INDEX
);
5813 face
->overline_p
= true;
5815 else if (EQ (overline
, Qt
))
5817 face
->overline_color
= face
->foreground
;
5818 face
->overline_color_defaulted_p
= true;
5819 face
->overline_p
= true;
5822 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5823 if (STRINGP (strike_through
))
5825 face
->strike_through_color
5826 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5827 LFACE_STRIKE_THROUGH_INDEX
);
5828 face
->strike_through_p
= true;
5830 else if (EQ (strike_through
, Qt
))
5832 face
->strike_through_color
= face
->foreground
;
5833 face
->strike_through_color_defaulted_p
= true;
5834 face
->strike_through_p
= true;
5837 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5838 if (!NILP (stipple
))
5839 face
->stipple
= load_pixmap (f
, stipple
);
5840 #endif /* HAVE_WINDOW_SYSTEM */
5846 /* Map a specified color of face FACE on frame F to a tty color index.
5847 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5848 specifies which color to map. Set *DEFAULTED to true if mapping to the
5849 default foreground/background colors. */
5852 map_tty_color (struct frame
*f
, struct face
*face
,
5853 enum lface_attribute_index idx
, bool *defaulted
)
5855 Lisp_Object frame
, color
, def
;
5856 bool foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5857 unsigned long default_pixel
=
5858 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5859 unsigned long pixel
= default_pixel
;
5861 unsigned long default_other_pixel
=
5862 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5865 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5867 XSETFRAME (frame
, f
);
5868 color
= face
->lface
[idx
];
5872 && CONSP (Vtty_defined_color_alist
)
5873 && (def
= assoc_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5876 /* Associations in tty-defined-color-alist are of the form
5877 (NAME INDEX R G B). We need the INDEX part. */
5878 pixel
= XINT (XCAR (XCDR (def
)));
5881 if (pixel
== default_pixel
&& STRINGP (color
))
5883 pixel
= load_color (f
, face
, color
, idx
);
5886 /* If the foreground of the default face is the default color,
5887 use the foreground color defined by the frame. */
5888 if (FRAME_MSDOS_P (f
))
5890 if (pixel
== default_pixel
5891 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5894 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5896 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5897 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5900 else if (pixel
== default_other_pixel
)
5903 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5905 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5906 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5914 face
->foreground
= pixel
;
5916 face
->background
= pixel
;
5920 /* Realize the fully-specified face with attributes ATTRS in face
5921 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5922 Value is a pointer to the newly created realized face. */
5924 static struct face
*
5925 realize_tty_face (struct face_cache
*cache
,
5926 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5930 bool face_colors_defaulted
= false;
5931 struct frame
*f
= cache
->f
;
5933 /* Frame must be a termcap frame. */
5934 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5936 /* Allocate a new realized face. */
5937 face
= make_realized_face (attrs
);
5939 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5942 /* Map face attributes to TTY appearances. */
5943 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5944 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5946 face
->tty_bold_p
= true;
5948 face
->tty_italic_p
= true;
5949 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5950 face
->tty_underline_p
= true;
5951 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5952 face
->tty_reverse_p
= true;
5954 /* Map color names to color indices. */
5955 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5956 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5958 /* Swap colors if face is inverse-video. If the colors are taken
5959 from the frame colors, they are already inverted, since the
5960 frame-creation function calls x-handle-reverse-video. */
5961 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5963 unsigned long tem
= face
->foreground
;
5964 face
->foreground
= face
->background
;
5965 face
->background
= tem
;
5968 if (tty_suppress_bold_inverse_default_colors_p
5970 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5971 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5972 face
->tty_bold_p
= false;
5978 DEFUN ("tty-suppress-bold-inverse-default-colors",
5979 Ftty_suppress_bold_inverse_default_colors
,
5980 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5981 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5982 SUPPRESS non-nil means suppress it.
5983 This affects bold faces on TTYs whose foreground is the default background
5984 color of the display and whose background is the default foreground color.
5985 For such faces, the bold face attribute is ignored if this variable
5987 (Lisp_Object suppress
)
5989 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5996 /***********************************************************************
5998 ***********************************************************************/
6000 /* Return the ID of the face to use to display character CH with face
6001 property PROP on frame F in current_buffer. */
6004 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
6008 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
6013 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6014 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6018 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6019 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6020 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6021 merge_face_ref (NULL
, f
, prop
, attrs
, true, 0);
6022 face_id
= lookup_face (f
, attrs
);
6028 /* Return the face ID associated with buffer position POS for
6029 displaying ASCII characters. Return in *ENDPTR the position at
6030 which a different face is needed, as far as text properties and
6031 overlays are concerned. W is a window displaying current_buffer.
6033 REGION_BEG, REGION_END delimit the region, so it can be
6036 LIMIT is a position not to scan beyond. That is to limit the time
6037 this function can take.
6039 If MOUSE, use the character's mouse-face, not its face, and only
6040 consider the highest-priority source of mouse-face at POS,
6041 i.e. don't merge different mouse-face values if more than one
6042 source specifies it.
6044 BASE_FACE_ID, if non-negative, specifies a base face id to use
6045 instead of DEFAULT_FACE_ID.
6047 The face returned is suitable for displaying ASCII characters. */
6050 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
6051 ptrdiff_t *endptr
, ptrdiff_t limit
,
6052 bool mouse
, int base_face_id
)
6054 struct frame
*f
= XFRAME (w
->frame
);
6055 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6056 Lisp_Object prop
, position
;
6057 ptrdiff_t i
, noverlays
;
6058 Lisp_Object
*overlay_vec
;
6060 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6061 Lisp_Object limit1
, end
;
6062 struct face
*default_face
;
6064 /* W must display the current buffer. We could write this function
6065 to use the frame and buffer of W, but right now it doesn't. */
6066 /* eassert (XBUFFER (w->contents) == current_buffer); */
6068 XSETFASTINT (position
, pos
);
6072 /* Get the `face' or `mouse_face' text property at POS, and
6073 determine the next position at which the property changes. */
6074 prop
= Fget_text_property (position
, propname
, w
->contents
);
6075 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6076 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
6078 endpos
= XINT (end
);
6080 /* Look at properties from overlays. */
6083 ptrdiff_t next_overlay
;
6085 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, false);
6086 if (next_overlay
< endpos
)
6087 endpos
= next_overlay
;
6095 if (base_face_id
>= 0)
6096 face_id
= base_face_id
;
6097 else if (NILP (Vface_remapping_alist
))
6098 face_id
= DEFAULT_FACE_ID
;
6100 face_id
= lookup_basic_face (w
, f
, DEFAULT_FACE_ID
);
6102 default_face
= FACE_FROM_ID (f
, face_id
);
6105 /* Optimize common cases where we can use the default face. */
6110 return default_face
->id
;
6113 /* Begin with attributes from the default face. */
6114 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6116 /* Merge in attributes specified via text properties. */
6118 merge_face_ref (w
, f
, prop
, attrs
, true, 0);
6120 /* Now merge the overlay data. */
6121 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6122 /* For mouse-face, we need only the single highest-priority face
6123 from the overlays, if any. */
6126 for (prop
= Qnil
, i
= noverlays
- 1; i
>= 0 && NILP (prop
); --i
)
6131 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6134 /* Overlays always take priority over text properties,
6135 so discard the mouse-face text property, if any, and
6136 use the overlay property instead. */
6137 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6138 merge_face_ref (w
, f
, prop
, attrs
, true, 0);
6141 oend
= OVERLAY_END (overlay_vec
[i
]);
6142 oendpos
= OVERLAY_POSITION (oend
);
6143 if (oendpos
< endpos
)
6149 for (i
= 0; i
< noverlays
; i
++)
6154 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6156 merge_face_ref (w
, f
, prop
, attrs
, true, 0);
6158 oend
= OVERLAY_END (overlay_vec
[i
]);
6159 oendpos
= OVERLAY_POSITION (oend
);
6160 if (oendpos
< endpos
)
6169 /* Look up a realized face with the given face attributes,
6170 or realize a new one for ASCII characters. */
6171 return lookup_face (f
, attrs
);
6174 /* Return the face ID at buffer position POS for displaying ASCII
6175 characters associated with overlay strings for overlay OVERLAY.
6177 Like face_at_buffer_position except for OVERLAY. Currently it
6178 simply disregards the `face' properties of all overlays. */
6181 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6182 ptrdiff_t *endptr
, ptrdiff_t limit
,
6183 bool mouse
, Lisp_Object overlay
)
6185 struct frame
*f
= XFRAME (w
->frame
);
6186 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6187 Lisp_Object prop
, position
;
6189 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6190 Lisp_Object limit1
, end
;
6191 struct face
*default_face
;
6193 /* W must display the current buffer. We could write this function
6194 to use the frame and buffer of W, but right now it doesn't. */
6195 /* eassert (XBUFFER (w->contents) == current_buffer); */
6197 XSETFASTINT (position
, pos
);
6201 /* Get the `face' or `mouse_face' text property at POS, and
6202 determine the next position at which the property changes. */
6203 prop
= Fget_text_property (position
, propname
, w
->contents
);
6204 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6205 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
6207 endpos
= XINT (end
);
6211 /* Optimize common case where we can use the default face. */
6213 && NILP (Vface_remapping_alist
))
6214 return DEFAULT_FACE_ID
;
6216 /* Begin with attributes from the default face. */
6217 default_face
= FACE_FROM_ID (f
, lookup_basic_face (w
, f
, DEFAULT_FACE_ID
));
6218 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6220 /* Merge in attributes specified via text properties. */
6222 merge_face_ref (w
, f
, prop
, attrs
, true, 0);
6226 /* Look up a realized face with the given face attributes,
6227 or realize a new one for ASCII characters. */
6228 return lookup_face (f
, attrs
);
6232 /* Compute the face at character position POS in Lisp string STRING on
6233 window W, for ASCII characters.
6235 If STRING is an overlay string, it comes from position BUFPOS in
6236 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6237 not an overlay string. W must display the current buffer.
6238 REGION_BEG and REGION_END give the start and end positions of the
6239 region; both are -1 if no region is visible.
6241 BASE_FACE_ID is the id of a face to merge with. For strings coming
6242 from overlays or the `display' property it is the face at BUFPOS.
6244 If MOUSE_P, use the character's mouse-face, not its face.
6246 Set *ENDPTR to the next position where to check for faces in
6247 STRING; -1 if the face is constant from POS to the end of the
6250 Value is the id of the face to use. The face returned is suitable
6251 for displaying ASCII characters. */
6254 face_at_string_position (struct window
*w
, Lisp_Object string
,
6255 ptrdiff_t pos
, ptrdiff_t bufpos
,
6256 ptrdiff_t *endptr
, enum face_id base_face_id
,
6259 Lisp_Object prop
, position
, end
, limit
;
6260 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6261 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6262 struct face
*base_face
;
6263 bool multibyte_p
= STRING_MULTIBYTE (string
);
6264 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6266 /* Get the value of the face property at the current position within
6267 STRING. Value is nil if there is no face property. */
6268 XSETFASTINT (position
, pos
);
6269 prop
= Fget_text_property (position
, prop_name
, string
);
6271 /* Get the next position at which to check for faces. Value of end
6272 is nil if face is constant all the way to the end of the string.
6273 Otherwise it is a string position where to check faces next.
6274 Limit is the maximum position up to which to check for property
6275 changes in Fnext_single_property_change. Strings are usually
6276 short, so set the limit to the end of the string. */
6277 XSETFASTINT (limit
, SCHARS (string
));
6278 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6280 *endptr
= XFASTINT (end
);
6284 base_face
= FACE_FROM_ID (f
, base_face_id
);
6286 /* Optimize the default case that there is no face property. */
6289 /* We can't realize faces for different charsets differently
6290 if we don't have fonts, so we can stop here if not working
6291 on a window-system frame. */
6292 || !FRAME_WINDOW_P (f
)
6293 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
)))
6294 return base_face
->id
;
6296 /* Begin with attributes from the base face. */
6297 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6299 /* Merge in attributes specified via text properties. */
6301 merge_face_ref (w
, f
, prop
, attrs
, true, 0);
6303 /* Look up a realized face with the given face attributes,
6304 or realize a new one for ASCII characters. */
6305 return lookup_face (f
, attrs
);
6309 /* Merge a face into a realized face.
6311 W is a window in the frame where faces are (to be) realized.
6313 FACE_NAME is named face to merge.
6315 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6317 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6319 BASE_FACE_ID is realized face to merge into.
6325 merge_faces (struct window
*w
, Lisp_Object face_name
, int face_id
,
6328 struct frame
*f
= WINDOW_XFRAME (w
);
6329 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6330 struct face
*base_face
;
6332 base_face
= FACE_FROM_ID_OR_NULL (f
, base_face_id
);
6334 return base_face_id
;
6336 if (EQ (face_name
, Qt
))
6338 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6339 return base_face_id
;
6340 face_name
= lface_id_to_name
[face_id
];
6341 /* When called during make-frame, lookup_derived_face may fail
6342 if the faces are uninitialized. Don't signal an error. */
6343 face_id
= lookup_derived_face (w
, f
, face_name
, base_face_id
, 0);
6344 return (face_id
>= 0 ? face_id
: base_face_id
);
6347 /* Begin with attributes from the base face. */
6348 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6350 if (!NILP (face_name
))
6352 if (!merge_named_face (w
, f
, face_name
, attrs
, 0))
6353 return base_face_id
;
6359 return base_face_id
;
6360 face
= FACE_FROM_ID_OR_NULL (f
, face_id
);
6362 return base_face_id
;
6363 merge_face_vectors (w
, f
, face
->lface
, attrs
, 0);
6366 /* Look up a realized face with the given face attributes,
6367 or realize a new one for ASCII characters. */
6368 return lookup_face (f
, attrs
);
6373 #ifndef HAVE_X_WINDOWS
6374 DEFUN ("x-load-color-file", Fx_load_color_file
,
6375 Sx_load_color_file
, 1, 1, 0,
6376 doc
: /* Create an alist of color entries from an external file.
6378 The file should define one named RGB color per line like so:
6380 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6381 (Lisp_Object filename
)
6384 Lisp_Object cmap
= Qnil
;
6385 Lisp_Object abspath
;
6387 CHECK_STRING (filename
);
6388 abspath
= Fexpand_file_name (filename
, Qnil
);
6391 fp
= emacs_fopen (SSDATA (abspath
), "r" FOPEN_TEXT
);
6395 int red
, green
, blue
;
6398 while (fgets_unlocked (buf
, sizeof (buf
), fp
) != NULL
) {
6399 if (sscanf (buf
, "%d %d %d %n", &red
, &green
, &blue
, &num
) == 3)
6402 int color
= RGB (red
, green
, blue
);
6404 int color
= (red
<< 16) | (green
<< 8) | blue
;
6406 char *name
= buf
+ num
;
6407 ptrdiff_t len
= strlen (name
);
6408 len
-= 0 < len
&& name
[len
- 1] == '\n';
6409 cmap
= Fcons (Fcons (make_string (name
, len
), make_number (color
)),
6421 /***********************************************************************
6423 ***********************************************************************/
6427 /* Print the contents of the realized face FACE to stderr. */
6430 dump_realized_face (struct face
*face
)
6432 fprintf (stderr
, "ID: %d\n", face
->id
);
6433 #ifdef HAVE_X_WINDOWS
6434 fprintf (stderr
, "gc: %p\n", face
->gc
);
6436 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6438 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6439 fprintf (stderr
, "background: 0x%lx (%s)\n",
6441 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6443 fprintf (stderr
, "font_name: %s (%s)\n",
6444 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6445 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6446 #ifdef HAVE_X_WINDOWS
6447 fprintf (stderr
, "font = %p\n", face
->font
);
6449 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6450 fprintf (stderr
, "underline: %d (%s)\n",
6452 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6453 fprintf (stderr
, "hash: %u\n", face
->hash
);
6457 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6464 fprintf (stderr
, "font selection order: ");
6465 for (i
= 0; i
< ARRAYELTS (font_sort_order
); ++i
)
6466 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6467 fprintf (stderr
, "\n");
6469 fprintf (stderr
, "alternative fonts: ");
6470 debug_print (Vface_alternative_font_family_alist
);
6471 fprintf (stderr
, "\n");
6473 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6474 Fdump_face (make_number (i
));
6480 face
= FACE_FROM_ID_OR_NULL (SELECTED_FRAME (), XINT (n
));
6482 error ("Not a valid face");
6483 dump_realized_face (face
);
6490 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6491 0, 0, 0, doc
: /* */)
6494 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6495 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6496 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6500 #endif /* GLYPH_DEBUG */
6504 /***********************************************************************
6506 ***********************************************************************/
6509 syms_of_xfaces (void)
6511 /* The symbols `face' and `mouse-face' used as text properties. */
6512 DEFSYM (Qface
, "face");
6514 /* Property for basic faces which other faces cannot inherit. */
6515 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6517 /* Error symbol for wrong_type_argument in load_pixmap. */
6518 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6520 /* The name of the function to call when the background of the frame
6521 has changed, frame_set_background_mode. */
6522 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6524 /* Lisp face attribute keywords. */
6525 DEFSYM (QCfamily
, ":family");
6526 DEFSYM (QCheight
, ":height");
6527 DEFSYM (QCweight
, ":weight");
6528 DEFSYM (QCslant
, ":slant");
6529 DEFSYM (QCunderline
, ":underline");
6530 DEFSYM (QCinverse_video
, ":inverse-video");
6531 DEFSYM (QCreverse_video
, ":reverse-video");
6532 DEFSYM (QCforeground
, ":foreground");
6533 DEFSYM (QCbackground
, ":background");
6534 DEFSYM (QCstipple
, ":stipple");
6535 DEFSYM (QCwidth
, ":width");
6536 DEFSYM (QCfont
, ":font");
6537 DEFSYM (QCfontset
, ":fontset");
6538 DEFSYM (QCdistant_foreground
, ":distant-foreground");
6539 DEFSYM (QCbold
, ":bold");
6540 DEFSYM (QCitalic
, ":italic");
6541 DEFSYM (QCoverline
, ":overline");
6542 DEFSYM (QCstrike_through
, ":strike-through");
6543 DEFSYM (QCbox
, ":box");
6544 DEFSYM (QCinherit
, ":inherit");
6546 /* Symbols used for Lisp face attribute values. */
6547 DEFSYM (QCcolor
, ":color");
6548 DEFSYM (QCline_width
, ":line-width");
6549 DEFSYM (QCstyle
, ":style");
6550 DEFSYM (Qline
, "line");
6551 DEFSYM (Qwave
, "wave");
6552 DEFSYM (Qreleased_button
, "released-button");
6553 DEFSYM (Qpressed_button
, "pressed-button");
6554 DEFSYM (Qnormal
, "normal");
6555 DEFSYM (Qextra_light
, "extra-light");
6556 DEFSYM (Qlight
, "light");
6557 DEFSYM (Qsemi_light
, "semi-light");
6558 DEFSYM (Qsemi_bold
, "semi-bold");
6559 DEFSYM (Qbold
, "bold");
6560 DEFSYM (Qextra_bold
, "extra-bold");
6561 DEFSYM (Qultra_bold
, "ultra-bold");
6562 DEFSYM (Qoblique
, "oblique");
6563 DEFSYM (Qitalic
, "italic");
6565 /* The symbols `foreground-color' and `background-color' which can be
6566 used as part of a `face' property. This is for compatibility with
6568 DEFSYM (Qbackground_color
, "background-color");
6569 DEFSYM (Qforeground_color
, "foreground-color");
6571 DEFSYM (Qunspecified
, "unspecified");
6572 DEFSYM (QCignore_defface
, ":ignore-defface");
6574 /* Used for limiting character attributes to windows with specific
6576 DEFSYM (QCwindow
, ":window");
6577 DEFSYM (QCfiltered
, ":filtered");
6579 /* The symbol `face-alias'. A symbol having that property is an
6580 alias for another face. Value of the property is the name of
6581 the aliased face. */
6582 DEFSYM (Qface_alias
, "face-alias");
6584 /* Names of basic faces. */
6585 DEFSYM (Qdefault
, "default");
6586 DEFSYM (Qtool_bar
, "tool-bar");
6587 DEFSYM (Qfringe
, "fringe");
6588 DEFSYM (Qheader_line
, "header-line");
6589 DEFSYM (Qscroll_bar
, "scroll-bar");
6590 DEFSYM (Qmenu
, "menu");
6591 DEFSYM (Qcursor
, "cursor");
6592 DEFSYM (Qborder
, "border");
6593 DEFSYM (Qmouse
, "mouse");
6594 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6595 DEFSYM (Qvertical_border
, "vertical-border");
6596 DEFSYM (Qwindow_divider
, "window-divider");
6597 DEFSYM (Qwindow_divider_first_pixel
, "window-divider-first-pixel");
6598 DEFSYM (Qwindow_divider_last_pixel
, "window-divider-last-pixel");
6599 DEFSYM (Qinternal_border
, "internal-border");
6601 /* TTY color-related functions (defined in tty-colors.el). */
6602 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6603 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6604 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6606 /* The name of the function used to compute colors on TTYs. */
6607 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6609 Vparam_value_alist
= list1 (Fcons (Qnil
, Qnil
));
6610 staticpro (&Vparam_value_alist
);
6611 Vface_alternative_font_family_alist
= Qnil
;
6612 staticpro (&Vface_alternative_font_family_alist
);
6613 Vface_alternative_font_registry_alist
= Qnil
;
6614 staticpro (&Vface_alternative_font_registry_alist
);
6616 defsubr (&Sinternal_make_lisp_face
);
6617 defsubr (&Sinternal_lisp_face_p
);
6618 defsubr (&Sinternal_set_lisp_face_attribute
);
6619 #ifdef HAVE_WINDOW_SYSTEM
6620 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6622 defsubr (&Scolor_gray_p
);
6623 defsubr (&Scolor_supported_p
);
6624 #ifndef HAVE_X_WINDOWS
6625 defsubr (&Sx_load_color_file
);
6627 defsubr (&Sface_attribute_relative_p
);
6628 defsubr (&Smerge_face_attribute
);
6629 defsubr (&Sinternal_get_lisp_face_attribute
);
6630 defsubr (&Sinternal_lisp_face_attribute_values
);
6631 defsubr (&Sinternal_lisp_face_equal_p
);
6632 defsubr (&Sinternal_lisp_face_empty_p
);
6633 defsubr (&Sinternal_copy_lisp_face
);
6634 defsubr (&Sinternal_merge_in_global_face
);
6635 defsubr (&Sface_font
);
6636 defsubr (&Sframe_face_alist
);
6637 defsubr (&Sdisplay_supports_face_attributes_p
);
6638 defsubr (&Scolor_distance
);
6639 defsubr (&Sinternal_set_font_selection_order
);
6640 defsubr (&Sinternal_set_alternative_font_family_alist
);
6641 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6642 defsubr (&Sface_attributes_as_vector
);
6644 defsubr (&Sdump_face
);
6645 defsubr (&Sshow_face_resources
);
6646 #endif /* GLYPH_DEBUG */
6647 defsubr (&Sclear_face_cache
);
6648 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6650 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6651 defsubr (&Sdump_colors
);
6654 DEFVAR_BOOL ("face-filters-always-match", face_filters_always_match
,
6655 doc
: /* Non-nil means that face filters are always deemed to match.
6656 This variable is intended for use only by code that evaluates
6657 the "specifity" of a face specification and should be let-bound
6658 only for this purpose. */);
6660 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6661 doc
: /* List of global face definitions (for internal use only.) */);
6662 Vface_new_frame_defaults
= Qnil
;
6664 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6665 doc
: /* Default stipple pattern used on monochrome displays.
6666 This stipple pattern is used on monochrome displays
6667 instead of shades of gray for a face background color.
6668 See `set-face-stipple' for possible values for this variable. */);
6669 Vface_default_stipple
= build_pure_c_string ("gray3");
6671 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6672 doc
: /* An alist of defined terminal colors and their RGB values.
6673 See the docstring of `tty-color-alist' for the details. */);
6674 Vtty_defined_color_alist
= Qnil
;
6676 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6677 doc
: /* Allowed scalable fonts.
6678 A value of nil means don't allow any scalable fonts.
6679 A value of t means allow any scalable font.
6680 Otherwise, value must be a list of regular expressions. A font may be
6681 scaled if its name matches a regular expression in the list.
6682 Note that if value is nil, a scalable font might still be used, if no
6683 other font of the appropriate family and registry is available. */);
6684 Vscalable_fonts_allowed
= Qnil
;
6686 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6687 doc
: /* List of ignored fonts.
6688 Each element is a regular expression that matches names of fonts to
6690 #ifdef HAVE_OTF_KANNADA_BUG
6691 /* https://debbugs.gnu.org/30193 */
6692 Vface_ignored_fonts
= list1 (build_string ("Noto Serif Kannada"));
6694 Vface_ignored_fonts
= Qnil
;
6697 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6698 doc
: /* Alist of face remappings.
6699 Each element is of the form:
6701 (FACE . REPLACEMENT),
6703 which causes display of the face FACE to use REPLACEMENT instead.
6704 REPLACEMENT is a face specification, i.e. one of the following:
6707 (2) a property list of attribute/value pairs, or
6708 (3) a list in which each element has one of the above forms.
6710 List values for REPLACEMENT are merged to form the final face
6711 specification, with earlier entries taking precedence, in the same way
6712 as with the `face' text property.
6714 Face-name remapping cycles are suppressed; recursive references use
6715 the underlying face instead of the remapped face. So a remapping of
6718 (FACE EXTRA-FACE... FACE)
6722 (FACE (FACE-ATTR VAL ...) FACE)
6724 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6725 existing definition of FACE. Note that this isn't necessary for the
6726 default face, since every face inherits from the default face.
6728 An entry in the list can also be a filtered face expression of the
6731 (:filtered FILTER FACE-SPECIFICATION)
6733 This construct applies FACE-SPECIFICATION (which can have any of the
6734 forms allowed for face specifications generally) only if FILTER
6735 matches at the moment Emacs wants to draw text with the combined face.
6737 The only filters currently defined are NIL (which always matches) and
6738 (:window PARAMETER VALUE), which matches only in the context of a
6739 window with a parameter EQ-equal to VALUE.
6741 An entry in the face list can also be nil, which does nothing.
6743 If `face-remapping-alist' is made buffer-local, the face remapping
6744 takes effect only in that buffer. For instance, the mode my-mode
6745 could define a face `my-mode-default', and then in the mode setup
6748 (set (make-local-variable \\='face-remapping-alist)
6749 \\='((default my-mode-default)))).
6751 You probably want to use the face-remap package included in Emacs
6752 instead of manipulating face-remapping-alist directly.
6754 Because Emacs normally only redraws screen areas when the underlying
6755 buffer contents change, you may need to call `redraw-display' after
6756 changing this variable for it to take effect. */);
6757 Vface_remapping_alist
= Qnil
;
6759 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6760 doc
: /* Alist of fonts vs the rescaling factors.
6761 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6762 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6763 RESCALE-RATIO is a floating point number to specify how much larger
6764 \(or smaller) font we should use. For instance, if a face requests
6765 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6766 Vface_font_rescale_alist
= Qnil
;
6768 #ifdef HAVE_WINDOW_SYSTEM
6769 defsubr (&Sbitmap_spec_p
);
6770 defsubr (&Sx_list_fonts
);
6771 defsubr (&Sinternal_face_x_get_resource
);
6772 defsubr (&Sx_family_fonts
);