1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2013 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
24 When using Emacs with X, the display style of characters can be
25 changed by defining `faces'. Each face can specify the following
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 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. */
203 #include "sysstdio.h"
204 #include <sys/types.h>
205 #include <sys/stat.h>
208 #include "character.h"
210 #include "keyboard.h"
212 #include "termhooks.h"
216 #include <Xm/XmStrDefs.h>
217 #endif /* USE_MOTIF */
223 #ifdef HAVE_WINDOW_SYSTEM
227 #define x_display_info w32_display_info
228 #define GCGraphicsExposures 0
229 #endif /* HAVE_NTGUI */
232 #define GCGraphicsExposures 0
234 #endif /* HAVE_WINDOW_SYSTEM */
237 #include "dispextern.h"
238 #include "blockinput.h"
240 #include "intervals.h"
241 #include "termchar.h"
245 #ifdef HAVE_X_WINDOWS
247 /* Compensate for a bug in Xos.h on some systems, on which it requires
248 time.h. On some such systems, Xos.h tries to redefine struct
249 timeval and struct timezone if USG is #defined while it is
252 #ifdef XOS_NEEDS_TIME_H
258 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
260 #else /* not XOS_NEEDS_TIME_H */
262 #endif /* not XOS_NEEDS_TIME_H */
264 #endif /* HAVE_X_WINDOWS */
268 /* Non-zero if face attribute ATTR is unspecified. */
270 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
272 /* Non-zero if face attribute ATTR is `ignore-defface'. */
274 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
276 /* Value is the number of elements of VECTOR. */
278 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
280 /* Size of hash table of realized faces in face caches (should be a
283 #define FACE_CACHE_BUCKETS_SIZE 1001
285 /* Keyword symbols used for face attribute names. */
287 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
288 static Lisp_Object QCunderline
;
289 static Lisp_Object QCinverse_video
, QCstipple
;
290 Lisp_Object QCforeground
, QCbackground
;
292 static Lisp_Object QCfont
, QCbold
, QCitalic
;
293 static Lisp_Object QCreverse_video
;
294 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
295 static Lisp_Object QCfontset
;
297 /* Symbols used for attribute values. */
301 static Lisp_Object Qline
, Qwave
;
302 Lisp_Object Qextra_light
, Qlight
;
303 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
304 Lisp_Object Qoblique
;
306 static Lisp_Object Qreleased_button
, Qpressed_button
;
307 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
308 Lisp_Object Qunspecified
; /* used in dosfns.c */
309 static Lisp_Object QCignore_defface
;
311 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
313 /* The name of the function to call when the background of the frame
314 has changed, frame_set_background_mode. */
316 static Lisp_Object Qframe_set_background_mode
;
318 /* Names of basic faces. */
320 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
321 static Lisp_Object Qregion
;
322 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
323 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
324 Lisp_Object Qmode_line_inactive
;
325 static Lisp_Object Qvertical_border
;
327 /* The symbol `face-alias'. A symbols having that property is an
328 alias for another face. Value of the property is the name of
331 static Lisp_Object Qface_alias
;
333 /* Alist of alternative font families. Each element is of the form
334 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
335 try FAMILY1, then FAMILY2, ... */
337 Lisp_Object Vface_alternative_font_family_alist
;
339 /* Alist of alternative font registries. Each element is of the form
340 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
341 loaded, try REGISTRY1, then REGISTRY2, ... */
343 Lisp_Object Vface_alternative_font_registry_alist
;
345 /* Allowed scalable fonts. A value of nil means don't allow any
346 scalable fonts. A value of t means allow the use of any scalable
347 font. Otherwise, value must be a list of regular expressions. A
348 font may be scaled if its name matches a regular expression in the
351 static Lisp_Object Qscalable_fonts_allowed
;
353 /* The symbols `foreground-color' and `background-color' which can be
354 used as part of a `face' property. This is for compatibility with
357 Lisp_Object Qforeground_color
, Qbackground_color
;
359 /* The symbols `face' and `mouse-face' used as text properties. */
363 /* Property for basic faces which other faces cannot inherit. */
365 static Lisp_Object Qface_no_inherit
;
367 /* Error symbol for wrong_type_argument in load_pixmap. */
369 static Lisp_Object Qbitmap_spec_p
;
371 /* The next ID to assign to Lisp faces. */
373 static int next_lface_id
;
375 /* A vector mapping Lisp face Id's to face names. */
377 static Lisp_Object
*lface_id_to_name
;
378 static ptrdiff_t lface_id_to_name_size
;
380 /* TTY color-related functions (defined in tty-colors.el). */
382 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
384 /* The name of the function used to compute colors on TTYs. */
386 static Lisp_Object Qtty_color_alist
;
388 #ifdef HAVE_WINDOW_SYSTEM
390 /* Counter for calls to clear_face_cache. If this counter reaches
391 CLEAR_FONT_TABLE_COUNT, and a frame has more than
392 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
394 static int clear_font_table_count
;
395 #define CLEAR_FONT_TABLE_COUNT 100
396 #define CLEAR_FONT_TABLE_NFONTS 10
398 #endif /* HAVE_WINDOW_SYSTEM */
400 /* Non-zero means face attributes have been changed since the last
401 redisplay. Used in redisplay_internal. */
403 int face_change_count
;
405 /* Non-zero means don't display bold text if a face's foreground
406 and background colors are the inverse of the default colors of the
407 display. This is a kluge to suppress `bold black' foreground text
408 which is hard to read on an LCD monitor. */
410 static int tty_suppress_bold_inverse_default_colors_p
;
412 /* A list of the form `((x . y))' used to avoid consing in
413 Finternal_set_lisp_face_attribute. */
415 static Lisp_Object Vparam_value_alist
;
417 /* The total number of colors currently allocated. */
420 static int ncolors_allocated
;
421 static int npixmaps_allocated
;
425 /* Non-zero means the definition of the `menu' face for new frames has
428 static int menu_face_changed_default
;
430 struct named_merge_point
;
432 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
434 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
435 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
436 static bool realize_basic_faces (struct frame
*);
437 static bool realize_default_face (struct frame
*);
438 static void realize_named_face (struct frame
*, Lisp_Object
, int);
439 static struct face_cache
*make_face_cache (struct frame
*);
440 static void free_face_cache (struct face_cache
*);
441 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
442 int, struct named_merge_point
*);
444 #ifdef HAVE_WINDOW_SYSTEM
445 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
446 static void clear_face_gcs (struct face_cache
*);
447 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
449 #endif /* HAVE_WINDOW_SYSTEM */
451 /***********************************************************************
453 ***********************************************************************/
455 #ifdef HAVE_X_WINDOWS
457 #ifdef DEBUG_X_COLORS
459 /* The following is a poor mans infrastructure for debugging X color
460 allocation problems on displays with PseudoColor-8. Some X servers
461 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
462 color reference counts completely so that they don't signal an
463 error when a color is freed whose reference count is already 0.
464 Other X servers do. To help me debug this, the following code
465 implements a simple reference counting schema of its own, for a
466 single display/screen. --gerd. */
468 /* Reference counts for pixel colors. */
470 int color_count
[256];
472 /* Register color PIXEL as allocated. */
475 register_color (unsigned long pixel
)
477 eassert (pixel
< 256);
478 ++color_count
[pixel
];
482 /* Register color PIXEL as deallocated. */
485 unregister_color (unsigned long pixel
)
487 eassert (pixel
< 256);
488 if (color_count
[pixel
] > 0)
489 --color_count
[pixel
];
495 /* Register N colors from PIXELS as deallocated. */
498 unregister_colors (unsigned long *pixels
, int n
)
501 for (i
= 0; i
< n
; ++i
)
502 unregister_color (pixels
[i
]);
506 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
507 doc
: /* Dump currently allocated colors to stderr. */)
512 fputc ('\n', stderr
);
514 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
517 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
520 fputc ('\n', stderr
);
522 fputc ('\t', stderr
);
526 fputc ('\n', stderr
);
530 #endif /* DEBUG_X_COLORS */
533 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
534 color values. Interrupt input must be blocked when this function
538 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
540 int class = FRAME_DISPLAY_INFO (f
)->visual
->class;
542 /* If display has an immutable color map, freeing colors is not
543 necessary and some servers don't allow it. So don't do it. */
544 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
546 #ifdef DEBUG_X_COLORS
547 unregister_colors (pixels
, npixels
);
549 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
557 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
558 color values. Interrupt input must be blocked when this function
562 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
563 long unsigned int *pixels
, int npixels
)
565 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
566 int class = dpyinfo
->visual
->class;
568 /* If display has an immutable color map, freeing colors is not
569 necessary and some servers don't allow it. So don't do it. */
570 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
572 #ifdef DEBUG_X_COLORS
573 unregister_colors (pixels
, npixels
);
575 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
578 #endif /* USE_X_TOOLKIT */
580 /* Create and return a GC for use on frame F. GC values and mask
581 are given by XGCV and MASK. */
584 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
588 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
595 /* Free GC which was used on frame F. */
598 x_free_gc (struct frame
*f
, GC gc
)
600 eassert (input_blocked_p ());
601 IF_DEBUG ((--ngcs
, eassert (ngcs
>= 0)));
602 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
605 #endif /* HAVE_X_WINDOWS */
608 /* W32 emulation of GCs */
611 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
615 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
622 /* Free GC which was used on frame F. */
625 x_free_gc (struct frame
*f
, GC gc
)
627 IF_DEBUG ((--ngcs
, eassert (ngcs
>= 0)));
631 #endif /* HAVE_NTGUI */
634 /* NS emulation of GCs */
637 x_create_gc (struct frame
*f
,
641 GC gc
= xmalloc (sizeof *gc
);
647 x_free_gc (struct frame
*f
, GC gc
)
653 /***********************************************************************
655 ***********************************************************************/
657 /* Initialize face cache and basic faces for frame F. */
660 init_frame_faces (struct frame
*f
)
662 /* Make a face cache, if F doesn't have one. */
663 if (FRAME_FACE_CACHE (f
) == NULL
)
664 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
666 #ifdef HAVE_WINDOW_SYSTEM
667 /* Make the image cache. */
668 if (FRAME_WINDOW_P (f
))
670 /* We initialize the image cache when creating the first frame
671 on a terminal, and not during terminal creation. This way,
672 `x-open-connection' on a tty won't create an image cache. */
673 if (FRAME_IMAGE_CACHE (f
) == NULL
)
674 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
675 ++FRAME_IMAGE_CACHE (f
)->refcount
;
677 #endif /* HAVE_WINDOW_SYSTEM */
679 /* Realize basic faces. Must have enough information in frame
680 parameters to realize basic faces at this point. */
681 #ifdef HAVE_X_WINDOWS
682 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
685 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
688 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
690 if (!realize_basic_faces (f
))
695 /* Free face cache of frame F. Called from delete_frame. */
698 free_frame_faces (struct frame
*f
)
700 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
704 free_face_cache (face_cache
);
705 FRAME_FACE_CACHE (f
) = NULL
;
708 #ifdef HAVE_WINDOW_SYSTEM
709 if (FRAME_WINDOW_P (f
))
711 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
714 --image_cache
->refcount
;
715 if (image_cache
->refcount
== 0)
716 free_image_cache (f
);
719 #endif /* HAVE_WINDOW_SYSTEM */
723 /* Clear face caches, and recompute basic faces for frame F. Call
724 this after changing frame parameters on which those faces depend,
725 or when realized faces have been freed due to changing attributes
729 recompute_basic_faces (struct frame
*f
)
731 if (FRAME_FACE_CACHE (f
))
733 clear_face_cache (0);
734 if (!realize_basic_faces (f
))
740 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
741 try to free unused fonts, too. */
744 clear_face_cache (int clear_fonts_p
)
746 #ifdef HAVE_WINDOW_SYSTEM
747 Lisp_Object tail
, frame
;
750 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
752 /* From time to time see if we can unload some fonts. This also
753 frees all realized faces on all frames. Fonts needed by
754 faces will be loaded again when faces are realized again. */
755 clear_font_table_count
= 0;
757 FOR_EACH_FRAME (tail
, frame
)
759 struct frame
*f
= XFRAME (frame
);
760 if (FRAME_WINDOW_P (f
)
761 && FRAME_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
763 clear_font_cache (f
);
764 free_all_realized_faces (frame
);
770 /* Clear GCs of realized faces. */
771 FOR_EACH_FRAME (tail
, frame
)
773 struct frame
*f
= XFRAME (frame
);
774 if (FRAME_WINDOW_P (f
))
775 clear_face_gcs (FRAME_FACE_CACHE (f
));
777 clear_image_caches (Qnil
);
779 #endif /* HAVE_WINDOW_SYSTEM */
783 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
784 doc
: /* Clear face caches on all frames.
785 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
786 (Lisp_Object thoroughly
)
788 clear_face_cache (!NILP (thoroughly
));
790 ++windows_or_buffers_changed
;
795 /***********************************************************************
797 ***********************************************************************/
799 #ifdef HAVE_WINDOW_SYSTEM
801 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
802 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
803 A bitmap specification is either a string, a file name, or a list
804 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
805 HEIGHT is its height, and DATA is a string containing the bits of
806 the pixmap. Bits are stored row by row, each row occupies
807 \(WIDTH + 7)/8 bytes. */)
812 if (STRINGP (object
))
813 /* If OBJECT is a string, it's a file name. */
815 else if (CONSP (object
))
817 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
818 HEIGHT must be ints > 0, and DATA must be string large
819 enough to hold a bitmap of the specified size. */
820 Lisp_Object width
, height
, data
;
822 height
= width
= data
= Qnil
;
826 width
= XCAR (object
);
827 object
= XCDR (object
);
830 height
= XCAR (object
);
831 object
= XCDR (object
);
833 data
= XCAR (object
);
838 && RANGED_INTEGERP (1, width
, INT_MAX
)
839 && RANGED_INTEGERP (1, height
, INT_MAX
))
841 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
843 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
848 return pixmap_p
? Qt
: Qnil
;
852 /* Load a bitmap according to NAME (which is either a file name or a
853 pixmap spec) for use on frame F. Value is the bitmap_id (see
854 xfns.c). If NAME is nil, return with a bitmap id of zero. If
855 bitmap cannot be loaded, display a message saying so, and return
856 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
857 if these pointers are not null. */
860 load_pixmap (struct frame
*f
, Lisp_Object name
, unsigned int *w_ptr
,
868 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
873 /* Decode a bitmap spec into a bitmap. */
878 w
= XINT (Fcar (name
));
879 h
= XINT (Fcar (Fcdr (name
)));
880 bits
= Fcar (Fcdr (Fcdr (name
)));
882 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
887 /* It must be a string -- a file name. */
888 bitmap_id
= x_create_bitmap_from_file (f
, name
);
894 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
905 ++npixmaps_allocated
;
908 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
911 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
917 #endif /* HAVE_WINDOW_SYSTEM */
921 /***********************************************************************
923 ***********************************************************************/
925 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
926 RGB_LIST should contain (at least) 3 lisp integers.
927 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
930 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
932 #define PARSE_RGB_LIST_FIELD(field) \
933 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
935 color->field = XINT (XCAR (rgb_list)); \
936 rgb_list = XCDR (rgb_list); \
941 PARSE_RGB_LIST_FIELD (red
);
942 PARSE_RGB_LIST_FIELD (green
);
943 PARSE_RGB_LIST_FIELD (blue
);
949 /* Lookup on frame F the color described by the lisp string COLOR.
950 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
951 non-zero, then the `standard' definition of the same color is
955 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
958 Lisp_Object frame
, color_desc
;
960 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
963 XSETFRAME (frame
, f
);
965 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
966 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
970 if (! INTEGERP (XCAR (XCDR (color_desc
))))
973 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
975 rgb
= XCDR (XCDR (color_desc
));
976 if (! parse_rgb_list (rgb
, tty_color
))
979 /* Should we fill in STD_COLOR too? */
982 /* Default STD_COLOR to the same as TTY_COLOR. */
983 *std_color
= *tty_color
;
985 /* Do a quick check to see if the returned descriptor is
986 actually _exactly_ equal to COLOR, otherwise we have to
987 lookup STD_COLOR separately. If it's impossible to lookup
988 a standard color, we just give up and use TTY_COLOR. */
989 if ((!STRINGP (XCAR (color_desc
))
990 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
991 && !NILP (Ffboundp (Qtty_color_standard_values
)))
993 /* Look up STD_COLOR separately. */
994 rgb
= call1 (Qtty_color_standard_values
, color
);
995 if (! parse_rgb_list (rgb
, std_color
))
1002 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1003 /* We were called early during startup, and the colors are not
1004 yet set up in tty-defined-color-alist. Don't return a failure
1005 indication, since this produces the annoying "Unable to
1006 load color" messages in the *Messages* buffer. */
1009 /* tty-color-desc seems to have returned a bad value. */
1013 /* A version of defined_color for non-X frames. */
1016 tty_defined_color (struct frame
*f
, const char *color_name
,
1017 XColor
*color_def
, bool alloc
)
1022 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1024 color_def
->blue
= 0;
1025 color_def
->green
= 0;
1028 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1030 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1032 if (strcmp (color_name
, "unspecified-fg") == 0)
1033 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1034 else if (strcmp (color_name
, "unspecified-bg") == 0)
1035 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1038 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1045 /* Decide if color named COLOR_NAME is valid for the display
1046 associated with the frame F; if so, return the rgb values in
1047 COLOR_DEF. If ALLOC, allocate a new colormap cell.
1049 This does the right thing for any type of frame. */
1052 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1055 if (!FRAME_WINDOW_P (f
))
1056 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1057 #ifdef HAVE_X_WINDOWS
1058 else if (FRAME_X_P (f
))
1059 return x_defined_color (f
, color_name
, color_def
, alloc
);
1062 else if (FRAME_W32_P (f
))
1063 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1066 else if (FRAME_NS_P (f
))
1067 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1074 /* Given the index IDX of a tty color on frame F, return its name, a
1078 tty_color_name (struct frame
*f
, int idx
)
1080 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1083 Lisp_Object coldesc
;
1085 XSETFRAME (frame
, f
);
1086 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1088 if (!NILP (coldesc
))
1089 return XCAR (coldesc
);
1092 /* We can have an MSDOG frame under -nw for a short window of
1093 opportunity before internal_terminal_init is called. DTRT. */
1094 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1095 return msdos_stdcolor_name (idx
);
1098 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1099 return build_string (unspecified_fg
);
1100 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1101 return build_string (unspecified_bg
);
1103 return Qunspecified
;
1107 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1110 The criterion implemented here is not a terribly sophisticated one. */
1113 face_color_gray_p (struct frame
*f
, const char *color_name
)
1118 if (defined_color (f
, color_name
, &color
, 0))
1119 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1120 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1122 ((eabs (color
.red
- color
.green
)
1123 < max (color
.red
, color
.green
) / 20)
1124 && (eabs (color
.green
- color
.blue
)
1125 < max (color
.green
, color
.blue
) / 20)
1126 && (eabs (color
.blue
- color
.red
)
1127 < max (color
.blue
, color
.red
) / 20)));
1135 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1136 BACKGROUND_P non-zero means the color will be used as background
1140 face_color_supported_p (struct frame
*f
, const char *color_name
,
1146 XSETFRAME (frame
, f
);
1148 #ifdef HAVE_WINDOW_SYSTEM
1150 ? (!NILP (Fxw_display_color_p (frame
))
1151 || xstrcasecmp (color_name
, "black") == 0
1152 || xstrcasecmp (color_name
, "white") == 0
1154 && face_color_gray_p (f
, color_name
))
1155 || (!NILP (Fx_display_grayscale_p (frame
))
1156 && face_color_gray_p (f
, color_name
)))
1159 tty_defined_color (f
, color_name
, ¬_used
, 0);
1163 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1164 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1165 FRAME specifies the frame and thus the display for interpreting COLOR.
1166 If FRAME is nil or omitted, use the selected frame. */)
1167 (Lisp_Object color
, Lisp_Object frame
)
1169 CHECK_STRING (color
);
1170 return (face_color_gray_p (decode_any_frame (frame
), SSDATA (color
))
1175 DEFUN ("color-supported-p", Fcolor_supported_p
,
1176 Scolor_supported_p
, 1, 3, 0,
1177 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1178 BACKGROUND-P non-nil means COLOR is used as a background.
1179 Otherwise, this function tells whether it can be used as a foreground.
1180 If FRAME is nil or omitted, use the selected frame.
1181 COLOR must be a valid color name. */)
1182 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1184 CHECK_STRING (color
);
1185 return (face_color_supported_p (decode_any_frame (frame
),
1186 SSDATA (color
), !NILP (background_p
))
1191 /* Load color with name NAME for use by face FACE on frame F.
1192 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1193 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1194 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1195 pixel color. If color cannot be loaded, display a message, and
1196 return the foreground, background or underline color of F, but
1197 record that fact in flags of the face so that we don't try to free
1204 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1205 enum lface_attribute_index target_index
)
1209 eassert (STRINGP (name
));
1210 eassert (target_index
== LFACE_FOREGROUND_INDEX
1211 || target_index
== LFACE_BACKGROUND_INDEX
1212 || target_index
== LFACE_UNDERLINE_INDEX
1213 || target_index
== LFACE_OVERLINE_INDEX
1214 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1215 || target_index
== LFACE_BOX_INDEX
);
1217 /* if the color map is full, defined_color will return a best match
1218 to the values in an existing cell. */
1219 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1221 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1223 switch (target_index
)
1225 case LFACE_FOREGROUND_INDEX
:
1226 face
->foreground_defaulted_p
= 1;
1227 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1230 case LFACE_BACKGROUND_INDEX
:
1231 face
->background_defaulted_p
= 1;
1232 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1235 case LFACE_UNDERLINE_INDEX
:
1236 face
->underline_defaulted_p
= 1;
1237 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1240 case LFACE_OVERLINE_INDEX
:
1241 face
->overline_color_defaulted_p
= 1;
1242 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1245 case LFACE_STRIKE_THROUGH_INDEX
:
1246 face
->strike_through_color_defaulted_p
= 1;
1247 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1250 case LFACE_BOX_INDEX
:
1251 face
->box_color_defaulted_p
= 1;
1252 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1261 ++ncolors_allocated
;
1268 #ifdef HAVE_WINDOW_SYSTEM
1270 /* Load colors for face FACE which is used on frame F. Colors are
1271 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1272 of ATTRS. If the background color specified is not supported on F,
1273 try to emulate gray colors with a stipple from Vface_default_stipple. */
1276 load_face_colors (struct frame
*f
, struct face
*face
,
1277 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1281 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1282 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1284 /* Swap colors if face is inverse-video. */
1285 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1293 /* Check for support for foreground, not for background because
1294 face_color_supported_p is smart enough to know that grays are
1295 "supported" as background because we are supposed to use stipple
1297 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1298 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1300 x_destroy_bitmap (f
, face
->stipple
);
1301 face
->stipple
= load_pixmap (f
, Vface_default_stipple
, NULL
, NULL
);
1304 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1305 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1309 /* Free color PIXEL on frame F. */
1312 unload_color (struct frame
*f
, long unsigned int pixel
)
1314 #ifdef HAVE_X_WINDOWS
1318 x_free_colors (f
, &pixel
, 1);
1325 /* Free colors allocated for FACE. */
1328 free_face_colors (struct frame
*f
, struct face
*face
)
1330 /* PENDING(NS): need to do something here? */
1331 #ifdef HAVE_X_WINDOWS
1332 if (face
->colors_copied_bitwise_p
)
1337 if (!face
->foreground_defaulted_p
)
1339 x_free_colors (f
, &face
->foreground
, 1);
1340 IF_DEBUG (--ncolors_allocated
);
1343 if (!face
->background_defaulted_p
)
1345 x_free_colors (f
, &face
->background
, 1);
1346 IF_DEBUG (--ncolors_allocated
);
1349 if (face
->underline_p
1350 && !face
->underline_defaulted_p
)
1352 x_free_colors (f
, &face
->underline_color
, 1);
1353 IF_DEBUG (--ncolors_allocated
);
1356 if (face
->overline_p
1357 && !face
->overline_color_defaulted_p
)
1359 x_free_colors (f
, &face
->overline_color
, 1);
1360 IF_DEBUG (--ncolors_allocated
);
1363 if (face
->strike_through_p
1364 && !face
->strike_through_color_defaulted_p
)
1366 x_free_colors (f
, &face
->strike_through_color
, 1);
1367 IF_DEBUG (--ncolors_allocated
);
1370 if (face
->box
!= FACE_NO_BOX
1371 && !face
->box_color_defaulted_p
)
1373 x_free_colors (f
, &face
->box_color
, 1);
1374 IF_DEBUG (--ncolors_allocated
);
1378 #endif /* HAVE_X_WINDOWS */
1381 #endif /* HAVE_WINDOW_SYSTEM */
1385 /***********************************************************************
1387 ***********************************************************************/
1389 /* An enumerator for each field of an XLFD font name. */
1410 /* An enumerator for each possible slant value of a font. Taken from
1411 the XLFD specification. */
1419 XLFD_SLANT_REVERSE_ITALIC
,
1420 XLFD_SLANT_REVERSE_OBLIQUE
,
1424 /* Relative font weight according to XLFD documentation. */
1428 XLFD_WEIGHT_UNKNOWN
,
1429 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1430 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1431 XLFD_WEIGHT_LIGHT
, /* 30 */
1432 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1433 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1434 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1435 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1436 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1437 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1440 /* Relative proportionate width. */
1444 XLFD_SWIDTH_UNKNOWN
,
1445 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1446 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1447 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1448 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1449 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1450 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1451 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1452 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1453 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1456 /* Order by which font selection chooses fonts. The default values
1457 mean `first, find a best match for the font width, then for the
1458 font height, then for weight, then for slant.' This variable can be
1459 set via set-face-font-sort-order. */
1461 static int font_sort_order
[4];
1463 #ifdef HAVE_WINDOW_SYSTEM
1465 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1468 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1470 Lisp_Object
const *p1
= v1
;
1471 Lisp_Object
const *p2
= v2
;
1472 Lisp_Object font1
= *p1
;
1473 Lisp_Object font2
= *p2
;
1476 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1478 enum font_property_index idx
= font_props_for_sorting
[i
];
1479 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1482 if (idx
<= FONT_REGISTRY_INDEX
)
1485 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1487 result
= STRINGP (val2
) ? 1 : 0;
1491 if (INTEGERP (val1
))
1492 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1493 ? XINT (val1
) > XINT (val2
)
1496 result
= INTEGERP (val2
) ? 1 : 0;
1504 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1505 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1506 If FAMILY is omitted or nil, list all families.
1507 Otherwise, FAMILY must be a string, possibly containing wildcards
1509 If FRAME is omitted or nil, use the selected frame.
1510 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1511 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1512 FAMILY is the font family name. POINT-SIZE is the size of the
1513 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1514 width, weight and slant of the font. These symbols are the same as for
1515 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1516 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1517 giving the registry and encoding of the font.
1518 The result list is sorted according to the current setting of
1519 the face font sort order. */)
1520 (Lisp_Object family
, Lisp_Object frame
)
1522 Lisp_Object font_spec
, list
, *drivers
, vec
;
1523 struct frame
*f
= decode_live_frame (frame
);
1524 ptrdiff_t i
, nfonts
;
1529 font_spec
= Ffont_spec (0, NULL
);
1532 CHECK_STRING (family
);
1533 font_parse_family_registry (family
, Qnil
, font_spec
);
1536 list
= font_list_entities (f
, font_spec
);
1540 /* Sort the font entities. */
1541 for (i
= 0; i
< 4; i
++)
1542 switch (font_sort_order
[i
])
1545 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1546 case XLFD_POINT_SIZE
:
1547 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1549 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1551 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1553 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1554 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1555 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1556 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1558 ndrivers
= XINT (Flength (list
));
1559 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1560 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1561 drivers
[i
] = XCAR (list
);
1562 vec
= Fvconcat (ndrivers
, drivers
);
1563 nfonts
= ASIZE (vec
);
1565 qsort (XVECTOR (vec
)->u
.contents
, nfonts
, word_size
,
1566 compare_fonts_by_sort_order
);
1569 for (i
= nfonts
- 1; i
>= 0; --i
)
1571 Lisp_Object font
= AREF (vec
, i
);
1572 Lisp_Object v
= make_uninit_vector (8);
1574 Lisp_Object spacing
;
1576 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1577 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1578 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1580 ASET (v
, 2, make_number (point
));
1581 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1582 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1583 spacing
= Ffont_get (font
, QCspacing
);
1584 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1585 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1586 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1588 result
= Fcons (v
, result
);
1595 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1596 doc
: /* Return a list of the names of available fonts matching PATTERN.
1597 If optional arguments FACE and FRAME are specified, return only fonts
1598 the same size as FACE on FRAME.
1600 PATTERN should be a string containing a font name in the XLFD,
1601 Fontconfig, or GTK format. A font name given in the XLFD format may
1602 contain wildcard characters:
1603 the * character matches any substring, and
1604 the ? character matches any single character.
1605 PATTERN is case-insensitive.
1607 The return value is a list of strings, suitable as arguments to
1610 Fonts Emacs can't use may or may not be excluded
1611 even if they match PATTERN and FACE.
1612 The optional fourth argument MAXIMUM sets a limit on how many
1613 fonts to match. The first MAXIMUM fonts are reported.
1614 The optional fifth argument WIDTH, if specified, is a number of columns
1615 occupied by a character of a font. In that case, return only fonts
1616 the WIDTH times as wide as FACE on FRAME. */)
1617 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1618 Lisp_Object maximum
, Lisp_Object width
)
1621 int size
, avgwidth
IF_LINT (= 0);
1623 check_window_system (NULL
);
1624 CHECK_STRING (pattern
);
1626 if (! NILP (maximum
))
1627 CHECK_NATNUM (maximum
);
1630 CHECK_NUMBER (width
);
1632 /* We can't simply call decode_window_system_frame because
1633 this function may be called before any frame is created. */
1634 f
= decode_live_frame (frame
);
1635 if (! FRAME_WINDOW_P (f
))
1637 /* Perhaps we have not yet created any frame. */
1643 XSETFRAME (frame
, f
);
1645 /* Determine the width standard for comparison with the fonts we find. */
1651 /* This is of limited utility since it works with character
1652 widths. Keep it for compatibility. --gerd. */
1653 int face_id
= lookup_named_face (f
, face
, 0);
1654 struct face
*width_face
= (face_id
< 0
1656 : FACE_FROM_ID (f
, face_id
));
1658 if (width_face
&& width_face
->font
)
1660 size
= width_face
->font
->pixel_size
;
1661 avgwidth
= width_face
->font
->average_width
;
1665 size
= FRAME_FONT (f
)->pixel_size
;
1666 avgwidth
= FRAME_FONT (f
)->average_width
;
1669 avgwidth
*= XINT (width
);
1673 Lisp_Object font_spec
;
1674 Lisp_Object args
[2], tail
;
1676 font_spec
= font_spec_from_name (pattern
);
1677 if (!FONTP (font_spec
))
1678 signal_error ("Invalid font name", pattern
);
1682 Ffont_put (font_spec
, QCsize
, make_number (size
));
1683 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1685 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1686 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1688 Lisp_Object font_entity
;
1690 font_entity
= XCAR (tail
);
1691 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1692 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1693 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1695 /* This is a scalable font. For backward compatibility,
1696 we set the specified size. */
1697 font_entity
= copy_font_spec (font_entity
);
1698 ASET (font_entity
, FONT_SIZE_INDEX
,
1699 AREF (font_spec
, FONT_SIZE_INDEX
));
1701 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1704 /* We don't have to check fontsets. */
1706 args
[1] = list_fontsets (f
, pattern
, size
);
1707 return Fnconc (2, args
);
1711 #endif /* HAVE_WINDOW_SYSTEM */
1714 /***********************************************************************
1716 ***********************************************************************/
1718 /* Access face attributes of face LFACE, a Lisp vector. */
1720 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1721 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1722 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1723 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1724 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1725 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1726 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1727 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1728 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1729 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1730 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1731 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1732 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1733 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1734 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1735 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1736 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1738 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1739 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1741 #define LFACEP(LFACE) \
1743 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1744 && EQ (AREF (LFACE, 0), Qface))
1749 /* Check consistency of Lisp face attribute vector ATTRS. */
1752 check_lface_attrs (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1754 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1755 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1756 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1757 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1758 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1759 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1760 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1761 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1762 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1763 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1764 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1765 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1766 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1767 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1768 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1769 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1770 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1771 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1772 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1773 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1774 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1775 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1776 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1777 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1778 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1779 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1780 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1781 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1782 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1783 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1784 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1785 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1786 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1787 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1788 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1789 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1790 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1791 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1792 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1793 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1794 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1795 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1796 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1797 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1798 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1799 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1800 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1801 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1802 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1803 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1804 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1805 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1806 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1807 #ifdef HAVE_WINDOW_SYSTEM
1808 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1809 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1810 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1811 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1812 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1813 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1814 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1815 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1816 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1817 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1822 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1825 check_lface (Lisp_Object lface
)
1829 eassert (LFACEP (lface
));
1830 check_lface_attrs (XVECTOR (lface
)->u
.contents
);
1834 #else /* not GLYPH_DEBUG */
1836 #define check_lface_attrs(attrs) (void) 0
1837 #define check_lface(lface) (void) 0
1839 #endif /* GLYPH_DEBUG */
1843 /* Face-merge cycle checking. */
1845 enum named_merge_point_kind
1847 NAMED_MERGE_POINT_NORMAL
,
1848 NAMED_MERGE_POINT_REMAP
1851 /* A `named merge point' is simply a point during face-merging where we
1852 look up a face by name. We keep a stack of which named lookups we're
1853 currently processing so that we can easily detect cycles, using a
1854 linked- list of struct named_merge_point structures, typically
1855 allocated on the stack frame of the named lookup functions which are
1856 active (so no consing is required). */
1857 struct named_merge_point
1859 Lisp_Object face_name
;
1860 enum named_merge_point_kind named_merge_point_kind
;
1861 struct named_merge_point
*prev
;
1865 /* If a face merging cycle is detected for FACE_NAME, return 0,
1866 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1867 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1868 pointed to by NAMED_MERGE_POINTS, and return 1. */
1871 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1872 Lisp_Object face_name
,
1873 enum named_merge_point_kind named_merge_point_kind
,
1874 struct named_merge_point
**named_merge_points
)
1876 struct named_merge_point
*prev
;
1878 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1879 if (EQ (face_name
, prev
->face_name
))
1881 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1882 /* A cycle, so fail. */
1884 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1885 /* A remap `hides ' any previous normal merge points
1886 (because the remap means that it's actually different face),
1887 so as we know the current merge point must be normal, we
1888 can just assume it's OK. */
1892 new_named_merge_point
->face_name
= face_name
;
1893 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1894 new_named_merge_point
->prev
= *named_merge_points
;
1896 *named_merge_points
= new_named_merge_point
;
1902 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1903 to make it a symbol. If FACE_NAME is an alias for another face,
1904 return that face's name.
1906 Return default face in case of errors. */
1909 resolve_face_name (Lisp_Object face_name
, int signal_p
)
1911 Lisp_Object orig_face
;
1912 Lisp_Object tortoise
, hare
;
1914 if (STRINGP (face_name
))
1915 face_name
= intern (SSDATA (face_name
));
1917 if (NILP (face_name
) || !SYMBOLP (face_name
))
1920 orig_face
= face_name
;
1921 tortoise
= hare
= face_name
;
1926 hare
= Fget (hare
, Qface_alias
);
1927 if (NILP (hare
) || !SYMBOLP (hare
))
1931 hare
= Fget (hare
, Qface_alias
);
1932 if (NILP (hare
) || !SYMBOLP (hare
))
1935 tortoise
= Fget (tortoise
, Qface_alias
);
1936 if (EQ (hare
, tortoise
))
1939 xsignal1 (Qcircular_list
, orig_face
);
1948 /* Return the face definition of FACE_NAME on frame F. F null means
1949 return the definition for new frames. FACE_NAME may be a string or
1950 a symbol (apparently Emacs 20.2 allowed strings as face names in
1951 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
1952 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
1953 is zero, value is nil if FACE_NAME is not a valid face name. */
1955 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
1961 lface
= assq_no_quit (face_name
, f
->face_alist
);
1963 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
1966 lface
= XCDR (lface
);
1968 signal_error ("Invalid face", face_name
);
1970 check_lface (lface
);
1975 /* Return the face definition of FACE_NAME on frame F. F null means
1976 return the definition for new frames. FACE_NAME may be a string or
1977 a symbol (apparently Emacs 20.2 allowed strings as face names in
1978 face text properties; Ediff uses that). If FACE_NAME is an alias
1979 for another face, return that face's definition. If SIGNAL_P is
1980 non-zero, signal an error if FACE_NAME is not a valid face name.
1981 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
1984 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
1986 face_name
= resolve_face_name (face_name
, signal_p
);
1987 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
1991 /* Get face attributes of face FACE_NAME from frame-local faces on
1992 frame F. Store the resulting attributes in ATTRS which must point
1993 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
1994 is non-zero, signal an error if FACE_NAME does not name a face.
1995 Otherwise, value is zero if FACE_NAME is not a face. */
1998 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
1999 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
2004 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2007 memcpy (attrs
, XVECTOR (lface
)->u
.contents
,
2008 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2010 return !NILP (lface
);
2013 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2014 F. Store the resulting attributes in ATTRS which must point to a
2015 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2016 alias for another face, use that face's definition. If SIGNAL_P is
2017 non-zero, signal an error if FACE_NAME does not name a face.
2018 Otherwise, value is zero if FACE_NAME is not a face. */
2021 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2022 Lisp_Object attrs
[LFACE_VECTOR_SIZE
], int signal_p
,
2023 struct named_merge_point
*named_merge_points
)
2025 Lisp_Object face_remapping
;
2027 face_name
= resolve_face_name (face_name
, signal_p
);
2029 /* See if SYMBOL has been remapped to some other face (usually this
2030 is done buffer-locally). */
2031 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2032 if (CONSP (face_remapping
))
2034 struct named_merge_point named_merge_point
;
2036 if (push_named_merge_point (&named_merge_point
,
2037 face_name
, NAMED_MERGE_POINT_REMAP
,
2038 &named_merge_points
))
2042 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2043 attrs
[i
] = Qunspecified
;
2045 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2046 signal_p
, named_merge_points
);
2050 /* Default case, no remapping. */
2051 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2055 /* Non-zero if all attributes in face attribute vector ATTRS are
2056 specified, i.e. are non-nil. */
2059 lface_fully_specified_p (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
2063 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2064 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2065 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2068 return i
== LFACE_VECTOR_SIZE
;
2071 #ifdef HAVE_WINDOW_SYSTEM
2073 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2074 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2075 exception is `font' attribute. It is set to FONT_OBJECT regardless
2079 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2080 Lisp_Object font_object
, int force_p
)
2083 struct font
*font
= XFONT_OBJECT (font_object
);
2085 /* Set attributes only if unspecified, otherwise face defaults for
2086 new frames would never take effect. If the font doesn't have a
2087 specific property, set a normal value for that. */
2089 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2091 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2093 ASET (lface
, LFACE_FAMILY_INDEX
, SYMBOL_NAME (family
));
2096 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2098 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2100 ASET (lface
, LFACE_FOUNDRY_INDEX
, SYMBOL_NAME (foundry
));
2103 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2105 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, FRAME_RES_Y (f
));
2108 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (pt
));
2111 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2113 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2114 ASET (lface
, LFACE_WEIGHT_INDEX
, ! NILP (val
) ? val
:Qnormal
);
2116 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2118 val
= FONT_SLANT_FOR_FACE (font_object
);
2119 ASET (lface
, LFACE_SLANT_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2121 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2123 val
= FONT_WIDTH_FOR_FACE (font_object
);
2124 ASET (lface
, LFACE_SWIDTH_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2127 ASET (lface
, LFACE_FONT_INDEX
, font_object
);
2131 #endif /* HAVE_WINDOW_SYSTEM */
2134 /* Merges the face height FROM with the face height TO, and returns the
2135 merged height. If FROM is an invalid height, then INVALID is
2136 returned instead. FROM and TO may be either absolute face heights or
2137 `relative' heights; the returned value is always an absolute height
2138 unless both FROM and TO are relative. */
2141 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2143 Lisp_Object result
= invalid
;
2145 if (INTEGERP (from
))
2146 /* FROM is absolute, just use it as is. */
2148 else if (FLOATP (from
))
2149 /* FROM is a scale, use it to adjust TO. */
2152 /* relative X absolute => absolute */
2153 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2154 else if (FLOATP (to
))
2155 /* relative X relative => relative */
2156 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2157 else if (UNSPECIFIEDP (to
))
2160 else if (FUNCTIONP (from
))
2161 /* FROM is a function, which use to adjust TO. */
2163 /* Call function with current height as argument.
2164 From is the new height. */
2165 result
= safe_call1 (from
, to
);
2167 /* Ensure that if TO was absolute, so is the result. */
2168 if (INTEGERP (to
) && !INTEGERP (result
))
2176 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2177 store the resulting attributes in TO, which must be already be
2178 completely specified and contain only absolute attributes. Every
2179 specified attribute of FROM overrides the corresponding attribute of
2180 TO; relative attributes in FROM are merged with the absolute value in
2181 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2182 loops in face inheritance/remapping; it should be 0 when called from
2186 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2187 struct named_merge_point
*named_merge_points
)
2190 Lisp_Object font
= Qnil
;
2192 /* If FROM inherits from some other faces, merge their attributes into
2193 TO before merging FROM's direct attributes. Note that an :inherit
2194 attribute of `unspecified' is the same as one of nil; we never
2195 merge :inherit attributes, so nil is more correct, but lots of
2196 other code uses `unspecified' as a generic value for face attributes. */
2197 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2198 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2199 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2201 if (FONT_SPEC_P (from
[LFACE_FONT_INDEX
]))
2203 if (!UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2204 font
= merge_font_spec (from
[LFACE_FONT_INDEX
], to
[LFACE_FONT_INDEX
]);
2206 font
= copy_font_spec (from
[LFACE_FONT_INDEX
]);
2207 to
[LFACE_FONT_INDEX
] = font
;
2210 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2211 if (!UNSPECIFIEDP (from
[i
]))
2213 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2215 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2216 font_clear_prop (to
, FONT_SIZE_INDEX
);
2218 else if (i
!= LFACE_FONT_INDEX
&& ! EQ (to
[i
], from
[i
]))
2221 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2222 font_clear_prop (to
,
2223 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2224 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2225 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2226 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2227 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2228 : FONT_SLANT_INDEX
));
2232 /* If FROM specifies a font spec, make its contents take precedence
2233 over :family and other attributes. This is needed for face
2234 remapping using :font to work. */
2238 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
2239 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
));
2240 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
2241 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
));
2242 if (! NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
2243 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (font
);
2244 if (! NILP (AREF (font
, FONT_SLANT_INDEX
)))
2245 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (font
);
2246 if (! NILP (AREF (font
, FONT_WIDTH_INDEX
)))
2247 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (font
);
2248 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2251 /* TO is always an absolute face, which should inherit from nothing.
2252 We blindly copy the :inherit attribute above and fix it up here. */
2253 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2256 /* Merge the named face FACE_NAME on frame F, into the vector of face
2257 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2258 inheritance. Returns true if FACE_NAME is a valid face name and
2259 merging succeeded. */
2262 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2263 struct named_merge_point
*named_merge_points
)
2265 struct named_merge_point named_merge_point
;
2267 if (push_named_merge_point (&named_merge_point
,
2268 face_name
, NAMED_MERGE_POINT_NORMAL
,
2269 &named_merge_points
))
2271 struct gcpro gcpro1
;
2272 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2273 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2277 GCPRO1 (named_merge_point
.face_name
);
2278 merge_face_vectors (f
, from
, to
, named_merge_points
);
2289 /* Merge face attributes from the lisp `face reference' FACE_REF on
2290 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2291 problems with FACE_REF cause an error message to be shown. Return
2292 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2293 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2294 list structure; it may be 0 for most callers.
2296 FACE_REF may be a single face specification or a list of such
2297 specifications. Each face specification can be:
2299 1. A symbol or string naming a Lisp face.
2301 2. A property list of the form (KEYWORD VALUE ...) where each
2302 KEYWORD is a face attribute name, and value is an appropriate value
2305 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2306 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2307 for compatibility with 20.2.
2309 Face specifications earlier in lists take precedence over later
2313 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2314 int err_msgs
, struct named_merge_point
*named_merge_points
)
2316 int ok
= 1; /* Succeed without an error? */
2318 if (CONSP (face_ref
))
2320 Lisp_Object first
= XCAR (face_ref
);
2322 if (EQ (first
, Qforeground_color
)
2323 || EQ (first
, Qbackground_color
))
2325 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2326 . COLOR). COLOR must be a string. */
2327 Lisp_Object color_name
= XCDR (face_ref
);
2328 Lisp_Object color
= first
;
2330 if (STRINGP (color_name
))
2332 if (EQ (color
, Qforeground_color
))
2333 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2335 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2340 add_to_log ("Invalid face color", color_name
, Qnil
);
2344 else if (SYMBOLP (first
)
2345 && *SDATA (SYMBOL_NAME (first
)) == ':')
2347 /* Assume this is the property list form. */
2348 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2350 Lisp_Object keyword
= XCAR (face_ref
);
2351 Lisp_Object value
= XCAR (XCDR (face_ref
));
2354 /* Specifying `unspecified' is a no-op. */
2355 if (EQ (value
, Qunspecified
))
2357 else if (EQ (keyword
, QCfamily
))
2359 if (STRINGP (value
))
2361 to
[LFACE_FAMILY_INDEX
] = value
;
2362 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2367 else if (EQ (keyword
, QCfoundry
))
2369 if (STRINGP (value
))
2371 to
[LFACE_FOUNDRY_INDEX
] = value
;
2372 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2377 else if (EQ (keyword
, QCheight
))
2379 Lisp_Object new_height
=
2380 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2382 if (! NILP (new_height
))
2384 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2385 font_clear_prop (to
, FONT_SIZE_INDEX
);
2390 else if (EQ (keyword
, QCweight
))
2392 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2394 to
[LFACE_WEIGHT_INDEX
] = value
;
2395 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2400 else if (EQ (keyword
, QCslant
))
2402 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2404 to
[LFACE_SLANT_INDEX
] = value
;
2405 font_clear_prop (to
, FONT_SLANT_INDEX
);
2410 else if (EQ (keyword
, QCunderline
))
2416 to
[LFACE_UNDERLINE_INDEX
] = value
;
2420 else if (EQ (keyword
, QCoverline
))
2425 to
[LFACE_OVERLINE_INDEX
] = value
;
2429 else if (EQ (keyword
, QCstrike_through
))
2434 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2438 else if (EQ (keyword
, QCbox
))
2441 value
= make_number (1);
2442 if (INTEGERP (value
)
2446 to
[LFACE_BOX_INDEX
] = value
;
2450 else if (EQ (keyword
, QCinverse_video
)
2451 || EQ (keyword
, QCreverse_video
))
2453 if (EQ (value
, Qt
) || NILP (value
))
2454 to
[LFACE_INVERSE_INDEX
] = value
;
2458 else if (EQ (keyword
, QCforeground
))
2460 if (STRINGP (value
))
2461 to
[LFACE_FOREGROUND_INDEX
] = value
;
2465 else if (EQ (keyword
, QCbackground
))
2467 if (STRINGP (value
))
2468 to
[LFACE_BACKGROUND_INDEX
] = value
;
2472 else if (EQ (keyword
, QCstipple
))
2474 #if defined (HAVE_WINDOW_SYSTEM)
2475 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2476 if (!NILP (pixmap_p
))
2477 to
[LFACE_STIPPLE_INDEX
] = value
;
2480 #endif /* HAVE_WINDOW_SYSTEM */
2482 else if (EQ (keyword
, QCwidth
))
2484 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2486 to
[LFACE_SWIDTH_INDEX
] = value
;
2487 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2492 else if (EQ (keyword
, QCfont
))
2495 to
[LFACE_FONT_INDEX
] = value
;
2499 else if (EQ (keyword
, QCinherit
))
2501 /* This is not really very useful; it's just like a
2502 normal face reference. */
2503 if (! merge_face_ref (f
, value
, to
,
2504 err_msgs
, named_merge_points
))
2512 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2516 face_ref
= XCDR (XCDR (face_ref
));
2521 /* This is a list of face refs. Those at the beginning of the
2522 list take precedence over what follows, so we have to merge
2523 from the end backwards. */
2524 Lisp_Object next
= XCDR (face_ref
);
2527 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2529 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2535 /* FACE_REF ought to be a face name. */
2536 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2537 if (!ok
&& err_msgs
)
2538 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2545 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2546 Sinternal_make_lisp_face
, 1, 2, 0,
2547 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2548 If FACE was not known as a face before, create a new one.
2549 If optional argument FRAME is specified, make a frame-local face
2550 for that frame. Otherwise operate on the global face definition.
2551 Value is a vector of face attributes. */)
2552 (Lisp_Object face
, Lisp_Object frame
)
2554 Lisp_Object global_lface
, lface
;
2558 CHECK_SYMBOL (face
);
2559 global_lface
= lface_from_face_name (NULL
, face
, 0);
2563 CHECK_LIVE_FRAME (frame
);
2565 lface
= lface_from_face_name (f
, face
, 0);
2568 f
= NULL
, lface
= Qnil
;
2570 /* Add a global definition if there is none. */
2571 if (NILP (global_lface
))
2573 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2575 ASET (global_lface
, 0, Qface
);
2576 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2577 Vface_new_frame_defaults
);
2579 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2580 face id to Lisp face is given by the vector lface_id_to_name.
2581 The mapping from Lisp face to Lisp face id is given by the
2582 property `face' of the Lisp face name. */
2583 if (next_lface_id
== lface_id_to_name_size
)
2585 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2586 sizeof *lface_id_to_name
);
2588 lface_id_to_name
[next_lface_id
] = face
;
2589 Fput (face
, Qface
, make_number (next_lface_id
));
2593 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2594 ASET (global_lface
, i
, Qunspecified
);
2596 /* Add a frame-local definition. */
2601 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2603 ASET (lface
, 0, Qface
);
2604 fset_face_alist (f
, Fcons (Fcons (face
, lface
), f
->face_alist
));
2607 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2608 ASET (lface
, i
, Qunspecified
);
2611 lface
= global_lface
;
2613 /* Changing a named face means that all realized faces depending on
2614 that face are invalid. Since we cannot tell which realized faces
2615 depend on the face, make sure they are all removed. This is done
2616 by incrementing face_change_count. The next call to
2617 init_iterator will then free realized faces. */
2618 if (NILP (Fget (face
, Qface_no_inherit
)))
2620 ++face_change_count
;
2621 ++windows_or_buffers_changed
;
2624 eassert (LFACEP (lface
));
2625 check_lface (lface
);
2630 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2631 Sinternal_lisp_face_p
, 1, 2, 0,
2632 doc
: /* Return non-nil if FACE names a face.
2633 FACE should be a symbol or string.
2634 If optional second argument FRAME is non-nil, check for the
2635 existence of a frame-local face with name FACE on that frame.
2636 Otherwise check for the existence of a global face. */)
2637 (Lisp_Object face
, Lisp_Object frame
)
2641 face
= resolve_face_name (face
, 1);
2645 CHECK_LIVE_FRAME (frame
);
2646 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2649 lface
= lface_from_face_name (NULL
, face
, 0);
2655 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2656 Sinternal_copy_lisp_face
, 4, 4, 0,
2657 doc
: /* Copy face FROM to TO.
2658 If FRAME is t, copy the global face definition of FROM.
2659 Otherwise, copy the frame-local definition of FROM on FRAME.
2660 If NEW-FRAME is a frame, copy that data into the frame-local
2661 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2662 FRAME controls where the data is copied to.
2664 The value is TO. */)
2665 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2667 Lisp_Object lface
, copy
;
2669 CHECK_SYMBOL (from
);
2674 /* Copy global definition of FROM. We don't make copies of
2675 strings etc. because 20.2 didn't do it either. */
2676 lface
= lface_from_face_name (NULL
, from
, 1);
2677 copy
= Finternal_make_lisp_face (to
, Qnil
);
2681 /* Copy frame-local definition of FROM. */
2682 if (NILP (new_frame
))
2684 CHECK_LIVE_FRAME (frame
);
2685 CHECK_LIVE_FRAME (new_frame
);
2686 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2687 copy
= Finternal_make_lisp_face (to
, new_frame
);
2690 vcopy (copy
, 0, XVECTOR (lface
)->u
.contents
, LFACE_VECTOR_SIZE
);
2692 /* Changing a named face means that all realized faces depending on
2693 that face are invalid. Since we cannot tell which realized faces
2694 depend on the face, make sure they are all removed. This is done
2695 by incrementing face_change_count. The next call to
2696 init_iterator will then free realized faces. */
2697 if (NILP (Fget (to
, Qface_no_inherit
)))
2699 ++face_change_count
;
2700 ++windows_or_buffers_changed
;
2707 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2708 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2709 doc
: /* Set attribute ATTR of FACE to VALUE.
2710 FRAME being a frame means change the face on that frame.
2711 FRAME nil means change the face of the selected frame.
2712 FRAME t means change the default for new frames.
2713 FRAME 0 means change the face on all frames, and change the default
2715 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2718 Lisp_Object old_value
= Qnil
;
2719 /* Set one of enum font_property_index (> 0) if ATTR is one of
2720 font-related attributes other than QCfont and QCfontset. */
2721 enum font_property_index prop_index
= 0;
2723 CHECK_SYMBOL (face
);
2724 CHECK_SYMBOL (attr
);
2726 face
= resolve_face_name (face
, 1);
2728 /* If FRAME is 0, change face on all frames, and change the
2729 default for new frames. */
2730 if (INTEGERP (frame
) && XINT (frame
) == 0)
2733 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2734 FOR_EACH_FRAME (tail
, frame
)
2735 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2739 /* Set lface to the Lisp attribute vector of FACE. */
2742 lface
= lface_from_face_name (NULL
, face
, 1);
2744 /* When updating face-new-frame-defaults, we put :ignore-defface
2745 where the caller wants `unspecified'. This forces the frame
2746 defaults to ignore the defface value. Otherwise, the defface
2747 will take effect, which is generally not what is intended.
2748 The value of that attribute will be inherited from some other
2749 face during face merging. See internal_merge_in_global_face. */
2750 if (UNSPECIFIEDP (value
))
2751 value
= QCignore_defface
;
2756 frame
= selected_frame
;
2758 CHECK_LIVE_FRAME (frame
);
2759 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2761 /* If a frame-local face doesn't exist yet, create one. */
2763 lface
= Finternal_make_lisp_face (face
, frame
);
2766 if (EQ (attr
, QCfamily
))
2768 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2770 CHECK_STRING (value
);
2771 if (SCHARS (value
) == 0)
2772 signal_error ("Invalid face family", value
);
2774 old_value
= LFACE_FAMILY (lface
);
2775 ASET (lface
, LFACE_FAMILY_INDEX
, value
);
2776 prop_index
= FONT_FAMILY_INDEX
;
2778 else if (EQ (attr
, QCfoundry
))
2780 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2782 CHECK_STRING (value
);
2783 if (SCHARS (value
) == 0)
2784 signal_error ("Invalid face foundry", value
);
2786 old_value
= LFACE_FOUNDRY (lface
);
2787 ASET (lface
, LFACE_FOUNDRY_INDEX
, value
);
2788 prop_index
= FONT_FOUNDRY_INDEX
;
2790 else if (EQ (attr
, QCheight
))
2792 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2794 if (EQ (face
, Qdefault
))
2796 /* The default face must have an absolute size. */
2797 if (!INTEGERP (value
) || XINT (value
) <= 0)
2798 signal_error ("Default face height not absolute and positive",
2803 /* For non-default faces, do a test merge with a random
2804 height to see if VALUE's ok. */
2805 Lisp_Object test
= merge_face_heights (value
,
2808 if (!INTEGERP (test
) || XINT (test
) <= 0)
2809 signal_error ("Face height does not produce a positive integer",
2814 old_value
= LFACE_HEIGHT (lface
);
2815 ASET (lface
, LFACE_HEIGHT_INDEX
, value
);
2816 prop_index
= FONT_SIZE_INDEX
;
2818 else if (EQ (attr
, QCweight
))
2820 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2822 CHECK_SYMBOL (value
);
2823 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2824 signal_error ("Invalid face weight", value
);
2826 old_value
= LFACE_WEIGHT (lface
);
2827 ASET (lface
, LFACE_WEIGHT_INDEX
, value
);
2828 prop_index
= FONT_WEIGHT_INDEX
;
2830 else if (EQ (attr
, QCslant
))
2832 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2834 CHECK_SYMBOL (value
);
2835 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2836 signal_error ("Invalid face slant", value
);
2838 old_value
= LFACE_SLANT (lface
);
2839 ASET (lface
, LFACE_SLANT_INDEX
, value
);
2840 prop_index
= FONT_SLANT_INDEX
;
2842 else if (EQ (attr
, QCunderline
))
2846 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2848 else if (NILP (value
) || EQ (value
, Qt
))
2850 else if (STRINGP (value
) && SCHARS (value
) > 0)
2852 else if (CONSP (value
))
2854 Lisp_Object key
, val
, list
;
2857 /* FIXME? This errs on the side of acceptance. Eg it accepts:
2858 (defface foo '((t :underline 'foo) "doc")
2859 Maybe this is intentional, maybe it isn't.
2860 Non-nil symbols other than t are not documented as being valid.
2861 Eg compare with inverse-video, which explicitly rejects them.
2865 while (!NILP (CAR_SAFE(list
)))
2867 key
= CAR_SAFE (list
);
2868 list
= CDR_SAFE (list
);
2869 val
= CAR_SAFE (list
);
2870 list
= CDR_SAFE (list
);
2872 if (NILP (key
) || NILP (val
))
2878 else if (EQ (key
, QCcolor
)
2879 && !(EQ (val
, Qforeground_color
)
2880 || (STRINGP (val
) && SCHARS (val
) > 0)))
2886 else if (EQ (key
, QCstyle
)
2887 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2896 signal_error ("Invalid face underline", value
);
2898 old_value
= LFACE_UNDERLINE (lface
);
2899 ASET (lface
, LFACE_UNDERLINE_INDEX
, value
);
2901 else if (EQ (attr
, QCoverline
))
2903 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2904 if ((SYMBOLP (value
)
2906 && !EQ (value
, Qnil
))
2907 /* Overline color. */
2909 && SCHARS (value
) == 0))
2910 signal_error ("Invalid face overline", value
);
2912 old_value
= LFACE_OVERLINE (lface
);
2913 ASET (lface
, LFACE_OVERLINE_INDEX
, value
);
2915 else if (EQ (attr
, QCstrike_through
))
2917 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2918 if ((SYMBOLP (value
)
2920 && !EQ (value
, Qnil
))
2921 /* Strike-through color. */
2923 && SCHARS (value
) == 0))
2924 signal_error ("Invalid face strike-through", value
);
2926 old_value
= LFACE_STRIKE_THROUGH (lface
);
2927 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, value
);
2929 else if (EQ (attr
, QCbox
))
2933 /* Allow t meaning a simple box of width 1 in foreground color
2936 value
= make_number (1);
2938 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2940 else if (NILP (value
))
2942 else if (INTEGERP (value
))
2943 valid_p
= XINT (value
) != 0;
2944 else if (STRINGP (value
))
2945 valid_p
= SCHARS (value
) > 0;
2946 else if (CONSP (value
))
2962 if (EQ (k
, QCline_width
))
2964 if (!INTEGERP (v
) || XINT (v
) == 0)
2967 else if (EQ (k
, QCcolor
))
2969 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
2972 else if (EQ (k
, QCstyle
))
2974 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
2981 valid_p
= NILP (tem
);
2987 signal_error ("Invalid face box", value
);
2989 old_value
= LFACE_BOX (lface
);
2990 ASET (lface
, LFACE_BOX_INDEX
, value
);
2992 else if (EQ (attr
, QCinverse_video
)
2993 || EQ (attr
, QCreverse_video
))
2995 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2997 CHECK_SYMBOL (value
);
2998 if (!EQ (value
, Qt
) && !NILP (value
))
2999 signal_error ("Invalid inverse-video face attribute value", value
);
3001 old_value
= LFACE_INVERSE (lface
);
3002 ASET (lface
, LFACE_INVERSE_INDEX
, value
);
3004 else if (EQ (attr
, QCforeground
))
3006 /* Compatibility with 20.x. */
3008 value
= Qunspecified
;
3009 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3011 /* Don't check for valid color names here because it depends
3012 on the frame (display) whether the color will be valid
3013 when the face is realized. */
3014 CHECK_STRING (value
);
3015 if (SCHARS (value
) == 0)
3016 signal_error ("Empty foreground color value", value
);
3018 old_value
= LFACE_FOREGROUND (lface
);
3019 ASET (lface
, LFACE_FOREGROUND_INDEX
, value
);
3021 else if (EQ (attr
, QCbackground
))
3023 /* Compatibility with 20.x. */
3025 value
= Qunspecified
;
3026 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3028 /* Don't check for valid color names here because it depends
3029 on the frame (display) whether the color will be valid
3030 when the face is realized. */
3031 CHECK_STRING (value
);
3032 if (SCHARS (value
) == 0)
3033 signal_error ("Empty background color value", value
);
3035 old_value
= LFACE_BACKGROUND (lface
);
3036 ASET (lface
, LFACE_BACKGROUND_INDEX
, value
);
3038 else if (EQ (attr
, QCstipple
))
3040 #if defined (HAVE_WINDOW_SYSTEM)
3041 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3043 && NILP (Fbitmap_spec_p (value
)))
3044 signal_error ("Invalid stipple attribute", value
);
3045 old_value
= LFACE_STIPPLE (lface
);
3046 ASET (lface
, LFACE_STIPPLE_INDEX
, value
);
3047 #endif /* HAVE_WINDOW_SYSTEM */
3049 else if (EQ (attr
, QCwidth
))
3051 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3053 CHECK_SYMBOL (value
);
3054 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3055 signal_error ("Invalid face width", value
);
3057 old_value
= LFACE_SWIDTH (lface
);
3058 ASET (lface
, LFACE_SWIDTH_INDEX
, value
);
3059 prop_index
= FONT_WIDTH_INDEX
;
3061 else if (EQ (attr
, QCfont
))
3063 #ifdef HAVE_WINDOW_SYSTEM
3064 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3066 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3070 old_value
= LFACE_FONT (lface
);
3071 if (! FONTP (value
))
3073 if (STRINGP (value
))
3075 Lisp_Object name
= value
;
3076 int fontset
= fs_query_fontset (name
, 0);
3079 name
= fontset_ascii (fontset
);
3080 value
= font_spec_from_name (name
);
3082 signal_error ("Invalid font name", name
);
3085 signal_error ("Invalid font or font-spec", value
);
3088 f
= XFRAME (selected_frame
);
3091 if (! FONT_OBJECT_P (value
))
3093 Lisp_Object
*attrs
= XVECTOR (lface
)->u
.contents
;
3094 Lisp_Object font_object
;
3096 font_object
= font_load_for_lface (f
, attrs
, value
);
3097 if (NILP (font_object
))
3098 signal_error ("Font not available", value
);
3099 value
= font_object
;
3101 set_lface_from_font (f
, lface
, value
, 1);
3104 ASET (lface
, LFACE_FONT_INDEX
, value
);
3106 #endif /* HAVE_WINDOW_SYSTEM */
3108 else if (EQ (attr
, QCfontset
))
3110 #ifdef HAVE_WINDOW_SYSTEM
3111 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3115 old_value
= LFACE_FONTSET (lface
);
3116 tmp
= Fquery_fontset (value
, Qnil
);
3118 signal_error ("Invalid fontset name", value
);
3119 ASET (lface
, LFACE_FONTSET_INDEX
, value
= tmp
);
3121 #endif /* HAVE_WINDOW_SYSTEM */
3123 else if (EQ (attr
, QCinherit
))
3126 if (SYMBOLP (value
))
3129 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3130 if (!SYMBOLP (XCAR (tail
)))
3133 ASET (lface
, LFACE_INHERIT_INDEX
, value
);
3135 signal_error ("Invalid face inheritance", value
);
3137 else if (EQ (attr
, QCbold
))
3139 old_value
= LFACE_WEIGHT (lface
);
3140 ASET (lface
, LFACE_WEIGHT_INDEX
, NILP (value
) ? Qnormal
: Qbold
);
3141 prop_index
= FONT_WEIGHT_INDEX
;
3143 else if (EQ (attr
, QCitalic
))
3146 old_value
= LFACE_SLANT (lface
);
3147 ASET (lface
, LFACE_SLANT_INDEX
, NILP (value
) ? Qnormal
: Qitalic
);
3148 prop_index
= FONT_SLANT_INDEX
;
3151 signal_error ("Invalid face attribute name", attr
);
3155 /* If a font-related attribute other than QCfont and QCfontset
3156 is specified, and if the original QCfont attribute has a font
3157 (font-spec or font-object), set the corresponding property in
3158 the font to nil so that the font selector doesn't think that
3159 the attribute is mandatory. Also, clear the average
3161 font_clear_prop (XVECTOR (lface
)->u
.contents
, prop_index
);
3164 /* Changing a named face means that all realized faces depending on
3165 that face are invalid. Since we cannot tell which realized faces
3166 depend on the face, make sure they are all removed. This is done
3167 by incrementing face_change_count. The next call to
3168 init_iterator will then free realized faces. */
3170 && NILP (Fget (face
, Qface_no_inherit
))
3171 && NILP (Fequal (old_value
, value
)))
3173 ++face_change_count
;
3174 ++windows_or_buffers_changed
;
3177 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3178 && NILP (Fequal (old_value
, value
)))
3184 if (EQ (face
, Qdefault
))
3186 #ifdef HAVE_WINDOW_SYSTEM
3187 /* Changed font-related attributes of the `default' face are
3188 reflected in changed `font' frame parameters. */
3190 && (prop_index
|| EQ (attr
, QCfont
))
3191 && lface_fully_specified_p (XVECTOR (lface
)->u
.contents
))
3192 set_font_frame_param (frame
, lface
);
3194 #endif /* HAVE_WINDOW_SYSTEM */
3196 if (EQ (attr
, QCforeground
))
3197 param
= Qforeground_color
;
3198 else if (EQ (attr
, QCbackground
))
3199 param
= Qbackground_color
;
3201 #ifdef HAVE_WINDOW_SYSTEM
3203 else if (EQ (face
, Qscroll_bar
))
3205 /* Changing the colors of `scroll-bar' sets frame parameters
3206 `scroll-bar-foreground' and `scroll-bar-background'. */
3207 if (EQ (attr
, QCforeground
))
3208 param
= Qscroll_bar_foreground
;
3209 else if (EQ (attr
, QCbackground
))
3210 param
= Qscroll_bar_background
;
3212 #endif /* not HAVE_NTGUI */
3213 else if (EQ (face
, Qborder
))
3215 /* Changing background color of `border' sets frame parameter
3217 if (EQ (attr
, QCbackground
))
3218 param
= Qborder_color
;
3220 else if (EQ (face
, Qcursor
))
3222 /* Changing background color of `cursor' sets frame parameter
3224 if (EQ (attr
, QCbackground
))
3225 param
= Qcursor_color
;
3227 else if (EQ (face
, Qmouse
))
3229 /* Changing background color of `mouse' sets frame parameter
3231 if (EQ (attr
, QCbackground
))
3232 param
= Qmouse_color
;
3234 #endif /* HAVE_WINDOW_SYSTEM */
3235 else if (EQ (face
, Qmenu
))
3237 /* Indicate that we have to update the menu bar when realizing
3238 faces on FRAME. FRAME t change the default for new frames.
3239 We do this by setting the flag in new face caches. */
3242 struct frame
*f
= XFRAME (frame
);
3243 if (FRAME_FACE_CACHE (f
) == NULL
)
3244 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3245 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3248 menu_face_changed_default
= 1;
3254 /* Update `default-frame-alist', which is used for new frames. */
3256 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3259 /* Update the current frame's parameters. */
3262 cons
= XCAR (Vparam_value_alist
);
3263 XSETCAR (cons
, param
);
3264 XSETCDR (cons
, value
);
3265 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3274 /* Update the corresponding face when frame parameter PARAM on frame F
3275 has been assigned the value NEW_VALUE. */
3278 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3279 Lisp_Object new_value
)
3281 Lisp_Object face
= Qnil
;
3284 /* If there are no faces yet, give up. This is the case when called
3285 from Fx_create_frame, and we do the necessary things later in
3286 face-set-after-frame-defaults. */
3287 if (NILP (f
->face_alist
))
3290 if (EQ (param
, Qforeground_color
))
3293 lface
= lface_from_face_name (f
, face
, 1);
3294 ASET (lface
, LFACE_FOREGROUND_INDEX
,
3295 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3296 realize_basic_faces (f
);
3298 else if (EQ (param
, Qbackground_color
))
3302 /* Changing the background color might change the background
3303 mode, so that we have to load new defface specs.
3304 Call frame-set-background-mode to do that. */
3305 XSETFRAME (frame
, f
);
3306 call1 (Qframe_set_background_mode
, frame
);
3309 lface
= lface_from_face_name (f
, face
, 1);
3310 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3311 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3312 realize_basic_faces (f
);
3314 #ifdef HAVE_WINDOW_SYSTEM
3315 else if (EQ (param
, Qborder_color
))
3318 lface
= lface_from_face_name (f
, face
, 1);
3319 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3320 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3322 else if (EQ (param
, Qcursor_color
))
3325 lface
= lface_from_face_name (f
, face
, 1);
3326 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3327 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3329 else if (EQ (param
, Qmouse_color
))
3332 lface
= lface_from_face_name (f
, face
, 1);
3333 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3334 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3338 /* Changing a named face means that all realized faces depending on
3339 that face are invalid. Since we cannot tell which realized faces
3340 depend on the face, make sure they are all removed. This is done
3341 by incrementing face_change_count. The next call to
3342 init_iterator will then free realized faces. */
3344 && NILP (Fget (face
, Qface_no_inherit
)))
3346 ++face_change_count
;
3347 ++windows_or_buffers_changed
;
3352 #ifdef HAVE_WINDOW_SYSTEM
3354 /* Set the `font' frame parameter of FRAME determined from the
3355 font-object set in `default' face attributes LFACE. */
3358 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3360 struct frame
*f
= XFRAME (frame
);
3363 if (FRAME_WINDOW_P (f
)
3364 /* Don't do anything if the font is `unspecified'. This can
3365 happen during frame creation. */
3366 && (font
= LFACE_FONT (lface
),
3367 ! UNSPECIFIEDP (font
)))
3369 if (FONT_SPEC_P (font
))
3371 font
= font_load_for_lface (f
, XVECTOR (lface
)->u
.contents
, font
);
3374 ASET (lface
, LFACE_FONT_INDEX
, font
);
3376 f
->default_face_done_p
= 0;
3377 Fmodify_frame_parameters (frame
, list1 (Fcons (Qfont
, font
)));
3381 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3382 Sinternal_face_x_get_resource
, 2, 3, 0,
3383 doc
: /* Get the value of X resource RESOURCE, class CLASS.
3384 Returned value is for the display of frame FRAME. If FRAME is not
3385 specified or nil, use selected frame. This function exists because
3386 ordinary `x-get-resource' doesn't take a frame argument. */)
3387 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3389 Lisp_Object value
= Qnil
;
3392 CHECK_STRING (resource
);
3393 CHECK_STRING (class);
3394 f
= decode_live_frame (frame
);
3396 value
= display_x_get_resource (FRAME_DISPLAY_INFO (f
),
3397 resource
, class, Qnil
, Qnil
);
3403 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3404 If VALUE is "on" or "true", return t. If VALUE is "off" or
3405 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3406 error; if SIGNAL_P is zero, return 0. */
3409 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3411 Lisp_Object result
= make_number (0);
3413 eassert (STRINGP (value
));
3415 if (xstrcasecmp (SSDATA (value
), "on") == 0
3416 || xstrcasecmp (SSDATA (value
), "true") == 0)
3418 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3419 || xstrcasecmp (SSDATA (value
), "false") == 0)
3421 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3422 result
= Qunspecified
;
3424 signal_error ("Invalid face attribute value from X resource", value
);
3430 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3431 Finternal_set_lisp_face_attribute_from_resource
,
3432 Sinternal_set_lisp_face_attribute_from_resource
,
3433 3, 4, 0, doc
: /* */)
3434 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3436 CHECK_SYMBOL (face
);
3437 CHECK_SYMBOL (attr
);
3438 CHECK_STRING (value
);
3440 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3441 value
= Qunspecified
;
3442 else if (EQ (attr
, QCheight
))
3444 value
= Fstring_to_number (value
, make_number (10));
3445 if (XINT (value
) <= 0)
3446 signal_error ("Invalid face height from X resource", value
);
3448 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3449 value
= face_boolean_x_resource_value (value
, 1);
3450 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3451 value
= intern (SSDATA (value
));
3452 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3453 value
= face_boolean_x_resource_value (value
, 1);
3454 else if (EQ (attr
, QCunderline
)
3455 || EQ (attr
, QCoverline
)
3456 || EQ (attr
, QCstrike_through
))
3458 Lisp_Object boolean_value
;
3460 /* If the result of face_boolean_x_resource_value is t or nil,
3461 VALUE does NOT specify a color. */
3462 boolean_value
= face_boolean_x_resource_value (value
, 0);
3463 if (SYMBOLP (boolean_value
))
3464 value
= boolean_value
;
3466 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3467 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3469 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3472 #endif /* HAVE_WINDOW_SYSTEM */
3475 /***********************************************************************
3477 ***********************************************************************/
3479 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3481 /* Make menus on frame F appear as specified by the `menu' face. */
3484 x_update_menu_appearance (struct frame
*f
)
3486 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
3490 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3495 ptrdiff_t bufsize
= sizeof line
;
3496 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3497 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3498 const char *myname
= SSDATA (Vx_resource_name
);
3501 const char *popup_path
= "popup_menu";
3503 const char *popup_path
= "menu.popup";
3506 if (STRINGP (LFACE_FOREGROUND (lface
)))
3508 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3510 SDATA (LFACE_FOREGROUND (lface
)));
3511 XrmPutLineResource (&rdb
, line
);
3512 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3513 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3514 XrmPutLineResource (&rdb
, line
);
3518 if (STRINGP (LFACE_BACKGROUND (lface
)))
3520 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3522 SDATA (LFACE_BACKGROUND (lface
)));
3523 XrmPutLineResource (&rdb
, line
);
3525 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3526 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3527 XrmPutLineResource (&rdb
, line
);
3532 /* On Solaris 5.8, it's been reported that the `menu' face
3533 can be unspecified here, during startup. Why this
3534 happens remains unknown. -- cyd */
3535 && FONTP (LFACE_FONT (lface
))
3536 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3537 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3538 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3539 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3540 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3541 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3543 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3545 const char *suffix
= "List";
3548 #if defined HAVE_X_I18N
3550 const char *suffix
= "Set";
3552 const char *suffix
= "";
3559 #if defined HAVE_X_I18N
3560 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3562 char *fontsetname
= SSDATA (xlfd
);
3564 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3565 myname
, suffix
, fontsetname
);
3566 XrmPutLineResource (&rdb
, line
);
3568 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3569 myname
, popup_path
, suffix
, fontsetname
);
3570 XrmPutLineResource (&rdb
, line
);
3572 if (fontsetname
!= SSDATA (xlfd
))
3573 xfree (fontsetname
);
3577 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3578 free_frame_menubar (f
);
3585 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3588 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3589 Sface_attribute_relative_p
,
3591 doc
: /* Check whether a face attribute value is relative.
3592 Specifically, this function returns t if the attribute ATTRIBUTE
3593 with the value VALUE is relative.
3595 A relative value is one that doesn't entirely override whatever is
3596 inherited from another face. For most possible attributes,
3597 the only relative value that users see is `unspecified'.
3598 However, for :height, floating point values are also relative. */)
3599 (Lisp_Object attribute
, Lisp_Object value
)
3601 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3603 else if (EQ (attribute
, QCheight
))
3604 return INTEGERP (value
) ? Qnil
: Qt
;
3609 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3611 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3612 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3613 the result will be absolute, otherwise it will be relative. */)
3614 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3616 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3618 else if (EQ (attribute
, QCheight
))
3619 return merge_face_heights (value1
, value2
, value1
);
3625 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3626 Sinternal_get_lisp_face_attribute
,
3628 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3629 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3630 face attribute name, signal an error.
3631 If the optional argument FRAME is given, report on face SYMBOL in that
3632 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3633 frames). If FRAME is omitted or nil, use the selected frame. */)
3634 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3636 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3637 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 1), value
= Qnil
;
3639 CHECK_SYMBOL (symbol
);
3640 CHECK_SYMBOL (keyword
);
3642 if (EQ (keyword
, QCfamily
))
3643 value
= LFACE_FAMILY (lface
);
3644 else if (EQ (keyword
, QCfoundry
))
3645 value
= LFACE_FOUNDRY (lface
);
3646 else if (EQ (keyword
, QCheight
))
3647 value
= LFACE_HEIGHT (lface
);
3648 else if (EQ (keyword
, QCweight
))
3649 value
= LFACE_WEIGHT (lface
);
3650 else if (EQ (keyword
, QCslant
))
3651 value
= LFACE_SLANT (lface
);
3652 else if (EQ (keyword
, QCunderline
))
3653 value
= LFACE_UNDERLINE (lface
);
3654 else if (EQ (keyword
, QCoverline
))
3655 value
= LFACE_OVERLINE (lface
);
3656 else if (EQ (keyword
, QCstrike_through
))
3657 value
= LFACE_STRIKE_THROUGH (lface
);
3658 else if (EQ (keyword
, QCbox
))
3659 value
= LFACE_BOX (lface
);
3660 else if (EQ (keyword
, QCinverse_video
)
3661 || EQ (keyword
, QCreverse_video
))
3662 value
= LFACE_INVERSE (lface
);
3663 else if (EQ (keyword
, QCforeground
))
3664 value
= LFACE_FOREGROUND (lface
);
3665 else if (EQ (keyword
, QCbackground
))
3666 value
= LFACE_BACKGROUND (lface
);
3667 else if (EQ (keyword
, QCstipple
))
3668 value
= LFACE_STIPPLE (lface
);
3669 else if (EQ (keyword
, QCwidth
))
3670 value
= LFACE_SWIDTH (lface
);
3671 else if (EQ (keyword
, QCinherit
))
3672 value
= LFACE_INHERIT (lface
);
3673 else if (EQ (keyword
, QCfont
))
3674 value
= LFACE_FONT (lface
);
3675 else if (EQ (keyword
, QCfontset
))
3676 value
= LFACE_FONTSET (lface
);
3678 signal_error ("Invalid face attribute name", keyword
);
3680 if (IGNORE_DEFFACE_P (value
))
3681 return Qunspecified
;
3687 DEFUN ("internal-lisp-face-attribute-values",
3688 Finternal_lisp_face_attribute_values
,
3689 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3690 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3691 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3694 Lisp_Object result
= Qnil
;
3696 CHECK_SYMBOL (attr
);
3698 if (EQ (attr
, QCunderline
) || EQ (attr
, QCoverline
)
3699 || EQ (attr
, QCstrike_through
)
3700 || EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3701 result
= list2 (Qt
, Qnil
);
3707 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3708 Sinternal_merge_in_global_face
, 2, 2, 0,
3709 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3710 Default face attributes override any local face attributes. */)
3711 (Lisp_Object face
, Lisp_Object frame
)
3714 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3715 struct frame
*f
= XFRAME (frame
);
3717 CHECK_LIVE_FRAME (frame
);
3718 global_lface
= lface_from_face_name (NULL
, face
, 1);
3719 local_lface
= lface_from_face_name (f
, face
, 0);
3720 if (NILP (local_lface
))
3721 local_lface
= Finternal_make_lisp_face (face
, frame
);
3723 /* Make every specified global attribute override the local one.
3724 BEWARE!! This is only used from `face-set-after-frame-default' where
3725 the local frame is defined from default specs in `face-defface-spec'
3726 and those should be overridden by global settings. Hence the strange
3727 "global before local" priority. */
3728 lvec
= XVECTOR (local_lface
)->u
.contents
;
3729 gvec
= XVECTOR (global_lface
)->u
.contents
;
3730 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3731 if (IGNORE_DEFFACE_P (gvec
[i
]))
3732 ASET (local_lface
, i
, Qunspecified
);
3733 else if (! UNSPECIFIEDP (gvec
[i
]))
3734 ASET (local_lface
, i
, AREF (global_lface
, i
));
3736 /* If the default face was changed, update the face cache and the
3737 `font' frame parameter. */
3738 if (EQ (face
, Qdefault
))
3740 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3741 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3742 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3744 /* This can be NULL (e.g., in batch mode). */
3747 /* Ensure that the face vector is fully specified by merging
3748 the previously-cached vector. */
3749 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3750 merge_face_vectors (f
, lvec
, attrs
, 0);
3751 vcopy (local_lface
, 0, attrs
, LFACE_VECTOR_SIZE
);
3752 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3754 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3755 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3756 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3757 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3758 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3759 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3760 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3763 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3764 Fmodify_frame_parameters (frame
, list1 (Fcons (Qfont
, name
)));
3767 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3768 Fmodify_frame_parameters (frame
,
3769 list1 (Fcons (Qforeground_color
,
3770 gvec
[LFACE_FOREGROUND_INDEX
])));
3772 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3773 Fmodify_frame_parameters (frame
,
3774 list1 (Fcons (Qbackground_color
,
3775 gvec
[LFACE_BACKGROUND_INDEX
])));
3783 /* The following function is implemented for compatibility with 20.2.
3784 The function is used in x-resolve-fonts when it is asked to
3785 return fonts with the same size as the font of a face. This is
3786 done in fontset.el. */
3788 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3789 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3790 The font name is, by default, for ASCII characters.
3791 If the optional argument FRAME is given, report on face FACE in that frame.
3792 If FRAME is t, report on the defaults for face FACE (for new frames).
3793 The font default for a face is either nil, or a list
3794 of the form (bold), (italic) or (bold italic).
3795 If FRAME is omitted or nil, use the selected frame. And, in this case,
3796 if the optional third argument CHARACTER is given,
3797 return the font name used for CHARACTER. */)
3798 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3802 Lisp_Object result
= Qnil
;
3803 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3805 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3806 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3807 result
= Fcons (Qbold
, result
);
3809 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3810 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3811 result
= Fcons (Qitalic
, result
);
3817 struct frame
*f
= decode_live_frame (frame
);
3818 int face_id
= lookup_named_face (f
, face
, 1);
3819 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3823 #ifdef HAVE_WINDOW_SYSTEM
3824 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3826 CHECK_CHARACTER (character
);
3827 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3828 fface
= FACE_FROM_ID (f
, face_id
);
3831 ? fface
->font
->props
[FONT_NAME_INDEX
]
3833 #else /* !HAVE_WINDOW_SYSTEM */
3834 return build_string (FRAME_MSDOS_P (f
)
3836 : FRAME_W32_P (f
) ? "w32term"
3843 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3844 all attributes are `equal'. Tries to be fast because this function
3845 is called quite often. */
3848 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3850 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3851 and the other is specified. */
3852 if (XTYPE (v1
) != XTYPE (v2
))
3861 if (SBYTES (v1
) != SBYTES (v2
))
3864 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3871 return !NILP (Fequal (v1
, v2
));
3876 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3877 all attributes are `equal'. Tries to be fast because this function
3878 is called quite often. */
3881 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3886 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3887 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3893 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3894 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3895 doc
: /* True if FACE1 and FACE2 are equal.
3896 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3897 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3898 If FRAME is omitted or nil, use the selected frame. */)
3899 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3903 Lisp_Object lface1
, lface2
;
3905 /* Don't use decode_window_system_frame here because this function
3906 is called before X frames exist. At that time, if FRAME is nil,
3907 selected_frame will be used which is the frame dumped with
3908 Emacs. That frame is not an X frame. */
3909 f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3911 lface1
= lface_from_face_name (f
, face1
, 1);
3912 lface2
= lface_from_face_name (f
, face2
, 1);
3913 equal_p
= lface_equal_p (XVECTOR (lface1
)->u
.contents
,
3914 XVECTOR (lface2
)->u
.contents
);
3915 return equal_p
? Qt
: Qnil
;
3919 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3920 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3921 doc
: /* True if FACE has no attribute specified.
3922 If the optional argument FRAME is given, report on face FACE in that frame.
3923 If FRAME is t, report on the defaults for face FACE (for new frames).
3924 If FRAME is omitted or nil, use the selected frame. */)
3925 (Lisp_Object face
, Lisp_Object frame
)
3927 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3928 Lisp_Object lface
= lface_from_face_name (f
, face
, 1);
3931 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3932 if (!UNSPECIFIEDP (AREF (lface
, i
)))
3935 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3939 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
3941 doc
: /* Return an alist of frame-local faces defined on FRAME.
3942 For internal use only. */)
3945 return decode_live_frame (frame
)->face_alist
;
3949 /* Return a hash code for Lisp string STRING with case ignored. Used
3950 below in computing a hash value for a Lisp face. */
3953 hash_string_case_insensitive (Lisp_Object string
)
3955 const unsigned char *s
;
3957 eassert (STRINGP (string
));
3958 for (s
= SDATA (string
); *s
; ++s
)
3959 hash
= (hash
<< 1) ^ c_tolower (*s
);
3964 /* Return a hash code for face attribute vector V. */
3967 lface_hash (Lisp_Object
*v
)
3969 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
3970 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
3971 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
3972 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
3973 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
3974 ^ XHASH (v
[LFACE_SLANT_INDEX
])
3975 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
3976 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
3979 #ifdef HAVE_WINDOW_SYSTEM
3981 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
3982 considering charsets/registries). They do if they specify the same
3983 family, point size, weight, width, slant, and font. Both
3984 LFACE1 and LFACE2 must be fully-specified. */
3987 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
3989 eassert (lface_fully_specified_p (lface1
)
3990 && lface_fully_specified_p (lface2
));
3991 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
3992 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
3993 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
3994 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
3995 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
3996 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
3997 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
3998 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
3999 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4000 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4001 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4002 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4003 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4004 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4008 #endif /* HAVE_WINDOW_SYSTEM */
4010 /***********************************************************************
4012 ***********************************************************************/
4014 /* Allocate and return a new realized face for Lisp face attribute
4017 static struct face
*
4018 make_realized_face (Lisp_Object
*attr
)
4020 enum { off
= offsetof (struct face
, id
) };
4021 struct face
*face
= xmalloc (sizeof *face
);
4023 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4024 memset (&face
->id
, 0, sizeof *face
- off
);
4025 face
->ascii_face
= face
;
4031 /* Free realized face FACE, including its X resources. FACE may
4035 free_realized_face (struct frame
*f
, struct face
*face
)
4039 #ifdef HAVE_WINDOW_SYSTEM
4040 if (FRAME_WINDOW_P (f
))
4042 /* Free fontset of FACE if it is ASCII face. */
4043 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4044 free_face_fontset (f
, face
);
4049 font_done_for_face (f
, face
);
4050 x_free_gc (f
, face
->gc
);
4055 free_face_colors (f
, face
);
4056 x_destroy_bitmap (f
, face
->stipple
);
4058 #endif /* HAVE_WINDOW_SYSTEM */
4065 /* Prepare face FACE for subsequent display on frame F. This
4066 allocated GCs if they haven't been allocated yet or have been freed
4067 by clearing the face cache. */
4070 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4072 #ifdef HAVE_WINDOW_SYSTEM
4073 eassert (FRAME_WINDOW_P (f
));
4078 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4080 xgcv
.foreground
= face
->foreground
;
4081 xgcv
.background
= face
->background
;
4082 #ifdef HAVE_X_WINDOWS
4083 xgcv
.graphics_exposures
= False
;
4087 #ifdef HAVE_X_WINDOWS
4090 xgcv
.fill_style
= FillOpaqueStippled
;
4091 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4092 mask
|= GCFillStyle
| GCStipple
;
4095 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4097 font_prepare_for_face (f
, face
);
4100 #endif /* HAVE_WINDOW_SYSTEM */
4104 /* Returns the `distance' between the colors X and Y. */
4107 color_distance (XColor
*x
, XColor
*y
)
4109 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4110 Quoting from that paper:
4112 This formula has results that are very close to L*u*v* (with the
4113 modified lightness curve) and, more importantly, it is a more even
4114 algorithm: it does not have a range of colors where it suddenly
4115 gives far from optimal results.
4117 See <http://www.compuphase.com/cmetric.htm> for more info. */
4119 long r
= (x
->red
- y
->red
) >> 8;
4120 long g
= (x
->green
- y
->green
) >> 8;
4121 long b
= (x
->blue
- y
->blue
) >> 8;
4122 long r_mean
= (x
->red
+ y
->red
) >> 9;
4125 (((512 + r_mean
) * r
* r
) >> 8)
4127 + (((767 - r_mean
) * b
* b
) >> 8);
4131 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4132 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4133 COLOR1 and COLOR2 may be either strings containing the color name,
4134 or lists of the form (RED GREEN BLUE).
4135 If FRAME is unspecified or nil, the current frame is used. */)
4136 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4138 struct frame
*f
= decode_live_frame (frame
);
4139 XColor cdef1
, cdef2
;
4141 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4142 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4143 signal_error ("Invalid color", color1
);
4144 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4145 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4146 signal_error ("Invalid color", color2
);
4148 return make_number (color_distance (&cdef1
, &cdef2
));
4152 /***********************************************************************
4154 ***********************************************************************/
4156 /* Return a new face cache for frame F. */
4158 static struct face_cache
*
4159 make_face_cache (struct frame
*f
)
4161 struct face_cache
*c
= xmalloc (sizeof *c
);
4163 c
->buckets
= xzalloc (FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
);
4166 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4168 c
->menu_face_changed_p
= menu_face_changed_default
;
4172 #ifdef HAVE_WINDOW_SYSTEM
4174 /* Clear out all graphics contexts for all realized faces, except for
4175 the basic faces. This should be done from time to time just to avoid
4176 keeping too many graphics contexts that are no longer needed. */
4179 clear_face_gcs (struct face_cache
*c
)
4181 if (c
&& FRAME_WINDOW_P (c
->f
))
4184 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4186 struct face
*face
= c
->faces_by_id
[i
];
4187 if (face
&& face
->gc
)
4191 font_done_for_face (c
->f
, face
);
4192 x_free_gc (c
->f
, face
->gc
);
4200 #endif /* HAVE_WINDOW_SYSTEM */
4202 /* Free all realized faces in face cache C, including basic faces.
4203 C may be null. If faces are freed, make sure the frame's current
4204 matrix is marked invalid, so that a display caused by an expose
4205 event doesn't try to use faces we destroyed. */
4208 free_realized_faces (struct face_cache
*c
)
4213 struct frame
*f
= c
->f
;
4215 /* We must block input here because we can't process X events
4216 safely while only some faces are freed, or when the frame's
4217 current matrix still references freed faces. */
4220 for (i
= 0; i
< c
->used
; ++i
)
4222 free_realized_face (f
, c
->faces_by_id
[i
]);
4223 c
->faces_by_id
[i
] = NULL
;
4227 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4228 memset (c
->buckets
, 0, size
);
4230 /* Must do a thorough redisplay the next time. Mark current
4231 matrices as invalid because they will reference faces freed
4232 above. This function is also called when a frame is
4233 destroyed. In this case, the root window of F is nil. */
4234 if (WINDOWP (f
->root_window
))
4236 clear_current_matrices (f
);
4237 ++windows_or_buffers_changed
;
4245 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4246 This is done after attributes of a named face have been changed,
4247 because we can't tell which realized faces depend on that face. */
4250 free_all_realized_faces (Lisp_Object frame
)
4255 FOR_EACH_FRAME (rest
, frame
)
4256 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4259 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4263 /* Free face cache C and faces in it, including their X resources. */
4266 free_face_cache (struct face_cache
*c
)
4270 free_realized_faces (c
);
4272 xfree (c
->faces_by_id
);
4278 /* Cache realized face FACE in face cache C. HASH is the hash value
4279 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4280 FACE), insert the new face to the beginning of the collision list
4281 of the face hash table of C. Otherwise, add the new face to the
4282 end of the collision list. This way, lookup_face can quickly find
4283 that a requested face is not cached. */
4286 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4288 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4292 if (face
->ascii_face
!= face
)
4294 struct face
*last
= c
->buckets
[i
];
4305 c
->buckets
[i
] = face
;
4306 face
->prev
= face
->next
= NULL
;
4312 face
->next
= c
->buckets
[i
];
4314 face
->next
->prev
= face
;
4315 c
->buckets
[i
] = face
;
4318 /* Find a free slot in C->faces_by_id and use the index of the free
4319 slot as FACE->id. */
4320 for (i
= 0; i
< c
->used
; ++i
)
4321 if (c
->faces_by_id
[i
] == NULL
)
4326 /* Check that FACE got a unique id. */
4331 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4332 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4338 #endif /* GLYPH_DEBUG */
4340 /* Maybe enlarge C->faces_by_id. */
4343 if (c
->used
== c
->size
)
4344 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4345 sizeof *c
->faces_by_id
);
4349 c
->faces_by_id
[i
] = face
;
4353 /* Remove face FACE from cache C. */
4356 uncache_face (struct face_cache
*c
, struct face
*face
)
4358 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4361 face
->prev
->next
= face
->next
;
4363 c
->buckets
[i
] = face
->next
;
4366 face
->next
->prev
= face
->prev
;
4368 c
->faces_by_id
[face
->id
] = NULL
;
4369 if (face
->id
== c
->used
)
4374 /* Look up a realized face with face attributes ATTR in the face cache
4375 of frame F. The face will be used to display ASCII characters.
4376 Value is the ID of the face found. If no suitable face is found,
4377 realize a new one. */
4380 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4382 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4387 eassert (cache
!= NULL
);
4388 check_lface_attrs (attr
);
4390 /* Look up ATTR in the face cache. */
4391 hash
= lface_hash (attr
);
4392 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4394 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4396 if (face
->ascii_face
!= face
)
4398 /* There's no more ASCII face. */
4402 if (face
->hash
== hash
4403 && lface_equal_p (face
->lface
, attr
))
4407 /* If not found, realize a new face. */
4409 face
= realize_face (cache
, attr
, -1);
4412 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4413 #endif /* GLYPH_DEBUG */
4418 #ifdef HAVE_WINDOW_SYSTEM
4419 /* Look up a realized face that has the same attributes as BASE_FACE
4420 except for the font in the face cache of frame F. If FONT-OBJECT
4421 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4422 the face has no font. Value is the ID of the face found. If no
4423 suitable face is found, realize a new one. */
4426 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4428 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4433 eassert (cache
!= NULL
);
4434 base_face
= base_face
->ascii_face
;
4435 hash
= lface_hash (base_face
->lface
);
4436 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4438 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4440 if (face
->ascii_face
== face
)
4442 if (face
->ascii_face
== base_face
4443 && face
->font
== (NILP (font_object
) ? NULL
4444 : XFONT_OBJECT (font_object
))
4445 && lface_equal_p (face
->lface
, base_face
->lface
))
4449 /* If not found, realize a new face. */
4450 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4453 #endif /* HAVE_WINDOW_SYSTEM */
4455 /* Return the face id of the realized face for named face SYMBOL on
4456 frame F suitable for displaying ASCII characters. Value is -1 if
4457 the face couldn't be determined, which might happen if the default
4458 face isn't realized and cannot be realized. */
4461 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4463 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4464 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4465 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4467 if (default_face
== NULL
)
4469 if (!realize_basic_faces (f
))
4471 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4472 if (default_face
== NULL
)
4473 emacs_abort (); /* realize_basic_faces must have set it up */
4476 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4479 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4480 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4482 return lookup_face (f
, attrs
);
4486 /* Return the display face-id of the basic face whose canonical face-id
4487 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4488 basic face has bee remapped via Vface_remapping_alist. This function is
4489 conservative: if something goes wrong, it will simply return FACE_ID
4490 rather than signal an error. */
4493 lookup_basic_face (struct frame
*f
, int face_id
)
4495 Lisp_Object name
, mapping
;
4496 int remapped_face_id
;
4498 if (NILP (Vface_remapping_alist
))
4499 return face_id
; /* Nothing to do. */
4503 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4504 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4505 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4506 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4507 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4508 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4509 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4510 case BORDER_FACE_ID
: name
= Qborder
; break;
4511 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4512 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4513 case MENU_FACE_ID
: name
= Qmenu
; break;
4516 emacs_abort (); /* the caller is supposed to pass us a basic face id */
4519 /* Do a quick scan through Vface_remapping_alist, and return immediately
4520 if there is no remapping for face NAME. This is just an optimization
4521 for the very common no-remapping case. */
4522 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4524 return face_id
; /* Give up. */
4526 /* If there is a remapping entry, lookup the face using NAME, which will
4527 handle the remapping too. */
4528 remapped_face_id
= lookup_named_face (f
, name
, 0);
4529 if (remapped_face_id
< 0)
4530 return face_id
; /* Give up. */
4532 return remapped_face_id
;
4536 /* Return a face for charset ASCII that is like the face with id
4537 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4538 STEPS < 0 means larger. Value is the id of the face. */
4541 smaller_face (struct frame
*f
, int face_id
, int steps
)
4543 #ifdef HAVE_WINDOW_SYSTEM
4545 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4546 int pt
, last_pt
, last_height
;
4549 struct face
*new_face
;
4551 /* If not called for an X frame, just return the original face. */
4552 if (FRAME_TERMCAP_P (f
))
4555 /* Try in increments of 1/2 pt. */
4556 delta
= steps
< 0 ? 5 : -5;
4557 steps
= eabs (steps
);
4559 face
= FACE_FROM_ID (f
, face_id
);
4560 memcpy (attrs
, face
->lface
, sizeof attrs
);
4561 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4562 new_face_id
= face_id
;
4563 last_height
= FONT_HEIGHT (face
->font
);
4567 /* Give up if we cannot find a font within 10pt. */
4568 && eabs (last_pt
- pt
) < 100)
4570 /* Look up a face for a slightly smaller/larger font. */
4572 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4573 new_face_id
= lookup_face (f
, attrs
);
4574 new_face
= FACE_FROM_ID (f
, new_face_id
);
4576 /* If height changes, count that as one step. */
4577 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4578 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4581 last_height
= FONT_HEIGHT (new_face
->font
);
4588 #else /* not HAVE_WINDOW_SYSTEM */
4592 #endif /* not HAVE_WINDOW_SYSTEM */
4596 /* Return a face for charset ASCII that is like the face with id
4597 FACE_ID on frame F, but has height HEIGHT. */
4600 face_with_height (struct frame
*f
, int face_id
, int height
)
4602 #ifdef HAVE_WINDOW_SYSTEM
4604 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4606 if (FRAME_TERMCAP_P (f
)
4610 face
= FACE_FROM_ID (f
, face_id
);
4611 memcpy (attrs
, face
->lface
, sizeof attrs
);
4612 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4613 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4614 face_id
= lookup_face (f
, attrs
);
4615 #endif /* HAVE_WINDOW_SYSTEM */
4621 /* Return the face id of the realized face for named face SYMBOL on
4622 frame F suitable for displaying ASCII characters, and use
4623 attributes of the face FACE_ID for attributes that aren't
4624 completely specified by SYMBOL. This is like lookup_named_face,
4625 except that the default attributes come from FACE_ID, not from the
4626 default face. FACE_ID is assumed to be already realized. */
4629 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4632 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4633 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4634 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4639 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4642 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4643 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4644 return lookup_face (f
, attrs
);
4647 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4648 Sface_attributes_as_vector
, 1, 1, 0,
4649 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4653 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4655 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->u
.contents
,
4662 /***********************************************************************
4663 Face capability testing
4664 ***********************************************************************/
4667 /* If the distance (as returned by color_distance) between two colors is
4668 less than this, then they are considered the same, for determining
4669 whether a color is supported or not. The range of values is 0-65535. */
4671 #define TTY_SAME_COLOR_THRESHOLD 10000
4673 #ifdef HAVE_WINDOW_SYSTEM
4675 /* Return non-zero if all the face attributes in ATTRS are supported
4676 on the window-system frame F.
4678 The definition of `supported' is somewhat heuristic, but basically means
4679 that a face containing all the attributes in ATTRS, when merged with the
4680 default face for display, can be represented in a way that's
4682 \(1) different in appearance than the default face, and
4683 \(2) `close in spirit' to what the attributes specify, if not exact. */
4686 x_supports_face_attributes_p (struct frame
*f
,
4687 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4688 struct face
*def_face
)
4690 Lisp_Object
*def_attrs
= def_face
->lface
;
4692 /* Check that other specified attributes are different that the default
4694 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4695 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4696 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4697 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4698 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4699 def_attrs
[LFACE_INVERSE_INDEX
]))
4700 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4701 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4702 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4703 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4704 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4705 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4706 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4707 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4708 def_attrs
[LFACE_STIPPLE_INDEX
]))
4709 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4710 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4711 def_attrs
[LFACE_OVERLINE_INDEX
]))
4712 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4713 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4714 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4715 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4716 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4717 def_attrs
[LFACE_BOX_INDEX
])))
4720 /* Check font-related attributes, as those are the most commonly
4721 "unsupported" on a window-system (because of missing fonts). */
4722 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4723 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4724 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4725 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4726 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4727 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4731 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4734 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4736 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4738 face_id
= lookup_face (f
, merged_attrs
);
4739 face
= FACE_FROM_ID (f
, face_id
);
4742 error ("Cannot make face");
4744 /* If the font is the same, or no font is found, then not
4746 if (face
->font
== def_face
->font
4749 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4750 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4754 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4755 || face
->font
->driver
->case_sensitive
)
4757 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4758 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4759 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4760 s2
, make_number (0), Qnil
, Qt
), Qt
))
4766 /* Everything checks out, this face is supported. */
4770 #endif /* HAVE_WINDOW_SYSTEM */
4772 /* Return non-zero if all the face attributes in ATTRS are supported
4775 The definition of `supported' is somewhat heuristic, but basically means
4776 that a face containing all the attributes in ATTRS, when merged
4777 with the default face for display, can be represented in a way that's
4779 \(1) different in appearance than the default face, and
4780 \(2) `close in spirit' to what the attributes specify, if not exact.
4782 Point (2) implies that a `:weight black' attribute will be satisfied
4783 by any terminal that can display bold, and a `:foreground "yellow"' as
4784 long as the terminal can display a yellowish color, but `:slant italic'
4785 will _not_ be satisfied by the tty display code's automatic
4786 substitution of a `dim' face for italic. */
4789 tty_supports_face_attributes_p (struct frame
*f
,
4790 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4791 struct face
*def_face
)
4794 Lisp_Object val
, fg
, bg
;
4795 XColor fg_tty_color
, fg_std_color
;
4796 XColor bg_tty_color
, bg_std_color
;
4797 unsigned test_caps
= 0;
4798 Lisp_Object
*def_attrs
= def_face
->lface
;
4800 /* First check some easy-to-check stuff; ttys support none of the
4801 following attributes, so we can just return false if any are requested
4802 (even if `nominal' values are specified, we should still return false,
4803 as that will be the same value that the default face uses). We
4804 consider :slant unsupportable on ttys, even though the face code
4805 actually `fakes' them using a dim attribute if possible. This is
4806 because the faked result is too different from what the face
4808 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4809 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4810 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4811 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4812 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4813 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4814 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4815 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4818 /* Test for terminal `capabilities' (non-color character attributes). */
4820 /* font weight (bold/dim) */
4821 val
= attrs
[LFACE_WEIGHT_INDEX
];
4822 if (!UNSPECIFIEDP (val
)
4823 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4825 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4829 if (def_weight
> 100)
4830 return 0; /* same as default */
4831 test_caps
= TTY_CAP_BOLD
;
4833 else if (weight
< 100)
4835 if (def_weight
< 100)
4836 return 0; /* same as default */
4837 test_caps
= TTY_CAP_DIM
;
4839 else if (def_weight
== 100)
4840 return 0; /* same as default */
4844 val
= attrs
[LFACE_SLANT_INDEX
];
4845 if (!UNSPECIFIEDP (val
)
4846 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4848 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4849 if (slant
== 100 || slant
== def_slant
)
4850 return 0; /* same as default */
4852 test_caps
|= TTY_CAP_ITALIC
;
4856 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4857 if (!UNSPECIFIEDP (val
))
4860 return 0; /* ttys can't use colored underlines */
4861 else if (EQ (CAR_SAFE (val
), QCstyle
) && EQ (CAR_SAFE (CDR_SAFE (val
)), Qwave
))
4862 return 0; /* ttys can't use wave underlines */
4863 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4864 return 0; /* same as default */
4866 test_caps
|= TTY_CAP_UNDERLINE
;
4870 val
= attrs
[LFACE_INVERSE_INDEX
];
4871 if (!UNSPECIFIEDP (val
))
4873 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4874 return 0; /* same as default */
4876 test_caps
|= TTY_CAP_INVERSE
;
4880 /* Color testing. */
4882 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4883 we use them when calling `tty_capable_p' below, even if the face
4884 specifies no colors. */
4885 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4886 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4888 /* Check if foreground color is close enough. */
4889 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4892 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4894 if (face_attr_equal_p (fg
, def_fg
))
4895 return 0; /* same as default */
4896 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4897 return 0; /* not a valid color */
4898 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4899 > TTY_SAME_COLOR_THRESHOLD
)
4900 return 0; /* displayed color is too different */
4902 /* Make sure the color is really different than the default. */
4904 XColor def_fg_color
;
4905 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
4906 && (color_distance (&fg_tty_color
, &def_fg_color
)
4907 <= TTY_SAME_COLOR_THRESHOLD
))
4912 /* Check if background color is close enough. */
4913 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
4916 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
4918 if (face_attr_equal_p (bg
, def_bg
))
4919 return 0; /* same as default */
4920 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
4921 return 0; /* not a valid color */
4922 else if (color_distance (&bg_tty_color
, &bg_std_color
)
4923 > TTY_SAME_COLOR_THRESHOLD
)
4924 return 0; /* displayed color is too different */
4926 /* Make sure the color is really different than the default. */
4928 XColor def_bg_color
;
4929 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
4930 && (color_distance (&bg_tty_color
, &def_bg_color
)
4931 <= TTY_SAME_COLOR_THRESHOLD
))
4936 /* If both foreground and background are requested, see if the
4937 distance between them is OK. We just check to see if the distance
4938 between the tty's foreground and background is close enough to the
4939 distance between the standard foreground and background. */
4940 if (STRINGP (fg
) && STRINGP (bg
))
4943 = (color_distance (&fg_std_color
, &bg_std_color
)
4944 - color_distance (&fg_tty_color
, &bg_tty_color
));
4945 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
4946 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
4951 /* See if the capabilities we selected above are supported, with the
4953 if (test_caps
!= 0 &&
4954 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
4955 bg_tty_color
.pixel
))
4959 /* Hmmm, everything checks out, this terminal must support this face. */
4964 DEFUN ("display-supports-face-attributes-p",
4965 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
4967 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
4968 The optional argument DISPLAY can be a display name, a frame, or
4969 nil (meaning the selected frame's display).
4971 The definition of `supported' is somewhat heuristic, but basically means
4972 that a face containing all the attributes in ATTRIBUTES, when merged
4973 with the default face for display, can be represented in a way that's
4975 \(1) different in appearance than the default face, and
4976 \(2) `close in spirit' to what the attributes specify, if not exact.
4978 Point (2) implies that a `:weight black' attribute will be satisfied by
4979 any display that can display bold, and a `:foreground \"yellow\"' as long
4980 as it can display a yellowish color, but `:slant italic' will _not_ be
4981 satisfied by the tty display code's automatic substitution of a `dim'
4982 face for italic. */)
4983 (Lisp_Object attributes
, Lisp_Object display
)
4985 int supports
= 0, i
;
4988 struct face
*def_face
;
4989 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4991 if (noninteractive
|| !initialized
)
4992 /* We may not be able to access low-level face information in batch
4993 mode, or before being dumped, and this function is not going to
4994 be very useful in those cases anyway, so just give up. */
4998 frame
= selected_frame
;
4999 else if (FRAMEP (display
))
5003 /* Find any frame on DISPLAY. */
5007 FOR_EACH_FRAME (tail
, frame
)
5008 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5009 XFRAME (frame
)->param_alist
)),
5014 CHECK_LIVE_FRAME (frame
);
5017 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5018 attrs
[i
] = Qunspecified
;
5019 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5021 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5022 if (def_face
== NULL
)
5024 if (! realize_basic_faces (f
))
5025 error ("Cannot realize default face");
5026 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5027 if (def_face
== NULL
)
5028 emacs_abort (); /* realize_basic_faces must have set it up */
5031 /* Dispatch to the appropriate handler. */
5032 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5033 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5034 #ifdef HAVE_WINDOW_SYSTEM
5036 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5039 return supports
? Qt
: Qnil
;
5043 /***********************************************************************
5045 ***********************************************************************/
5047 DEFUN ("internal-set-font-selection-order",
5048 Finternal_set_font_selection_order
,
5049 Sinternal_set_font_selection_order
, 1, 1, 0,
5050 doc
: /* Set font selection order for face font selection to ORDER.
5051 ORDER must be a list of length 4 containing the symbols `:width',
5052 `:height', `:weight', and `:slant'. Face attributes appearing
5053 first in ORDER are matched first, e.g. if `:height' appears before
5054 `:weight' in ORDER, font selection first tries to find a font with
5055 a suitable height, and then tries to match the font weight.
5061 int indices
[DIM (font_sort_order
)];
5064 memset (indices
, 0, sizeof indices
);
5068 CONSP (list
) && i
< DIM (indices
);
5069 list
= XCDR (list
), ++i
)
5071 Lisp_Object attr
= XCAR (list
);
5074 if (EQ (attr
, QCwidth
))
5076 else if (EQ (attr
, QCheight
))
5077 xlfd
= XLFD_POINT_SIZE
;
5078 else if (EQ (attr
, QCweight
))
5080 else if (EQ (attr
, QCslant
))
5085 if (indices
[i
] != 0)
5090 if (!NILP (list
) || i
!= DIM (indices
))
5091 signal_error ("Invalid font sort order", order
);
5092 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5093 if (indices
[i
] == 0)
5094 signal_error ("Invalid font sort order", order
);
5096 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5098 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5099 free_all_realized_faces (Qnil
);
5102 font_update_sort_order (font_sort_order
);
5108 DEFUN ("internal-set-alternative-font-family-alist",
5109 Finternal_set_alternative_font_family_alist
,
5110 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5111 doc
: /* Define alternative font families to try in face font selection.
5112 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5113 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5114 be found. Value is ALIST. */)
5117 Lisp_Object entry
, tail
, tail2
;
5120 alist
= Fcopy_sequence (alist
);
5121 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5123 entry
= XCAR (tail
);
5125 entry
= Fcopy_sequence (entry
);
5126 XSETCAR (tail
, entry
);
5127 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5128 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5131 Vface_alternative_font_family_alist
= alist
;
5132 free_all_realized_faces (Qnil
);
5137 DEFUN ("internal-set-alternative-font-registry-alist",
5138 Finternal_set_alternative_font_registry_alist
,
5139 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5140 doc
: /* Define alternative font registries to try in face font selection.
5141 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5142 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5143 be found. Value is ALIST. */)
5146 Lisp_Object entry
, tail
, tail2
;
5149 alist
= Fcopy_sequence (alist
);
5150 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5152 entry
= XCAR (tail
);
5154 entry
= Fcopy_sequence (entry
);
5155 XSETCAR (tail
, entry
);
5156 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5157 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5159 Vface_alternative_font_registry_alist
= alist
;
5160 free_all_realized_faces (Qnil
);
5165 #ifdef HAVE_WINDOW_SYSTEM
5167 /* Return the fontset id of the base fontset name or alias name given
5168 by the fontset attribute of ATTRS. Value is -1 if the fontset
5169 attribute of ATTRS doesn't name a fontset. */
5172 face_fontset (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5176 name
= attrs
[LFACE_FONTSET_INDEX
];
5177 if (!STRINGP (name
))
5179 return fs_query_fontset (name
, 0);
5182 #endif /* HAVE_WINDOW_SYSTEM */
5186 /***********************************************************************
5188 ***********************************************************************/
5190 /* Realize basic faces on frame F. Value is zero if frame parameters
5191 of F don't contain enough information needed to realize the default
5195 realize_basic_faces (struct frame
*f
)
5198 ptrdiff_t count
= SPECPDL_INDEX ();
5200 /* Block input here so that we won't be surprised by an X expose
5201 event, for instance, without having the faces set up. */
5203 specbind (Qscalable_fonts_allowed
, Qt
);
5205 if (realize_default_face (f
))
5207 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5208 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5209 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5210 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5211 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5212 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5213 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5214 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5215 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5216 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5217 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5219 /* Reflect changes in the `menu' face in menu bars. */
5220 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5222 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5223 #ifdef USE_X_TOOLKIT
5224 if (FRAME_WINDOW_P (f
))
5225 x_update_menu_appearance (f
);
5232 unbind_to (count
, Qnil
);
5238 /* Realize the default face on frame F. If the face is not fully
5239 specified, make it fully-specified. Attributes of the default face
5240 that are not explicitly specified are taken from frame parameters. */
5243 realize_default_face (struct frame
*f
)
5245 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5247 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5250 /* If the `default' face is not yet known, create it. */
5251 lface
= lface_from_face_name (f
, Qdefault
, 0);
5255 XSETFRAME (frame
, f
);
5256 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5259 #ifdef HAVE_WINDOW_SYSTEM
5260 if (FRAME_WINDOW_P (f
))
5262 Lisp_Object font_object
;
5264 XSETFONT (font_object
, FRAME_FONT (f
));
5265 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5266 ASET (lface
, LFACE_FONTSET_INDEX
, fontset_name (FRAME_FONTSET (f
)));
5267 f
->default_face_done_p
= 1;
5269 #endif /* HAVE_WINDOW_SYSTEM */
5271 if (!FRAME_WINDOW_P (f
))
5273 ASET (lface
, LFACE_FAMILY_INDEX
, build_string ("default"));
5274 ASET (lface
, LFACE_FOUNDRY_INDEX
, LFACE_FAMILY (lface
));
5275 ASET (lface
, LFACE_SWIDTH_INDEX
, Qnormal
);
5276 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (1));
5277 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5278 ASET (lface
, LFACE_WEIGHT_INDEX
, Qnormal
);
5279 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5280 ASET (lface
, LFACE_SLANT_INDEX
, Qnormal
);
5281 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5282 ASET (lface
, LFACE_FONTSET_INDEX
, Qnil
);
5285 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5286 ASET (lface
, LFACE_UNDERLINE_INDEX
, Qnil
);
5288 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5289 ASET (lface
, LFACE_OVERLINE_INDEX
, Qnil
);
5291 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5292 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, Qnil
);
5294 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5295 ASET (lface
, LFACE_BOX_INDEX
, Qnil
);
5297 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5298 ASET (lface
, LFACE_INVERSE_INDEX
, Qnil
);
5300 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5302 /* This function is called so early that colors are not yet
5303 set in the frame parameter list. */
5304 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5306 if (CONSP (color
) && STRINGP (XCDR (color
)))
5307 ASET (lface
, LFACE_FOREGROUND_INDEX
, XCDR (color
));
5308 else if (FRAME_WINDOW_P (f
))
5310 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5311 ASET (lface
, LFACE_FOREGROUND_INDEX
, build_string (unspecified_fg
));
5316 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5318 /* This function is called so early that colors are not yet
5319 set in the frame parameter list. */
5320 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5321 if (CONSP (color
) && STRINGP (XCDR (color
)))
5322 ASET (lface
, LFACE_BACKGROUND_INDEX
, XCDR (color
));
5323 else if (FRAME_WINDOW_P (f
))
5325 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5326 ASET (lface
, LFACE_BACKGROUND_INDEX
, build_string (unspecified_bg
));
5331 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5332 ASET (lface
, LFACE_STIPPLE_INDEX
, Qnil
);
5334 /* Realize the face; it must be fully-specified now. */
5335 eassert (lface_fully_specified_p (XVECTOR (lface
)->u
.contents
));
5336 check_lface (lface
);
5337 memcpy (attrs
, XVECTOR (lface
)->u
.contents
, sizeof attrs
);
5338 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5340 #ifdef HAVE_WINDOW_SYSTEM
5341 #ifdef HAVE_X_WINDOWS
5342 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5344 /* This can happen when making a frame on a display that does
5345 not support the default font. */
5349 /* Otherwise, the font specified for the frame was not
5350 acceptable as a font for the default face (perhaps because
5351 auto-scaled fonts are rejected), so we must adjust the frame
5353 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5355 #endif /* HAVE_X_WINDOWS */
5356 #endif /* HAVE_WINDOW_SYSTEM */
5361 /* Realize basic faces other than the default face in face cache C.
5362 SYMBOL is the face name, ID is the face id the realized face must
5363 have. The default face must have been realized already. */
5366 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5368 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5369 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5370 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5371 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5373 /* The default face must exist and be fully specified. */
5374 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5375 check_lface_attrs (attrs
);
5376 eassert (lface_fully_specified_p (attrs
));
5378 /* If SYMBOL isn't know as a face, create it. */
5382 XSETFRAME (frame
, f
);
5383 lface
= Finternal_make_lisp_face (symbol
, frame
);
5386 /* Merge SYMBOL's face with the default face. */
5387 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5388 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5390 /* Realize the face. */
5391 realize_face (c
, attrs
, id
);
5395 /* Realize the fully-specified face with attributes ATTRS in face
5396 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5397 non-negative, it is an ID of face to remove before caching the new
5398 face. Value is a pointer to the newly created realized face. */
5400 static struct face
*
5401 realize_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
5406 /* LFACE must be fully specified. */
5407 eassert (cache
!= NULL
);
5408 check_lface_attrs (attrs
);
5410 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5412 /* Remove the former face. */
5413 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5414 uncache_face (cache
, former_face
);
5415 free_realized_face (cache
->f
, former_face
);
5416 SET_FRAME_GARBAGED (cache
->f
);
5419 if (FRAME_WINDOW_P (cache
->f
))
5420 face
= realize_x_face (cache
, attrs
);
5421 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5422 face
= realize_tty_face (cache
, attrs
);
5423 else if (FRAME_INITIAL_P (cache
->f
))
5425 /* Create a dummy face. */
5426 face
= make_realized_face (attrs
);
5431 /* Insert the new face. */
5432 cache_face (cache
, face
, lface_hash (attrs
));
5437 #ifdef HAVE_WINDOW_SYSTEM
5438 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5439 same attributes as BASE_FACE except for the font on frame F.
5440 FONT-OBJECT may be nil, in which case, realized a face of
5443 static struct face
*
5444 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5445 struct face
*base_face
)
5447 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5450 face
= xmalloc (sizeof *face
);
5455 = (! NILP (font_object
)
5456 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5457 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5459 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5460 face
->colors_copied_bitwise_p
= 1;
5461 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5464 cache_face (cache
, face
, face
->hash
);
5468 #endif /* HAVE_WINDOW_SYSTEM */
5471 /* Realize the fully-specified face with attributes ATTRS in face
5472 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5473 the new face doesn't share font with the default face, a fontname
5474 is allocated from the heap and set in `font_name' of the new face,
5475 but it is not yet loaded here. Value is a pointer to the newly
5476 created realized face. */
5478 static struct face
*
5479 realize_x_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5481 struct face
*face
= NULL
;
5482 #ifdef HAVE_WINDOW_SYSTEM
5483 struct face
*default_face
;
5485 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5487 eassert (FRAME_WINDOW_P (cache
->f
));
5489 /* Allocate a new realized face. */
5490 face
= make_realized_face (attrs
);
5491 face
->ascii_face
= face
;
5495 /* Determine the font to use. Most of the time, the font will be
5496 the same as the font of the default face, so try that first. */
5497 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5499 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5501 face
->font
= default_face
->font
;
5503 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5507 /* If the face attribute ATTRS specifies a fontset, use it as
5508 the base of a new realized fontset. Otherwise, use the same
5509 base fontset as of the default face. The base determines
5510 registry and encoding of a font. It may also determine
5511 foundry and family. The other fields of font name pattern
5512 are constructed from ATTRS. */
5513 int fontset
= face_fontset (attrs
);
5515 /* If we are realizing the default face, ATTRS should specify a
5516 fontset. In other words, if FONTSET is -1, we are not
5517 realizing the default face, thus the default face should have
5518 already been realized. */
5522 fontset
= default_face
->fontset
;
5526 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5527 attrs
[LFACE_FONT_INDEX
]
5528 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5529 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5531 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5532 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5542 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5543 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5544 face
->overstrike
= 1;
5546 /* Load colors, and set remaining attributes. */
5548 load_face_colors (f
, face
, attrs
);
5551 box
= attrs
[LFACE_BOX_INDEX
];
5554 /* A simple box of line width 1 drawn in color given by
5556 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5558 face
->box
= FACE_SIMPLE_BOX
;
5559 face
->box_line_width
= 1;
5561 else if (INTEGERP (box
))
5563 /* Simple box of specified line width in foreground color of the
5565 eassert (XINT (box
) != 0);
5566 face
->box
= FACE_SIMPLE_BOX
;
5567 face
->box_line_width
= XINT (box
);
5568 face
->box_color
= face
->foreground
;
5569 face
->box_color_defaulted_p
= 1;
5571 else if (CONSP (box
))
5573 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5574 being one of `raised' or `sunken'. */
5575 face
->box
= FACE_SIMPLE_BOX
;
5576 face
->box_color
= face
->foreground
;
5577 face
->box_color_defaulted_p
= 1;
5578 face
->box_line_width
= 1;
5582 Lisp_Object keyword
, value
;
5584 keyword
= XCAR (box
);
5592 if (EQ (keyword
, QCline_width
))
5594 if (INTEGERP (value
) && XINT (value
) != 0)
5595 face
->box_line_width
= XINT (value
);
5597 else if (EQ (keyword
, QCcolor
))
5599 if (STRINGP (value
))
5601 face
->box_color
= load_color (f
, face
, value
,
5603 face
->use_box_color_for_shadows_p
= 1;
5606 else if (EQ (keyword
, QCstyle
))
5608 if (EQ (value
, Qreleased_button
))
5609 face
->box
= FACE_RAISED_BOX
;
5610 else if (EQ (value
, Qpressed_button
))
5611 face
->box
= FACE_SUNKEN_BOX
;
5616 /* Text underline, overline, strike-through. */
5618 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5619 if (EQ (underline
, Qt
))
5621 /* Use default color (same as foreground color). */
5622 face
->underline_p
= 1;
5623 face
->underline_type
= FACE_UNDER_LINE
;
5624 face
->underline_defaulted_p
= 1;
5625 face
->underline_color
= 0;
5627 else if (STRINGP (underline
))
5629 /* Use specified color. */
5630 face
->underline_p
= 1;
5631 face
->underline_type
= FACE_UNDER_LINE
;
5632 face
->underline_defaulted_p
= 0;
5633 face
->underline_color
5634 = load_color (f
, face
, underline
,
5635 LFACE_UNDERLINE_INDEX
);
5637 else if (NILP (underline
))
5639 face
->underline_p
= 0;
5640 face
->underline_defaulted_p
= 0;
5641 face
->underline_color
= 0;
5643 else if (CONSP (underline
))
5645 /* `(:color COLOR :style STYLE)'.
5646 STYLE being one of `line' or `wave'. */
5647 face
->underline_p
= 1;
5648 face
->underline_color
= 0;
5649 face
->underline_defaulted_p
= 1;
5650 face
->underline_type
= FACE_UNDER_LINE
;
5652 /* FIXME? This is also not robust about checking the precise form.
5653 See comments in Finternal_set_lisp_face_attribute. */
5654 while (CONSP (underline
))
5656 Lisp_Object keyword
, value
;
5658 keyword
= XCAR (underline
);
5659 underline
= XCDR (underline
);
5661 if (!CONSP (underline
))
5663 value
= XCAR (underline
);
5664 underline
= XCDR (underline
);
5666 if (EQ (keyword
, QCcolor
))
5668 if (EQ (value
, Qforeground_color
))
5670 face
->underline_defaulted_p
= 1;
5671 face
->underline_color
= 0;
5673 else if (STRINGP (value
))
5675 face
->underline_defaulted_p
= 0;
5676 face
->underline_color
= load_color (f
, face
, value
,
5677 LFACE_UNDERLINE_INDEX
);
5680 else if (EQ (keyword
, QCstyle
))
5682 if (EQ (value
, Qline
))
5683 face
->underline_type
= FACE_UNDER_LINE
;
5684 else if (EQ (value
, Qwave
))
5685 face
->underline_type
= FACE_UNDER_WAVE
;
5690 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5691 if (STRINGP (overline
))
5693 face
->overline_color
5694 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5695 LFACE_OVERLINE_INDEX
);
5696 face
->overline_p
= 1;
5698 else if (EQ (overline
, Qt
))
5700 face
->overline_color
= face
->foreground
;
5701 face
->overline_color_defaulted_p
= 1;
5702 face
->overline_p
= 1;
5705 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5706 if (STRINGP (strike_through
))
5708 face
->strike_through_color
5709 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5710 LFACE_STRIKE_THROUGH_INDEX
);
5711 face
->strike_through_p
= 1;
5713 else if (EQ (strike_through
, Qt
))
5715 face
->strike_through_color
= face
->foreground
;
5716 face
->strike_through_color_defaulted_p
= 1;
5717 face
->strike_through_p
= 1;
5720 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5721 if (!NILP (stipple
))
5722 face
->stipple
= load_pixmap (f
, stipple
, NULL
, NULL
);
5723 #endif /* HAVE_WINDOW_SYSTEM */
5729 /* Map a specified color of face FACE on frame F to a tty color index.
5730 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5731 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5732 default foreground/background colors. */
5735 map_tty_color (struct frame
*f
, struct face
*face
,
5736 enum lface_attribute_index idx
, int *defaulted
)
5738 Lisp_Object frame
, color
, def
;
5739 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5740 unsigned long default_pixel
=
5741 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5742 unsigned long pixel
= default_pixel
;
5744 unsigned long default_other_pixel
=
5745 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5748 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5750 XSETFRAME (frame
, f
);
5751 color
= face
->lface
[idx
];
5755 && CONSP (Vtty_defined_color_alist
)
5756 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5759 /* Associations in tty-defined-color-alist are of the form
5760 (NAME INDEX R G B). We need the INDEX part. */
5761 pixel
= XINT (XCAR (XCDR (def
)));
5764 if (pixel
== default_pixel
&& STRINGP (color
))
5766 pixel
= load_color (f
, face
, color
, idx
);
5769 /* If the foreground of the default face is the default color,
5770 use the foreground color defined by the frame. */
5771 if (FRAME_MSDOS_P (f
))
5773 if (pixel
== default_pixel
5774 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5777 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5779 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5780 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5783 else if (pixel
== default_other_pixel
)
5786 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5788 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5789 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5797 face
->foreground
= pixel
;
5799 face
->background
= pixel
;
5803 /* Realize the fully-specified face with attributes ATTRS in face
5804 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5805 Value is a pointer to the newly created realized face. */
5807 static struct face
*
5808 realize_tty_face (struct face_cache
*cache
,
5809 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5813 int face_colors_defaulted
= 0;
5814 struct frame
*f
= cache
->f
;
5816 /* Frame must be a termcap frame. */
5817 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5819 /* Allocate a new realized face. */
5820 face
= make_realized_face (attrs
);
5822 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5825 /* Map face attributes to TTY appearances. */
5826 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5827 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5829 face
->tty_bold_p
= 1;
5831 face
->tty_italic_p
= 1;
5832 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5833 face
->tty_underline_p
= 1;
5834 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5835 face
->tty_reverse_p
= 1;
5837 /* Map color names to color indices. */
5838 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5839 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5841 /* Swap colors if face is inverse-video. If the colors are taken
5842 from the frame colors, they are already inverted, since the
5843 frame-creation function calls x-handle-reverse-video. */
5844 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5846 unsigned long tem
= face
->foreground
;
5847 face
->foreground
= face
->background
;
5848 face
->background
= tem
;
5851 if (tty_suppress_bold_inverse_default_colors_p
5853 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5854 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5855 face
->tty_bold_p
= 0;
5861 DEFUN ("tty-suppress-bold-inverse-default-colors",
5862 Ftty_suppress_bold_inverse_default_colors
,
5863 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5864 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5865 SUPPRESS non-nil means suppress it.
5866 This affects bold faces on TTYs whose foreground is the default background
5867 color of the display and whose background is the default foreground color.
5868 For such faces, the bold face attribute is ignored if this variable
5870 (Lisp_Object suppress
)
5872 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5873 ++face_change_count
;
5879 /***********************************************************************
5881 ***********************************************************************/
5883 /* Return the ID of the face to use to display character CH with face
5884 property PROP on frame F in current_buffer. */
5887 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5891 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5896 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5897 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5901 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5902 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5903 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5904 merge_face_ref (f
, prop
, attrs
, 1, 0);
5905 face_id
= lookup_face (f
, attrs
);
5911 /* Return the face ID associated with buffer position POS for
5912 displaying ASCII characters. Return in *ENDPTR the position at
5913 which a different face is needed, as far as text properties and
5914 overlays are concerned. W is a window displaying current_buffer.
5916 REGION_BEG, REGION_END delimit the region, so it can be
5919 LIMIT is a position not to scan beyond. That is to limit the time
5920 this function can take.
5922 If MOUSE is non-zero, use the character's mouse-face, not its face.
5924 BASE_FACE_ID, if non-negative, specifies a base face id to use
5925 instead of DEFAULT_FACE_ID.
5927 The face returned is suitable for displaying ASCII characters. */
5930 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
5931 ptrdiff_t region_beg
, ptrdiff_t region_end
,
5932 ptrdiff_t *endptr
, ptrdiff_t limit
,
5933 int mouse
, int base_face_id
)
5935 struct frame
*f
= XFRAME (w
->frame
);
5936 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5937 Lisp_Object prop
, position
;
5938 ptrdiff_t i
, noverlays
;
5939 Lisp_Object
*overlay_vec
;
5941 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5942 Lisp_Object limit1
, end
;
5943 struct face
*default_face
;
5945 /* W must display the current buffer. We could write this function
5946 to use the frame and buffer of W, but right now it doesn't. */
5947 /* eassert (XBUFFER (w->contents) == current_buffer); */
5949 XSETFASTINT (position
, pos
);
5952 if (pos
< region_beg
&& region_beg
< endpos
)
5953 endpos
= region_beg
;
5955 /* Get the `face' or `mouse_face' text property at POS, and
5956 determine the next position at which the property changes. */
5957 prop
= Fget_text_property (position
, propname
, w
->contents
);
5958 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5959 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
5961 endpos
= XINT (end
);
5963 /* Look at properties from overlays. */
5965 ptrdiff_t next_overlay
;
5967 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
5968 if (next_overlay
< endpos
)
5969 endpos
= next_overlay
;
5977 if (base_face_id
>= 0)
5978 face_id
= base_face_id
;
5979 else if (NILP (Vface_remapping_alist
))
5980 face_id
= DEFAULT_FACE_ID
;
5982 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
5984 default_face
= FACE_FROM_ID (f
, face_id
);
5987 /* Optimize common cases where we can use the default face. */
5990 && !(pos
>= region_beg
&& pos
< region_end
))
5991 return default_face
->id
;
5993 /* Begin with attributes from the default face. */
5994 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5996 /* Merge in attributes specified via text properties. */
5998 merge_face_ref (f
, prop
, attrs
, 1, 0);
6000 /* Now merge the overlay data. */
6001 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6002 for (i
= 0; i
< noverlays
; i
++)
6007 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6009 merge_face_ref (f
, prop
, attrs
, 1, 0);
6011 oend
= OVERLAY_END (overlay_vec
[i
]);
6012 oendpos
= OVERLAY_POSITION (oend
);
6013 if (oendpos
< endpos
)
6017 /* If in the region, merge in the region face. */
6018 if (pos
>= region_beg
&& pos
< region_end
)
6020 merge_named_face (f
, Qregion
, attrs
, 0);
6022 if (region_end
< endpos
)
6023 endpos
= region_end
;
6028 /* Look up a realized face with the given face attributes,
6029 or realize a new one for ASCII characters. */
6030 return lookup_face (f
, attrs
);
6033 /* Return the face ID at buffer position POS for displaying ASCII
6034 characters associated with overlay strings for overlay OVERLAY.
6036 Like face_at_buffer_position except for OVERLAY. Currently it
6037 simply disregards the `face' properties of all overlays. */
6040 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6041 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6042 ptrdiff_t *endptr
, ptrdiff_t limit
,
6043 int mouse
, Lisp_Object overlay
)
6045 struct frame
*f
= XFRAME (w
->frame
);
6046 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6047 Lisp_Object prop
, position
;
6049 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6050 Lisp_Object limit1
, end
;
6051 struct face
*default_face
;
6053 /* W must display the current buffer. We could write this function
6054 to use the frame and buffer of W, but right now it doesn't. */
6055 /* eassert (XBUFFER (w->contents) == current_buffer); */
6057 XSETFASTINT (position
, pos
);
6060 if (pos
< region_beg
&& region_beg
< endpos
)
6061 endpos
= region_beg
;
6063 /* Get the `face' or `mouse_face' text property at POS, and
6064 determine the next position at which the property changes. */
6065 prop
= Fget_text_property (position
, propname
, w
->contents
);
6066 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6067 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
6069 endpos
= XINT (end
);
6073 /* Optimize common case where we can use the default face. */
6075 && !(pos
>= region_beg
&& pos
< region_end
)
6076 && NILP (Vface_remapping_alist
))
6077 return DEFAULT_FACE_ID
;
6079 /* Begin with attributes from the default face. */
6080 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6081 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6083 /* Merge in attributes specified via text properties. */
6085 merge_face_ref (f
, prop
, attrs
, 1, 0);
6087 /* If in the region, merge in the region face. */
6088 if (pos
>= region_beg
&& pos
< region_end
)
6090 merge_named_face (f
, Qregion
, attrs
, 0);
6092 if (region_end
< endpos
)
6093 endpos
= region_end
;
6098 /* Look up a realized face with the given face attributes,
6099 or realize a new one for ASCII characters. */
6100 return lookup_face (f
, attrs
);
6104 /* Compute the face at character position POS in Lisp string STRING on
6105 window W, for ASCII characters.
6107 If STRING is an overlay string, it comes from position BUFPOS in
6108 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6109 not an overlay string. W must display the current buffer.
6110 REGION_BEG and REGION_END give the start and end positions of the
6111 region; both are -1 if no region is visible.
6113 BASE_FACE_ID is the id of a face to merge with. For strings coming
6114 from overlays or the `display' property it is the face at BUFPOS.
6116 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6118 Set *ENDPTR to the next position where to check for faces in
6119 STRING; -1 if the face is constant from POS to the end of the
6122 Value is the id of the face to use. The face returned is suitable
6123 for displaying ASCII characters. */
6126 face_at_string_position (struct window
*w
, Lisp_Object string
,
6127 ptrdiff_t pos
, ptrdiff_t bufpos
,
6128 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6129 ptrdiff_t *endptr
, enum face_id base_face_id
,
6132 Lisp_Object prop
, position
, end
, limit
;
6133 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6134 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6135 struct face
*base_face
;
6136 bool multibyte_p
= STRING_MULTIBYTE (string
);
6137 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6139 /* Get the value of the face property at the current position within
6140 STRING. Value is nil if there is no face property. */
6141 XSETFASTINT (position
, pos
);
6142 prop
= Fget_text_property (position
, prop_name
, string
);
6144 /* Get the next position at which to check for faces. Value of end
6145 is nil if face is constant all the way to the end of the string.
6146 Otherwise it is a string position where to check faces next.
6147 Limit is the maximum position up to which to check for property
6148 changes in Fnext_single_property_change. Strings are usually
6149 short, so set the limit to the end of the string. */
6150 XSETFASTINT (limit
, SCHARS (string
));
6151 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6153 *endptr
= XFASTINT (end
);
6157 base_face
= FACE_FROM_ID (f
, base_face_id
);
6158 eassert (base_face
);
6160 /* Optimize the default case that there is no face property and we
6161 are not in the region. */
6163 && (base_face_id
!= DEFAULT_FACE_ID
6164 /* BUFPOS <= 0 means STRING is not an overlay string, so
6165 that the region doesn't have to be taken into account. */
6167 || bufpos
< region_beg
6168 || bufpos
>= region_end
)
6170 /* We can't realize faces for different charsets differently
6171 if we don't have fonts, so we can stop here if not working
6172 on a window-system frame. */
6173 || !FRAME_WINDOW_P (f
)
6174 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6175 return base_face
->id
;
6177 /* Begin with attributes from the base face. */
6178 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6180 /* Merge in attributes specified via text properties. */
6182 merge_face_ref (f
, prop
, attrs
, 1, 0);
6184 /* If in the region, merge in the region face. */
6186 && bufpos
>= region_beg
6187 && bufpos
< region_end
)
6188 merge_named_face (f
, Qregion
, attrs
, 0);
6190 /* Look up a realized face with the given face attributes,
6191 or realize a new one for ASCII characters. */
6192 return lookup_face (f
, attrs
);
6196 /* Merge a face into a realized face.
6198 F is frame where faces are (to be) realized.
6200 FACE_NAME is named face to merge.
6202 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6204 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6206 BASE_FACE_ID is realized face to merge into.
6212 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6215 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6216 struct face
*base_face
;
6218 base_face
= FACE_FROM_ID (f
, base_face_id
);
6220 return base_face_id
;
6222 if (EQ (face_name
, Qt
))
6224 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6225 return base_face_id
;
6226 face_name
= lface_id_to_name
[face_id
];
6227 /* When called during make-frame, lookup_derived_face may fail
6228 if the faces are uninitialized. Don't signal an error. */
6229 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6230 return (face_id
>= 0 ? face_id
: base_face_id
);
6233 /* Begin with attributes from the base face. */
6234 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6236 if (!NILP (face_name
))
6238 if (!merge_named_face (f
, face_name
, attrs
, 0))
6239 return base_face_id
;
6245 return base_face_id
;
6246 face
= FACE_FROM_ID (f
, face_id
);
6248 return base_face_id
;
6249 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6252 /* Look up a realized face with the given face attributes,
6253 or realize a new one for ASCII characters. */
6254 return lookup_face (f
, attrs
);
6259 #ifndef HAVE_X_WINDOWS
6260 DEFUN ("x-load-color-file", Fx_load_color_file
,
6261 Sx_load_color_file
, 1, 1, 0,
6262 doc
: /* Create an alist of color entries from an external file.
6264 The file should define one named RGB color per line like so:
6266 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6267 (Lisp_Object filename
)
6270 Lisp_Object cmap
= Qnil
;
6271 Lisp_Object abspath
;
6273 CHECK_STRING (filename
);
6274 abspath
= Fexpand_file_name (filename
, Qnil
);
6277 fp
= emacs_fopen (SSDATA (abspath
), "rt");
6281 int red
, green
, blue
;
6284 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6285 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6288 int color
= RGB (red
, green
, blue
);
6290 int color
= (red
<< 16) | (green
<< 8) | blue
;
6292 char *name
= buf
+ num
;
6293 ptrdiff_t len
= strlen (name
);
6294 len
-= 0 < len
&& name
[len
- 1] == '\n';
6295 cmap
= Fcons (Fcons (make_string (name
, len
), make_number (color
)),
6307 /***********************************************************************
6309 ***********************************************************************/
6313 /* Print the contents of the realized face FACE to stderr. */
6316 dump_realized_face (struct face
*face
)
6318 fprintf (stderr
, "ID: %d\n", face
->id
);
6319 #ifdef HAVE_X_WINDOWS
6320 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6322 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6324 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6325 fprintf (stderr
, "background: 0x%lx (%s)\n",
6327 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6329 fprintf (stderr
, "font_name: %s (%s)\n",
6330 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6331 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6332 #ifdef HAVE_X_WINDOWS
6333 fprintf (stderr
, "font = %p\n", face
->font
);
6335 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6336 fprintf (stderr
, "underline: %d (%s)\n",
6338 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6339 fprintf (stderr
, "hash: %d\n", face
->hash
);
6343 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6350 fprintf (stderr
, "font selection order: ");
6351 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6352 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6353 fprintf (stderr
, "\n");
6355 fprintf (stderr
, "alternative fonts: ");
6356 debug_print (Vface_alternative_font_family_alist
);
6357 fprintf (stderr
, "\n");
6359 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6360 Fdump_face (make_number (i
));
6366 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6368 error ("Not a valid face");
6369 dump_realized_face (face
);
6376 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6377 0, 0, 0, doc
: /* */)
6380 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6381 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6382 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6386 #endif /* GLYPH_DEBUG */
6390 /***********************************************************************
6392 ***********************************************************************/
6395 syms_of_xfaces (void)
6397 DEFSYM (Qface
, "face");
6398 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6399 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6400 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6402 /* Lisp face attribute keywords. */
6403 DEFSYM (QCfamily
, ":family");
6404 DEFSYM (QCheight
, ":height");
6405 DEFSYM (QCweight
, ":weight");
6406 DEFSYM (QCslant
, ":slant");
6407 DEFSYM (QCunderline
, ":underline");
6408 DEFSYM (QCinverse_video
, ":inverse-video");
6409 DEFSYM (QCreverse_video
, ":reverse-video");
6410 DEFSYM (QCforeground
, ":foreground");
6411 DEFSYM (QCbackground
, ":background");
6412 DEFSYM (QCstipple
, ":stipple");
6413 DEFSYM (QCwidth
, ":width");
6414 DEFSYM (QCfont
, ":font");
6415 DEFSYM (QCfontset
, ":fontset");
6416 DEFSYM (QCbold
, ":bold");
6417 DEFSYM (QCitalic
, ":italic");
6418 DEFSYM (QCoverline
, ":overline");
6419 DEFSYM (QCstrike_through
, ":strike-through");
6420 DEFSYM (QCbox
, ":box");
6421 DEFSYM (QCinherit
, ":inherit");
6423 /* Symbols used for Lisp face attribute values. */
6424 DEFSYM (QCcolor
, ":color");
6425 DEFSYM (QCline_width
, ":line-width");
6426 DEFSYM (QCstyle
, ":style");
6427 DEFSYM (Qline
, "line");
6428 DEFSYM (Qwave
, "wave");
6429 DEFSYM (Qreleased_button
, "released-button");
6430 DEFSYM (Qpressed_button
, "pressed-button");
6431 DEFSYM (Qnormal
, "normal");
6432 DEFSYM (Qextra_light
, "extra-light");
6433 DEFSYM (Qlight
, "light");
6434 DEFSYM (Qsemi_light
, "semi-light");
6435 DEFSYM (Qsemi_bold
, "semi-bold");
6436 DEFSYM (Qbold
, "bold");
6437 DEFSYM (Qextra_bold
, "extra-bold");
6438 DEFSYM (Qultra_bold
, "ultra-bold");
6439 DEFSYM (Qoblique
, "oblique");
6440 DEFSYM (Qitalic
, "italic");
6441 DEFSYM (Qbackground_color
, "background-color");
6442 DEFSYM (Qforeground_color
, "foreground-color");
6443 DEFSYM (Qunspecified
, "unspecified");
6444 DEFSYM (QCignore_defface
, ":ignore-defface");
6446 DEFSYM (Qface_alias
, "face-alias");
6447 DEFSYM (Qdefault
, "default");
6448 DEFSYM (Qtool_bar
, "tool-bar");
6449 DEFSYM (Qregion
, "region");
6450 DEFSYM (Qfringe
, "fringe");
6451 DEFSYM (Qheader_line
, "header-line");
6452 DEFSYM (Qscroll_bar
, "scroll-bar");
6453 DEFSYM (Qmenu
, "menu");
6454 DEFSYM (Qcursor
, "cursor");
6455 DEFSYM (Qborder
, "border");
6456 DEFSYM (Qmouse
, "mouse");
6457 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6458 DEFSYM (Qvertical_border
, "vertical-border");
6459 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6460 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6461 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6462 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6463 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6465 Vparam_value_alist
= list1 (Fcons (Qnil
, Qnil
));
6466 staticpro (&Vparam_value_alist
);
6467 Vface_alternative_font_family_alist
= Qnil
;
6468 staticpro (&Vface_alternative_font_family_alist
);
6469 Vface_alternative_font_registry_alist
= Qnil
;
6470 staticpro (&Vface_alternative_font_registry_alist
);
6472 defsubr (&Sinternal_make_lisp_face
);
6473 defsubr (&Sinternal_lisp_face_p
);
6474 defsubr (&Sinternal_set_lisp_face_attribute
);
6475 #ifdef HAVE_WINDOW_SYSTEM
6476 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6478 defsubr (&Scolor_gray_p
);
6479 defsubr (&Scolor_supported_p
);
6480 #ifndef HAVE_X_WINDOWS
6481 defsubr (&Sx_load_color_file
);
6483 defsubr (&Sface_attribute_relative_p
);
6484 defsubr (&Smerge_face_attribute
);
6485 defsubr (&Sinternal_get_lisp_face_attribute
);
6486 defsubr (&Sinternal_lisp_face_attribute_values
);
6487 defsubr (&Sinternal_lisp_face_equal_p
);
6488 defsubr (&Sinternal_lisp_face_empty_p
);
6489 defsubr (&Sinternal_copy_lisp_face
);
6490 defsubr (&Sinternal_merge_in_global_face
);
6491 defsubr (&Sface_font
);
6492 defsubr (&Sframe_face_alist
);
6493 defsubr (&Sdisplay_supports_face_attributes_p
);
6494 defsubr (&Scolor_distance
);
6495 defsubr (&Sinternal_set_font_selection_order
);
6496 defsubr (&Sinternal_set_alternative_font_family_alist
);
6497 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6498 defsubr (&Sface_attributes_as_vector
);
6500 defsubr (&Sdump_face
);
6501 defsubr (&Sshow_face_resources
);
6502 #endif /* GLYPH_DEBUG */
6503 defsubr (&Sclear_face_cache
);
6504 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6506 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6507 defsubr (&Sdump_colors
);
6510 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6511 doc
: /* List of global face definitions (for internal use only.) */);
6512 Vface_new_frame_defaults
= Qnil
;
6514 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6515 doc
: /* Default stipple pattern used on monochrome displays.
6516 This stipple pattern is used on monochrome displays
6517 instead of shades of gray for a face background color.
6518 See `set-face-stipple' for possible values for this variable. */);
6519 Vface_default_stipple
= build_pure_c_string ("gray3");
6521 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6522 doc
: /* An alist of defined terminal colors and their RGB values.
6523 See the docstring of `tty-color-alist' for the details. */);
6524 Vtty_defined_color_alist
= Qnil
;
6526 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6527 doc
: /* Allowed scalable fonts.
6528 A value of nil means don't allow any scalable fonts.
6529 A value of t means allow any scalable font.
6530 Otherwise, value must be a list of regular expressions. A font may be
6531 scaled if its name matches a regular expression in the list.
6532 Note that if value is nil, a scalable font might still be used, if no
6533 other font of the appropriate family and registry is available. */);
6534 Vscalable_fonts_allowed
= Qnil
;
6536 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6537 doc
: /* List of ignored fonts.
6538 Each element is a regular expression that matches names of fonts to
6540 Vface_ignored_fonts
= Qnil
;
6542 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6543 doc
: /* Alist of face remappings.
6544 Each element is of the form:
6546 (FACE . REPLACEMENT),
6548 which causes display of the face FACE to use REPLACEMENT instead.
6549 REPLACEMENT is a face specification, i.e. one of the following:
6552 (2) a property list of attribute/value pairs, or
6553 (3) a list in which each element has the form of (1) or (2).
6555 List values for REPLACEMENT are merged to form the final face
6556 specification, with earlier entries taking precedence, in the same as
6557 as in the `face' text property.
6559 Face-name remapping cycles are suppressed; recursive references use
6560 the underlying face instead of the remapped face. So a remapping of
6563 (FACE EXTRA-FACE... FACE)
6567 (FACE (FACE-ATTR VAL ...) FACE)
6569 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6570 existing definition of FACE. Note that this isn't necessary for the
6571 default face, since every face inherits from the default face.
6573 If this variable is made buffer-local, the face remapping takes effect
6574 only in that buffer. For instance, the mode my-mode could define a
6575 face `my-mode-default', and then in the mode setup function, do:
6577 (set (make-local-variable 'face-remapping-alist)
6578 '((default my-mode-default)))).
6580 Because Emacs normally only redraws screen areas when the underlying
6581 buffer contents change, you may need to call `redraw-display' after
6582 changing this variable for it to take effect. */);
6583 Vface_remapping_alist
= Qnil
;
6585 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6586 doc
: /* Alist of fonts vs the rescaling factors.
6587 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6588 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6589 RESCALE-RATIO is a floating point number to specify how much larger
6590 \(or smaller) font we should use. For instance, if a face requests
6591 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6592 Vface_font_rescale_alist
= Qnil
;
6594 #ifdef HAVE_WINDOW_SYSTEM
6595 defsubr (&Sbitmap_spec_p
);
6596 defsubr (&Sx_list_fonts
);
6597 defsubr (&Sinternal_face_x_get_resource
);
6598 defsubr (&Sx_family_fonts
);