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
1201 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1202 enum lface_attribute_index target_index
)
1206 eassert (STRINGP (name
));
1207 eassert (target_index
== LFACE_FOREGROUND_INDEX
1208 || target_index
== LFACE_BACKGROUND_INDEX
1209 || target_index
== LFACE_UNDERLINE_INDEX
1210 || target_index
== LFACE_OVERLINE_INDEX
1211 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1212 || target_index
== LFACE_BOX_INDEX
);
1214 /* if the color map is full, defined_color will return a best match
1215 to the values in an existing cell. */
1216 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1218 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1220 switch (target_index
)
1222 case LFACE_FOREGROUND_INDEX
:
1223 face
->foreground_defaulted_p
= 1;
1224 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1227 case LFACE_BACKGROUND_INDEX
:
1228 face
->background_defaulted_p
= 1;
1229 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1232 case LFACE_UNDERLINE_INDEX
:
1233 face
->underline_defaulted_p
= 1;
1234 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1237 case LFACE_OVERLINE_INDEX
:
1238 face
->overline_color_defaulted_p
= 1;
1239 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1242 case LFACE_STRIKE_THROUGH_INDEX
:
1243 face
->strike_through_color_defaulted_p
= 1;
1244 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1247 case LFACE_BOX_INDEX
:
1248 face
->box_color_defaulted_p
= 1;
1249 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1258 ++ncolors_allocated
;
1265 #ifdef HAVE_WINDOW_SYSTEM
1267 /* Load colors for face FACE which is used on frame F. Colors are
1268 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1269 of ATTRS. If the background color specified is not supported on F,
1270 try to emulate gray colors with a stipple from Vface_default_stipple. */
1273 load_face_colors (struct frame
*f
, struct face
*face
,
1274 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1278 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1279 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1281 /* Swap colors if face is inverse-video. */
1282 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1290 /* Check for support for foreground, not for background because
1291 face_color_supported_p is smart enough to know that grays are
1292 "supported" as background because we are supposed to use stipple
1294 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1295 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1297 x_destroy_bitmap (f
, face
->stipple
);
1298 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1299 &face
->pixmap_w
, &face
->pixmap_h
);
1302 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1303 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1307 /* Free color PIXEL on frame F. */
1310 unload_color (struct frame
*f
, long unsigned int pixel
)
1312 #ifdef HAVE_X_WINDOWS
1316 x_free_colors (f
, &pixel
, 1);
1323 /* Free colors allocated for FACE. */
1326 free_face_colors (struct frame
*f
, struct face
*face
)
1328 /* PENDING(NS): need to do something here? */
1329 #ifdef HAVE_X_WINDOWS
1330 if (face
->colors_copied_bitwise_p
)
1335 if (!face
->foreground_defaulted_p
)
1337 x_free_colors (f
, &face
->foreground
, 1);
1338 IF_DEBUG (--ncolors_allocated
);
1341 if (!face
->background_defaulted_p
)
1343 x_free_colors (f
, &face
->background
, 1);
1344 IF_DEBUG (--ncolors_allocated
);
1347 if (face
->underline_p
1348 && !face
->underline_defaulted_p
)
1350 x_free_colors (f
, &face
->underline_color
, 1);
1351 IF_DEBUG (--ncolors_allocated
);
1354 if (face
->overline_p
1355 && !face
->overline_color_defaulted_p
)
1357 x_free_colors (f
, &face
->overline_color
, 1);
1358 IF_DEBUG (--ncolors_allocated
);
1361 if (face
->strike_through_p
1362 && !face
->strike_through_color_defaulted_p
)
1364 x_free_colors (f
, &face
->strike_through_color
, 1);
1365 IF_DEBUG (--ncolors_allocated
);
1368 if (face
->box
!= FACE_NO_BOX
1369 && !face
->box_color_defaulted_p
)
1371 x_free_colors (f
, &face
->box_color
, 1);
1372 IF_DEBUG (--ncolors_allocated
);
1376 #endif /* HAVE_X_WINDOWS */
1379 #endif /* HAVE_WINDOW_SYSTEM */
1383 /***********************************************************************
1385 ***********************************************************************/
1387 /* An enumerator for each field of an XLFD font name. */
1408 /* An enumerator for each possible slant value of a font. Taken from
1409 the XLFD specification. */
1417 XLFD_SLANT_REVERSE_ITALIC
,
1418 XLFD_SLANT_REVERSE_OBLIQUE
,
1422 /* Relative font weight according to XLFD documentation. */
1426 XLFD_WEIGHT_UNKNOWN
,
1427 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1428 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1429 XLFD_WEIGHT_LIGHT
, /* 30 */
1430 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1431 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1432 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1433 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1434 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1435 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1438 /* Relative proportionate width. */
1442 XLFD_SWIDTH_UNKNOWN
,
1443 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1444 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1445 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1446 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1447 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1448 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1449 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1450 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1451 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1454 /* Order by which font selection chooses fonts. The default values
1455 mean `first, find a best match for the font width, then for the
1456 font height, then for weight, then for slant.' This variable can be
1457 set via set-face-font-sort-order. */
1459 static int font_sort_order
[4];
1461 #ifdef HAVE_WINDOW_SYSTEM
1463 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1466 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1468 Lisp_Object
const *p1
= v1
;
1469 Lisp_Object
const *p2
= v2
;
1470 Lisp_Object font1
= *p1
;
1471 Lisp_Object font2
= *p2
;
1474 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1476 enum font_property_index idx
= font_props_for_sorting
[i
];
1477 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1480 if (idx
<= FONT_REGISTRY_INDEX
)
1483 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1485 result
= STRINGP (val2
) ? 1 : 0;
1489 if (INTEGERP (val1
))
1490 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1491 ? XINT (val1
) > XINT (val2
)
1494 result
= INTEGERP (val2
) ? 1 : 0;
1502 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1503 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1504 If FAMILY is omitted or nil, list all families.
1505 Otherwise, FAMILY must be a string, possibly containing wildcards
1507 If FRAME is omitted or nil, use the selected frame.
1508 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1509 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1510 FAMILY is the font family name. POINT-SIZE is the size of the
1511 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1512 width, weight and slant of the font. These symbols are the same as for
1513 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1514 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1515 giving the registry and encoding of the font.
1516 The result list is sorted according to the current setting of
1517 the face font sort order. */)
1518 (Lisp_Object family
, Lisp_Object frame
)
1520 Lisp_Object font_spec
, list
, *drivers
, vec
;
1521 struct frame
*f
= decode_live_frame (frame
);
1522 ptrdiff_t i
, nfonts
;
1527 font_spec
= Ffont_spec (0, NULL
);
1530 CHECK_STRING (family
);
1531 font_parse_family_registry (family
, Qnil
, font_spec
);
1534 list
= font_list_entities (f
, font_spec
);
1538 /* Sort the font entities. */
1539 for (i
= 0; i
< 4; i
++)
1540 switch (font_sort_order
[i
])
1543 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1544 case XLFD_POINT_SIZE
:
1545 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1547 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1549 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1551 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1552 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1553 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1554 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1556 ndrivers
= XINT (Flength (list
));
1557 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1558 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1559 drivers
[i
] = XCAR (list
);
1560 vec
= Fvconcat (ndrivers
, drivers
);
1561 nfonts
= ASIZE (vec
);
1563 qsort (XVECTOR (vec
)->u
.contents
, nfonts
, word_size
,
1564 compare_fonts_by_sort_order
);
1567 for (i
= nfonts
- 1; i
>= 0; --i
)
1569 Lisp_Object font
= AREF (vec
, i
);
1570 Lisp_Object v
= make_uninit_vector (8);
1572 Lisp_Object spacing
;
1574 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1575 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1576 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1578 ASET (v
, 2, make_number (point
));
1579 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1580 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1581 spacing
= Ffont_get (font
, QCspacing
);
1582 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1583 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1584 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1586 result
= Fcons (v
, result
);
1593 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1594 doc
: /* Return a list of the names of available fonts matching PATTERN.
1595 If optional arguments FACE and FRAME are specified, return only fonts
1596 the same size as FACE on FRAME.
1598 PATTERN should be a string containing a font name in the XLFD,
1599 Fontconfig, or GTK format. A font name given in the XLFD format may
1600 contain wildcard characters:
1601 the * character matches any substring, and
1602 the ? character matches any single character.
1603 PATTERN is case-insensitive.
1605 The return value is a list of strings, suitable as arguments to
1608 Fonts Emacs can't use may or may not be excluded
1609 even if they match PATTERN and FACE.
1610 The optional fourth argument MAXIMUM sets a limit on how many
1611 fonts to match. The first MAXIMUM fonts are reported.
1612 The optional fifth argument WIDTH, if specified, is a number of columns
1613 occupied by a character of a font. In that case, return only fonts
1614 the WIDTH times as wide as FACE on FRAME. */)
1615 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1616 Lisp_Object maximum
, Lisp_Object width
)
1619 int size
, avgwidth
IF_LINT (= 0);
1621 check_window_system (NULL
);
1622 CHECK_STRING (pattern
);
1624 if (! NILP (maximum
))
1625 CHECK_NATNUM (maximum
);
1628 CHECK_NUMBER (width
);
1630 /* We can't simply call decode_window_system_frame because
1631 this function may be called before any frame is created. */
1632 f
= decode_live_frame (frame
);
1633 if (! FRAME_WINDOW_P (f
))
1635 /* Perhaps we have not yet created any frame. */
1641 XSETFRAME (frame
, f
);
1643 /* Determine the width standard for comparison with the fonts we find. */
1649 /* This is of limited utility since it works with character
1650 widths. Keep it for compatibility. --gerd. */
1651 int face_id
= lookup_named_face (f
, face
, 0);
1652 struct face
*width_face
= (face_id
< 0
1654 : FACE_FROM_ID (f
, face_id
));
1656 if (width_face
&& width_face
->font
)
1658 size
= width_face
->font
->pixel_size
;
1659 avgwidth
= width_face
->font
->average_width
;
1663 size
= FRAME_FONT (f
)->pixel_size
;
1664 avgwidth
= FRAME_FONT (f
)->average_width
;
1667 avgwidth
*= XINT (width
);
1671 Lisp_Object font_spec
;
1672 Lisp_Object args
[2], tail
;
1674 font_spec
= font_spec_from_name (pattern
);
1675 if (!FONTP (font_spec
))
1676 signal_error ("Invalid font name", pattern
);
1680 Ffont_put (font_spec
, QCsize
, make_number (size
));
1681 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1683 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1684 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1686 Lisp_Object font_entity
;
1688 font_entity
= XCAR (tail
);
1689 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1690 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1691 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1693 /* This is a scalable font. For backward compatibility,
1694 we set the specified size. */
1695 font_entity
= copy_font_spec (font_entity
);
1696 ASET (font_entity
, FONT_SIZE_INDEX
,
1697 AREF (font_spec
, FONT_SIZE_INDEX
));
1699 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1702 /* We don't have to check fontsets. */
1704 args
[1] = list_fontsets (f
, pattern
, size
);
1705 return Fnconc (2, args
);
1709 #endif /* HAVE_WINDOW_SYSTEM */
1712 /***********************************************************************
1714 ***********************************************************************/
1716 /* Access face attributes of face LFACE, a Lisp vector. */
1718 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1719 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1720 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1721 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1722 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1723 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1724 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1725 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1726 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1727 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1728 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1729 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1730 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1731 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1732 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1733 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1734 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1736 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1737 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1739 #define LFACEP(LFACE) \
1741 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1742 && EQ (AREF (LFACE, 0), Qface))
1747 /* Check consistency of Lisp face attribute vector ATTRS. */
1750 check_lface_attrs (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1752 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1753 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1754 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1755 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1756 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1757 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1758 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1759 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1760 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1761 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1762 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1763 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1764 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1765 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1766 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1767 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1768 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1769 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1770 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1771 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1772 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1773 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1774 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1775 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1776 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1777 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1778 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1779 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1780 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1781 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1782 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1783 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1784 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1785 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1786 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1787 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1788 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1789 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1790 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1791 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1792 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1793 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1794 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1795 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1796 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1797 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1798 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1799 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1800 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1801 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1802 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1803 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1804 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1805 #ifdef HAVE_WINDOW_SYSTEM
1806 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1807 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1808 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1809 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1810 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1811 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1812 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1813 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1814 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1815 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1820 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1823 check_lface (Lisp_Object lface
)
1827 eassert (LFACEP (lface
));
1828 check_lface_attrs (XVECTOR (lface
)->u
.contents
);
1832 #else /* not GLYPH_DEBUG */
1834 #define check_lface_attrs(attrs) (void) 0
1835 #define check_lface(lface) (void) 0
1837 #endif /* GLYPH_DEBUG */
1841 /* Face-merge cycle checking. */
1843 enum named_merge_point_kind
1845 NAMED_MERGE_POINT_NORMAL
,
1846 NAMED_MERGE_POINT_REMAP
1849 /* A `named merge point' is simply a point during face-merging where we
1850 look up a face by name. We keep a stack of which named lookups we're
1851 currently processing so that we can easily detect cycles, using a
1852 linked- list of struct named_merge_point structures, typically
1853 allocated on the stack frame of the named lookup functions which are
1854 active (so no consing is required). */
1855 struct named_merge_point
1857 Lisp_Object face_name
;
1858 enum named_merge_point_kind named_merge_point_kind
;
1859 struct named_merge_point
*prev
;
1863 /* If a face merging cycle is detected for FACE_NAME, return 0,
1864 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1865 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1866 pointed to by NAMED_MERGE_POINTS, and return 1. */
1869 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1870 Lisp_Object face_name
,
1871 enum named_merge_point_kind named_merge_point_kind
,
1872 struct named_merge_point
**named_merge_points
)
1874 struct named_merge_point
*prev
;
1876 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1877 if (EQ (face_name
, prev
->face_name
))
1879 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1880 /* A cycle, so fail. */
1882 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1883 /* A remap `hides ' any previous normal merge points
1884 (because the remap means that it's actually different face),
1885 so as we know the current merge point must be normal, we
1886 can just assume it's OK. */
1890 new_named_merge_point
->face_name
= face_name
;
1891 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1892 new_named_merge_point
->prev
= *named_merge_points
;
1894 *named_merge_points
= new_named_merge_point
;
1900 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1901 to make it a symbol. If FACE_NAME is an alias for another face,
1902 return that face's name.
1904 Return default face in case of errors. */
1907 resolve_face_name (Lisp_Object face_name
, int signal_p
)
1909 Lisp_Object orig_face
;
1910 Lisp_Object tortoise
, hare
;
1912 if (STRINGP (face_name
))
1913 face_name
= intern (SSDATA (face_name
));
1915 if (NILP (face_name
) || !SYMBOLP (face_name
))
1918 orig_face
= face_name
;
1919 tortoise
= hare
= face_name
;
1924 hare
= Fget (hare
, Qface_alias
);
1925 if (NILP (hare
) || !SYMBOLP (hare
))
1929 hare
= Fget (hare
, Qface_alias
);
1930 if (NILP (hare
) || !SYMBOLP (hare
))
1933 tortoise
= Fget (tortoise
, Qface_alias
);
1934 if (EQ (hare
, tortoise
))
1937 xsignal1 (Qcircular_list
, orig_face
);
1946 /* Return the face definition of FACE_NAME on frame F. F null means
1947 return the definition for new frames. FACE_NAME may be a string or
1948 a symbol (apparently Emacs 20.2 allowed strings as face names in
1949 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
1950 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
1951 is zero, value is nil if FACE_NAME is not a valid face name. */
1953 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
1959 lface
= assq_no_quit (face_name
, f
->face_alist
);
1961 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
1964 lface
= XCDR (lface
);
1966 signal_error ("Invalid face", face_name
);
1968 check_lface (lface
);
1973 /* Return the face definition of FACE_NAME on frame F. F null means
1974 return the definition for new frames. FACE_NAME may be a string or
1975 a symbol (apparently Emacs 20.2 allowed strings as face names in
1976 face text properties; Ediff uses that). If FACE_NAME is an alias
1977 for another face, return that face's definition. If SIGNAL_P is
1978 non-zero, signal an error if FACE_NAME is not a valid face name.
1979 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
1982 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
1984 face_name
= resolve_face_name (face_name
, signal_p
);
1985 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
1989 /* Get face attributes of face FACE_NAME from frame-local faces on
1990 frame F. Store the resulting attributes in ATTRS which must point
1991 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
1992 is non-zero, signal an error if FACE_NAME does not name a face.
1993 Otherwise, value is zero if FACE_NAME is not a face. */
1996 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
1997 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
2002 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2005 memcpy (attrs
, XVECTOR (lface
)->u
.contents
,
2006 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2008 return !NILP (lface
);
2011 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2012 F. Store the resulting attributes in ATTRS which must point to a
2013 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2014 alias for another face, use that face's definition. If SIGNAL_P is
2015 non-zero, signal an error if FACE_NAME does not name a face.
2016 Otherwise, value is zero if FACE_NAME is not a face. */
2019 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2020 Lisp_Object attrs
[LFACE_VECTOR_SIZE
], int signal_p
,
2021 struct named_merge_point
*named_merge_points
)
2023 Lisp_Object face_remapping
;
2025 face_name
= resolve_face_name (face_name
, signal_p
);
2027 /* See if SYMBOL has been remapped to some other face (usually this
2028 is done buffer-locally). */
2029 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2030 if (CONSP (face_remapping
))
2032 struct named_merge_point named_merge_point
;
2034 if (push_named_merge_point (&named_merge_point
,
2035 face_name
, NAMED_MERGE_POINT_REMAP
,
2036 &named_merge_points
))
2040 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2041 attrs
[i
] = Qunspecified
;
2043 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2044 signal_p
, named_merge_points
);
2048 /* Default case, no remapping. */
2049 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2053 /* Non-zero if all attributes in face attribute vector ATTRS are
2054 specified, i.e. are non-nil. */
2057 lface_fully_specified_p (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
2061 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2062 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2063 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2066 return i
== LFACE_VECTOR_SIZE
;
2069 #ifdef HAVE_WINDOW_SYSTEM
2071 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2072 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2073 exception is `font' attribute. It is set to FONT_OBJECT regardless
2077 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2078 Lisp_Object font_object
, int force_p
)
2081 struct font
*font
= XFONT_OBJECT (font_object
);
2083 /* Set attributes only if unspecified, otherwise face defaults for
2084 new frames would never take effect. If the font doesn't have a
2085 specific property, set a normal value for that. */
2087 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2089 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2091 ASET (lface
, LFACE_FAMILY_INDEX
, SYMBOL_NAME (family
));
2094 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2096 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2098 ASET (lface
, LFACE_FOUNDRY_INDEX
, SYMBOL_NAME (foundry
));
2101 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2103 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, FRAME_RES_Y (f
));
2106 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (pt
));
2109 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2111 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2112 ASET (lface
, LFACE_WEIGHT_INDEX
, ! NILP (val
) ? val
:Qnormal
);
2114 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2116 val
= FONT_SLANT_FOR_FACE (font_object
);
2117 ASET (lface
, LFACE_SLANT_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2119 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2121 val
= FONT_WIDTH_FOR_FACE (font_object
);
2122 ASET (lface
, LFACE_SWIDTH_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2125 ASET (lface
, LFACE_FONT_INDEX
, font_object
);
2129 #endif /* HAVE_WINDOW_SYSTEM */
2132 /* Merges the face height FROM with the face height TO, and returns the
2133 merged height. If FROM is an invalid height, then INVALID is
2134 returned instead. FROM and TO may be either absolute face heights or
2135 `relative' heights; the returned value is always an absolute height
2136 unless both FROM and TO are relative. */
2139 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2141 Lisp_Object result
= invalid
;
2143 if (INTEGERP (from
))
2144 /* FROM is absolute, just use it as is. */
2146 else if (FLOATP (from
))
2147 /* FROM is a scale, use it to adjust TO. */
2150 /* relative X absolute => absolute */
2151 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2152 else if (FLOATP (to
))
2153 /* relative X relative => relative */
2154 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2155 else if (UNSPECIFIEDP (to
))
2158 else if (FUNCTIONP (from
))
2159 /* FROM is a function, which use to adjust TO. */
2161 /* Call function with current height as argument.
2162 From is the new height. */
2163 result
= safe_call1 (from
, to
);
2165 /* Ensure that if TO was absolute, so is the result. */
2166 if (INTEGERP (to
) && !INTEGERP (result
))
2174 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2175 store the resulting attributes in TO, which must be already be
2176 completely specified and contain only absolute attributes. Every
2177 specified attribute of FROM overrides the corresponding attribute of
2178 TO; relative attributes in FROM are merged with the absolute value in
2179 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2180 loops in face inheritance/remapping; it should be 0 when called from
2184 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2185 struct named_merge_point
*named_merge_points
)
2188 Lisp_Object font
= Qnil
;
2190 /* If FROM inherits from some other faces, merge their attributes into
2191 TO before merging FROM's direct attributes. Note that an :inherit
2192 attribute of `unspecified' is the same as one of nil; we never
2193 merge :inherit attributes, so nil is more correct, but lots of
2194 other code uses `unspecified' as a generic value for face attributes. */
2195 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2196 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2197 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2199 if (FONT_SPEC_P (from
[LFACE_FONT_INDEX
]))
2201 if (!UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2202 font
= merge_font_spec (from
[LFACE_FONT_INDEX
], to
[LFACE_FONT_INDEX
]);
2204 font
= copy_font_spec (from
[LFACE_FONT_INDEX
]);
2205 to
[LFACE_FONT_INDEX
] = font
;
2208 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2209 if (!UNSPECIFIEDP (from
[i
]))
2211 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2213 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2214 font_clear_prop (to
, FONT_SIZE_INDEX
);
2216 else if (i
!= LFACE_FONT_INDEX
&& ! EQ (to
[i
], from
[i
]))
2219 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2220 font_clear_prop (to
,
2221 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2222 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2223 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2224 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2225 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2226 : FONT_SLANT_INDEX
));
2230 /* If FROM specifies a font spec, make its contents take precedence
2231 over :family and other attributes. This is needed for face
2232 remapping using :font to work. */
2236 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
2237 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
));
2238 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
2239 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
));
2240 if (! NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
2241 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (font
);
2242 if (! NILP (AREF (font
, FONT_SLANT_INDEX
)))
2243 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (font
);
2244 if (! NILP (AREF (font
, FONT_WIDTH_INDEX
)))
2245 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (font
);
2246 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2249 /* TO is always an absolute face, which should inherit from nothing.
2250 We blindly copy the :inherit attribute above and fix it up here. */
2251 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2254 /* Merge the named face FACE_NAME on frame F, into the vector of face
2255 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2256 inheritance. Returns true if FACE_NAME is a valid face name and
2257 merging succeeded. */
2260 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2261 struct named_merge_point
*named_merge_points
)
2263 struct named_merge_point named_merge_point
;
2265 if (push_named_merge_point (&named_merge_point
,
2266 face_name
, NAMED_MERGE_POINT_NORMAL
,
2267 &named_merge_points
))
2269 struct gcpro gcpro1
;
2270 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2271 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2275 GCPRO1 (named_merge_point
.face_name
);
2276 merge_face_vectors (f
, from
, to
, named_merge_points
);
2287 /* Merge face attributes from the lisp `face reference' FACE_REF on
2288 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2289 problems with FACE_REF cause an error message to be shown. Return
2290 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2291 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2292 list structure; it may be 0 for most callers.
2294 FACE_REF may be a single face specification or a list of such
2295 specifications. Each face specification can be:
2297 1. A symbol or string naming a Lisp face.
2299 2. A property list of the form (KEYWORD VALUE ...) where each
2300 KEYWORD is a face attribute name, and value is an appropriate value
2303 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2304 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2305 for compatibility with 20.2.
2307 Face specifications earlier in lists take precedence over later
2311 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2312 int err_msgs
, struct named_merge_point
*named_merge_points
)
2314 int ok
= 1; /* Succeed without an error? */
2316 if (CONSP (face_ref
))
2318 Lisp_Object first
= XCAR (face_ref
);
2320 if (EQ (first
, Qforeground_color
)
2321 || EQ (first
, Qbackground_color
))
2323 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2324 . COLOR). COLOR must be a string. */
2325 Lisp_Object color_name
= XCDR (face_ref
);
2326 Lisp_Object color
= first
;
2328 if (STRINGP (color_name
))
2330 if (EQ (color
, Qforeground_color
))
2331 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2333 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2338 add_to_log ("Invalid face color", color_name
, Qnil
);
2342 else if (SYMBOLP (first
)
2343 && *SDATA (SYMBOL_NAME (first
)) == ':')
2345 /* Assume this is the property list form. */
2346 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2348 Lisp_Object keyword
= XCAR (face_ref
);
2349 Lisp_Object value
= XCAR (XCDR (face_ref
));
2352 /* Specifying `unspecified' is a no-op. */
2353 if (EQ (value
, Qunspecified
))
2355 else if (EQ (keyword
, QCfamily
))
2357 if (STRINGP (value
))
2359 to
[LFACE_FAMILY_INDEX
] = value
;
2360 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2365 else if (EQ (keyword
, QCfoundry
))
2367 if (STRINGP (value
))
2369 to
[LFACE_FOUNDRY_INDEX
] = value
;
2370 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2375 else if (EQ (keyword
, QCheight
))
2377 Lisp_Object new_height
=
2378 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2380 if (! NILP (new_height
))
2382 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2383 font_clear_prop (to
, FONT_SIZE_INDEX
);
2388 else if (EQ (keyword
, QCweight
))
2390 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2392 to
[LFACE_WEIGHT_INDEX
] = value
;
2393 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2398 else if (EQ (keyword
, QCslant
))
2400 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2402 to
[LFACE_SLANT_INDEX
] = value
;
2403 font_clear_prop (to
, FONT_SLANT_INDEX
);
2408 else if (EQ (keyword
, QCunderline
))
2414 to
[LFACE_UNDERLINE_INDEX
] = value
;
2418 else if (EQ (keyword
, QCoverline
))
2423 to
[LFACE_OVERLINE_INDEX
] = value
;
2427 else if (EQ (keyword
, QCstrike_through
))
2432 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2436 else if (EQ (keyword
, QCbox
))
2439 value
= make_number (1);
2440 if (INTEGERP (value
)
2444 to
[LFACE_BOX_INDEX
] = value
;
2448 else if (EQ (keyword
, QCinverse_video
)
2449 || EQ (keyword
, QCreverse_video
))
2451 if (EQ (value
, Qt
) || NILP (value
))
2452 to
[LFACE_INVERSE_INDEX
] = value
;
2456 else if (EQ (keyword
, QCforeground
))
2458 if (STRINGP (value
))
2459 to
[LFACE_FOREGROUND_INDEX
] = value
;
2463 else if (EQ (keyword
, QCbackground
))
2465 if (STRINGP (value
))
2466 to
[LFACE_BACKGROUND_INDEX
] = value
;
2470 else if (EQ (keyword
, QCstipple
))
2472 #if defined (HAVE_WINDOW_SYSTEM)
2473 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2474 if (!NILP (pixmap_p
))
2475 to
[LFACE_STIPPLE_INDEX
] = value
;
2478 #endif /* HAVE_WINDOW_SYSTEM */
2480 else if (EQ (keyword
, QCwidth
))
2482 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2484 to
[LFACE_SWIDTH_INDEX
] = value
;
2485 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2490 else if (EQ (keyword
, QCfont
))
2493 to
[LFACE_FONT_INDEX
] = value
;
2497 else if (EQ (keyword
, QCinherit
))
2499 /* This is not really very useful; it's just like a
2500 normal face reference. */
2501 if (! merge_face_ref (f
, value
, to
,
2502 err_msgs
, named_merge_points
))
2510 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2514 face_ref
= XCDR (XCDR (face_ref
));
2519 /* This is a list of face refs. Those at the beginning of the
2520 list take precedence over what follows, so we have to merge
2521 from the end backwards. */
2522 Lisp_Object next
= XCDR (face_ref
);
2525 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2527 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2533 /* FACE_REF ought to be a face name. */
2534 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2535 if (!ok
&& err_msgs
)
2536 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2543 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2544 Sinternal_make_lisp_face
, 1, 2, 0,
2545 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2546 If FACE was not known as a face before, create a new one.
2547 If optional argument FRAME is specified, make a frame-local face
2548 for that frame. Otherwise operate on the global face definition.
2549 Value is a vector of face attributes. */)
2550 (Lisp_Object face
, Lisp_Object frame
)
2552 Lisp_Object global_lface
, lface
;
2556 CHECK_SYMBOL (face
);
2557 global_lface
= lface_from_face_name (NULL
, face
, 0);
2561 CHECK_LIVE_FRAME (frame
);
2563 lface
= lface_from_face_name (f
, face
, 0);
2566 f
= NULL
, lface
= Qnil
;
2568 /* Add a global definition if there is none. */
2569 if (NILP (global_lface
))
2571 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2573 ASET (global_lface
, 0, Qface
);
2574 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2575 Vface_new_frame_defaults
);
2577 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2578 face id to Lisp face is given by the vector lface_id_to_name.
2579 The mapping from Lisp face to Lisp face id is given by the
2580 property `face' of the Lisp face name. */
2581 if (next_lface_id
== lface_id_to_name_size
)
2583 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2584 sizeof *lface_id_to_name
);
2586 lface_id_to_name
[next_lface_id
] = face
;
2587 Fput (face
, Qface
, make_number (next_lface_id
));
2591 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2592 ASET (global_lface
, i
, Qunspecified
);
2594 /* Add a frame-local definition. */
2599 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2601 ASET (lface
, 0, Qface
);
2602 fset_face_alist (f
, Fcons (Fcons (face
, lface
), f
->face_alist
));
2605 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2606 ASET (lface
, i
, Qunspecified
);
2609 lface
= global_lface
;
2611 /* Changing a named face means that all realized faces depending on
2612 that face are invalid. Since we cannot tell which realized faces
2613 depend on the face, make sure they are all removed. This is done
2614 by incrementing face_change_count. The next call to
2615 init_iterator will then free realized faces. */
2616 if (NILP (Fget (face
, Qface_no_inherit
)))
2618 ++face_change_count
;
2619 ++windows_or_buffers_changed
;
2622 eassert (LFACEP (lface
));
2623 check_lface (lface
);
2628 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2629 Sinternal_lisp_face_p
, 1, 2, 0,
2630 doc
: /* Return non-nil if FACE names a face.
2631 FACE should be a symbol or string.
2632 If optional second argument FRAME is non-nil, check for the
2633 existence of a frame-local face with name FACE on that frame.
2634 Otherwise check for the existence of a global face. */)
2635 (Lisp_Object face
, Lisp_Object frame
)
2639 face
= resolve_face_name (face
, 1);
2643 CHECK_LIVE_FRAME (frame
);
2644 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2647 lface
= lface_from_face_name (NULL
, face
, 0);
2653 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2654 Sinternal_copy_lisp_face
, 4, 4, 0,
2655 doc
: /* Copy face FROM to TO.
2656 If FRAME is t, copy the global face definition of FROM.
2657 Otherwise, copy the frame-local definition of FROM on FRAME.
2658 If NEW-FRAME is a frame, copy that data into the frame-local
2659 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2660 FRAME controls where the data is copied to.
2662 The value is TO. */)
2663 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2665 Lisp_Object lface
, copy
;
2667 CHECK_SYMBOL (from
);
2672 /* Copy global definition of FROM. We don't make copies of
2673 strings etc. because 20.2 didn't do it either. */
2674 lface
= lface_from_face_name (NULL
, from
, 1);
2675 copy
= Finternal_make_lisp_face (to
, Qnil
);
2679 /* Copy frame-local definition of FROM. */
2680 if (NILP (new_frame
))
2682 CHECK_LIVE_FRAME (frame
);
2683 CHECK_LIVE_FRAME (new_frame
);
2684 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2685 copy
= Finternal_make_lisp_face (to
, new_frame
);
2688 vcopy (copy
, 0, XVECTOR (lface
)->u
.contents
, LFACE_VECTOR_SIZE
);
2690 /* Changing a named face means that all realized faces depending on
2691 that face are invalid. Since we cannot tell which realized faces
2692 depend on the face, make sure they are all removed. This is done
2693 by incrementing face_change_count. The next call to
2694 init_iterator will then free realized faces. */
2695 if (NILP (Fget (to
, Qface_no_inherit
)))
2697 ++face_change_count
;
2698 ++windows_or_buffers_changed
;
2705 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2706 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2707 doc
: /* Set attribute ATTR of FACE to VALUE.
2708 FRAME being a frame means change the face on that frame.
2709 FRAME nil means change the face of the selected frame.
2710 FRAME t means change the default for new frames.
2711 FRAME 0 means change the face on all frames, and change the default
2713 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2716 Lisp_Object old_value
= Qnil
;
2717 /* Set one of enum font_property_index (> 0) if ATTR is one of
2718 font-related attributes other than QCfont and QCfontset. */
2719 enum font_property_index prop_index
= 0;
2721 CHECK_SYMBOL (face
);
2722 CHECK_SYMBOL (attr
);
2724 face
= resolve_face_name (face
, 1);
2726 /* If FRAME is 0, change face on all frames, and change the
2727 default for new frames. */
2728 if (INTEGERP (frame
) && XINT (frame
) == 0)
2731 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2732 FOR_EACH_FRAME (tail
, frame
)
2733 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2737 /* Set lface to the Lisp attribute vector of FACE. */
2740 lface
= lface_from_face_name (NULL
, face
, 1);
2742 /* When updating face-new-frame-defaults, we put :ignore-defface
2743 where the caller wants `unspecified'. This forces the frame
2744 defaults to ignore the defface value. Otherwise, the defface
2745 will take effect, which is generally not what is intended.
2746 The value of that attribute will be inherited from some other
2747 face during face merging. See internal_merge_in_global_face. */
2748 if (UNSPECIFIEDP (value
))
2749 value
= QCignore_defface
;
2754 frame
= selected_frame
;
2756 CHECK_LIVE_FRAME (frame
);
2757 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2759 /* If a frame-local face doesn't exist yet, create one. */
2761 lface
= Finternal_make_lisp_face (face
, frame
);
2764 if (EQ (attr
, QCfamily
))
2766 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2768 CHECK_STRING (value
);
2769 if (SCHARS (value
) == 0)
2770 signal_error ("Invalid face family", value
);
2772 old_value
= LFACE_FAMILY (lface
);
2773 ASET (lface
, LFACE_FAMILY_INDEX
, value
);
2774 prop_index
= FONT_FAMILY_INDEX
;
2776 else if (EQ (attr
, QCfoundry
))
2778 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2780 CHECK_STRING (value
);
2781 if (SCHARS (value
) == 0)
2782 signal_error ("Invalid face foundry", value
);
2784 old_value
= LFACE_FOUNDRY (lface
);
2785 ASET (lface
, LFACE_FOUNDRY_INDEX
, value
);
2786 prop_index
= FONT_FOUNDRY_INDEX
;
2788 else if (EQ (attr
, QCheight
))
2790 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2792 if (EQ (face
, Qdefault
))
2794 /* The default face must have an absolute size. */
2795 if (!INTEGERP (value
) || XINT (value
) <= 0)
2796 signal_error ("Default face height not absolute and positive",
2801 /* For non-default faces, do a test merge with a random
2802 height to see if VALUE's ok. */
2803 Lisp_Object test
= merge_face_heights (value
,
2806 if (!INTEGERP (test
) || XINT (test
) <= 0)
2807 signal_error ("Face height does not produce a positive integer",
2812 old_value
= LFACE_HEIGHT (lface
);
2813 ASET (lface
, LFACE_HEIGHT_INDEX
, value
);
2814 prop_index
= FONT_SIZE_INDEX
;
2816 else if (EQ (attr
, QCweight
))
2818 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2820 CHECK_SYMBOL (value
);
2821 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2822 signal_error ("Invalid face weight", value
);
2824 old_value
= LFACE_WEIGHT (lface
);
2825 ASET (lface
, LFACE_WEIGHT_INDEX
, value
);
2826 prop_index
= FONT_WEIGHT_INDEX
;
2828 else if (EQ (attr
, QCslant
))
2830 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2832 CHECK_SYMBOL (value
);
2833 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2834 signal_error ("Invalid face slant", value
);
2836 old_value
= LFACE_SLANT (lface
);
2837 ASET (lface
, LFACE_SLANT_INDEX
, value
);
2838 prop_index
= FONT_SLANT_INDEX
;
2840 else if (EQ (attr
, QCunderline
))
2844 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2846 else if (NILP (value
) || EQ (value
, Qt
))
2848 else if (STRINGP (value
) && SCHARS (value
) > 0)
2850 else if (CONSP (value
))
2852 Lisp_Object key
, val
, list
;
2855 /* FIXME? This errs on the side of acceptance. Eg it accepts:
2856 (defface foo '((t :underline 'foo) "doc")
2857 Maybe this is intentional, maybe it isn't.
2858 Non-nil symbols other than t are not documented as being valid.
2859 Eg compare with inverse-video, which explicitly rejects them.
2863 while (!NILP (CAR_SAFE(list
)))
2865 key
= CAR_SAFE (list
);
2866 list
= CDR_SAFE (list
);
2867 val
= CAR_SAFE (list
);
2868 list
= CDR_SAFE (list
);
2870 if (NILP (key
) || NILP (val
))
2876 else if (EQ (key
, QCcolor
)
2877 && !(EQ (val
, Qforeground_color
)
2878 || (STRINGP (val
) && SCHARS (val
) > 0)))
2884 else if (EQ (key
, QCstyle
)
2885 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2894 signal_error ("Invalid face underline", value
);
2896 old_value
= LFACE_UNDERLINE (lface
);
2897 ASET (lface
, LFACE_UNDERLINE_INDEX
, value
);
2899 else if (EQ (attr
, QCoverline
))
2901 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2902 if ((SYMBOLP (value
)
2904 && !EQ (value
, Qnil
))
2905 /* Overline color. */
2907 && SCHARS (value
) == 0))
2908 signal_error ("Invalid face overline", value
);
2910 old_value
= LFACE_OVERLINE (lface
);
2911 ASET (lface
, LFACE_OVERLINE_INDEX
, value
);
2913 else if (EQ (attr
, QCstrike_through
))
2915 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2916 if ((SYMBOLP (value
)
2918 && !EQ (value
, Qnil
))
2919 /* Strike-through color. */
2921 && SCHARS (value
) == 0))
2922 signal_error ("Invalid face strike-through", value
);
2924 old_value
= LFACE_STRIKE_THROUGH (lface
);
2925 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, value
);
2927 else if (EQ (attr
, QCbox
))
2931 /* Allow t meaning a simple box of width 1 in foreground color
2934 value
= make_number (1);
2936 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2938 else if (NILP (value
))
2940 else if (INTEGERP (value
))
2941 valid_p
= XINT (value
) != 0;
2942 else if (STRINGP (value
))
2943 valid_p
= SCHARS (value
) > 0;
2944 else if (CONSP (value
))
2960 if (EQ (k
, QCline_width
))
2962 if (!INTEGERP (v
) || XINT (v
) == 0)
2965 else if (EQ (k
, QCcolor
))
2967 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
2970 else if (EQ (k
, QCstyle
))
2972 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
2979 valid_p
= NILP (tem
);
2985 signal_error ("Invalid face box", value
);
2987 old_value
= LFACE_BOX (lface
);
2988 ASET (lface
, LFACE_BOX_INDEX
, value
);
2990 else if (EQ (attr
, QCinverse_video
)
2991 || EQ (attr
, QCreverse_video
))
2993 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2995 CHECK_SYMBOL (value
);
2996 if (!EQ (value
, Qt
) && !NILP (value
))
2997 signal_error ("Invalid inverse-video face attribute value", value
);
2999 old_value
= LFACE_INVERSE (lface
);
3000 ASET (lface
, LFACE_INVERSE_INDEX
, value
);
3002 else if (EQ (attr
, QCforeground
))
3004 /* Compatibility with 20.x. */
3006 value
= Qunspecified
;
3007 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3009 /* Don't check for valid color names here because it depends
3010 on the frame (display) whether the color will be valid
3011 when the face is realized. */
3012 CHECK_STRING (value
);
3013 if (SCHARS (value
) == 0)
3014 signal_error ("Empty foreground color value", value
);
3016 old_value
= LFACE_FOREGROUND (lface
);
3017 ASET (lface
, LFACE_FOREGROUND_INDEX
, value
);
3019 else if (EQ (attr
, QCbackground
))
3021 /* Compatibility with 20.x. */
3023 value
= Qunspecified
;
3024 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3026 /* Don't check for valid color names here because it depends
3027 on the frame (display) whether the color will be valid
3028 when the face is realized. */
3029 CHECK_STRING (value
);
3030 if (SCHARS (value
) == 0)
3031 signal_error ("Empty background color value", value
);
3033 old_value
= LFACE_BACKGROUND (lface
);
3034 ASET (lface
, LFACE_BACKGROUND_INDEX
, value
);
3036 else if (EQ (attr
, QCstipple
))
3038 #if defined (HAVE_WINDOW_SYSTEM)
3039 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3041 && NILP (Fbitmap_spec_p (value
)))
3042 signal_error ("Invalid stipple attribute", value
);
3043 old_value
= LFACE_STIPPLE (lface
);
3044 ASET (lface
, LFACE_STIPPLE_INDEX
, value
);
3045 #endif /* HAVE_WINDOW_SYSTEM */
3047 else if (EQ (attr
, QCwidth
))
3049 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3051 CHECK_SYMBOL (value
);
3052 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3053 signal_error ("Invalid face width", value
);
3055 old_value
= LFACE_SWIDTH (lface
);
3056 ASET (lface
, LFACE_SWIDTH_INDEX
, value
);
3057 prop_index
= FONT_WIDTH_INDEX
;
3059 else if (EQ (attr
, QCfont
))
3061 #ifdef HAVE_WINDOW_SYSTEM
3062 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3064 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3068 old_value
= LFACE_FONT (lface
);
3069 if (! FONTP (value
))
3071 if (STRINGP (value
))
3073 Lisp_Object name
= value
;
3074 int fontset
= fs_query_fontset (name
, 0);
3077 name
= fontset_ascii (fontset
);
3078 value
= font_spec_from_name (name
);
3080 signal_error ("Invalid font name", name
);
3083 signal_error ("Invalid font or font-spec", value
);
3086 f
= XFRAME (selected_frame
);
3089 if (! FONT_OBJECT_P (value
))
3091 Lisp_Object
*attrs
= XVECTOR (lface
)->u
.contents
;
3092 Lisp_Object font_object
;
3094 font_object
= font_load_for_lface (f
, attrs
, value
);
3095 if (NILP (font_object
))
3096 signal_error ("Font not available", value
);
3097 value
= font_object
;
3099 set_lface_from_font (f
, lface
, value
, 1);
3102 ASET (lface
, LFACE_FONT_INDEX
, value
);
3104 #endif /* HAVE_WINDOW_SYSTEM */
3106 else if (EQ (attr
, QCfontset
))
3108 #ifdef HAVE_WINDOW_SYSTEM
3109 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3113 old_value
= LFACE_FONTSET (lface
);
3114 tmp
= Fquery_fontset (value
, Qnil
);
3116 signal_error ("Invalid fontset name", value
);
3117 ASET (lface
, LFACE_FONTSET_INDEX
, value
= tmp
);
3119 #endif /* HAVE_WINDOW_SYSTEM */
3121 else if (EQ (attr
, QCinherit
))
3124 if (SYMBOLP (value
))
3127 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3128 if (!SYMBOLP (XCAR (tail
)))
3131 ASET (lface
, LFACE_INHERIT_INDEX
, value
);
3133 signal_error ("Invalid face inheritance", value
);
3135 else if (EQ (attr
, QCbold
))
3137 old_value
= LFACE_WEIGHT (lface
);
3138 ASET (lface
, LFACE_WEIGHT_INDEX
, NILP (value
) ? Qnormal
: Qbold
);
3139 prop_index
= FONT_WEIGHT_INDEX
;
3141 else if (EQ (attr
, QCitalic
))
3144 old_value
= LFACE_SLANT (lface
);
3145 ASET (lface
, LFACE_SLANT_INDEX
, NILP (value
) ? Qnormal
: Qitalic
);
3146 prop_index
= FONT_SLANT_INDEX
;
3149 signal_error ("Invalid face attribute name", attr
);
3153 /* If a font-related attribute other than QCfont and QCfontset
3154 is specified, and if the original QCfont attribute has a font
3155 (font-spec or font-object), set the corresponding property in
3156 the font to nil so that the font selector doesn't think that
3157 the attribute is mandatory. Also, clear the average
3159 font_clear_prop (XVECTOR (lface
)->u
.contents
, prop_index
);
3162 /* Changing a named face means that all realized faces depending on
3163 that face are invalid. Since we cannot tell which realized faces
3164 depend on the face, make sure they are all removed. This is done
3165 by incrementing face_change_count. The next call to
3166 init_iterator will then free realized faces. */
3168 && NILP (Fget (face
, Qface_no_inherit
))
3169 && NILP (Fequal (old_value
, value
)))
3171 ++face_change_count
;
3172 ++windows_or_buffers_changed
;
3175 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3176 && NILP (Fequal (old_value
, value
)))
3182 if (EQ (face
, Qdefault
))
3184 #ifdef HAVE_WINDOW_SYSTEM
3185 /* Changed font-related attributes of the `default' face are
3186 reflected in changed `font' frame parameters. */
3188 && (prop_index
|| EQ (attr
, QCfont
))
3189 && lface_fully_specified_p (XVECTOR (lface
)->u
.contents
))
3190 set_font_frame_param (frame
, lface
);
3192 #endif /* HAVE_WINDOW_SYSTEM */
3194 if (EQ (attr
, QCforeground
))
3195 param
= Qforeground_color
;
3196 else if (EQ (attr
, QCbackground
))
3197 param
= Qbackground_color
;
3199 #ifdef HAVE_WINDOW_SYSTEM
3201 else if (EQ (face
, Qscroll_bar
))
3203 /* Changing the colors of `scroll-bar' sets frame parameters
3204 `scroll-bar-foreground' and `scroll-bar-background'. */
3205 if (EQ (attr
, QCforeground
))
3206 param
= Qscroll_bar_foreground
;
3207 else if (EQ (attr
, QCbackground
))
3208 param
= Qscroll_bar_background
;
3210 #endif /* not HAVE_NTGUI */
3211 else if (EQ (face
, Qborder
))
3213 /* Changing background color of `border' sets frame parameter
3215 if (EQ (attr
, QCbackground
))
3216 param
= Qborder_color
;
3218 else if (EQ (face
, Qcursor
))
3220 /* Changing background color of `cursor' sets frame parameter
3222 if (EQ (attr
, QCbackground
))
3223 param
= Qcursor_color
;
3225 else if (EQ (face
, Qmouse
))
3227 /* Changing background color of `mouse' sets frame parameter
3229 if (EQ (attr
, QCbackground
))
3230 param
= Qmouse_color
;
3232 #endif /* HAVE_WINDOW_SYSTEM */
3233 else if (EQ (face
, Qmenu
))
3235 /* Indicate that we have to update the menu bar when realizing
3236 faces on FRAME. FRAME t change the default for new frames.
3237 We do this by setting the flag in new face caches. */
3240 struct frame
*f
= XFRAME (frame
);
3241 if (FRAME_FACE_CACHE (f
) == NULL
)
3242 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3243 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3246 menu_face_changed_default
= 1;
3252 /* Update `default-frame-alist', which is used for new frames. */
3254 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3257 /* Update the current frame's parameters. */
3260 cons
= XCAR (Vparam_value_alist
);
3261 XSETCAR (cons
, param
);
3262 XSETCDR (cons
, value
);
3263 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3272 /* Update the corresponding face when frame parameter PARAM on frame F
3273 has been assigned the value NEW_VALUE. */
3276 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3277 Lisp_Object new_value
)
3279 Lisp_Object face
= Qnil
;
3282 /* If there are no faces yet, give up. This is the case when called
3283 from Fx_create_frame, and we do the necessary things later in
3284 face-set-after-frame-defaults. */
3285 if (NILP (f
->face_alist
))
3288 if (EQ (param
, Qforeground_color
))
3291 lface
= lface_from_face_name (f
, face
, 1);
3292 ASET (lface
, LFACE_FOREGROUND_INDEX
,
3293 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3294 realize_basic_faces (f
);
3296 else if (EQ (param
, Qbackground_color
))
3300 /* Changing the background color might change the background
3301 mode, so that we have to load new defface specs.
3302 Call frame-set-background-mode to do that. */
3303 XSETFRAME (frame
, f
);
3304 call1 (Qframe_set_background_mode
, frame
);
3307 lface
= lface_from_face_name (f
, face
, 1);
3308 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3309 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3310 realize_basic_faces (f
);
3312 #ifdef HAVE_WINDOW_SYSTEM
3313 else if (EQ (param
, Qborder_color
))
3316 lface
= lface_from_face_name (f
, face
, 1);
3317 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3318 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3320 else if (EQ (param
, Qcursor_color
))
3323 lface
= lface_from_face_name (f
, face
, 1);
3324 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3325 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3327 else if (EQ (param
, Qmouse_color
))
3330 lface
= lface_from_face_name (f
, face
, 1);
3331 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3332 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3336 /* Changing a named face means that all realized faces depending on
3337 that face are invalid. Since we cannot tell which realized faces
3338 depend on the face, make sure they are all removed. This is done
3339 by incrementing face_change_count. The next call to
3340 init_iterator will then free realized faces. */
3342 && NILP (Fget (face
, Qface_no_inherit
)))
3344 ++face_change_count
;
3345 ++windows_or_buffers_changed
;
3350 #ifdef HAVE_WINDOW_SYSTEM
3352 /* Set the `font' frame parameter of FRAME determined from the
3353 font-object set in `default' face attributes LFACE. */
3356 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3358 struct frame
*f
= XFRAME (frame
);
3361 if (FRAME_WINDOW_P (f
)
3362 /* Don't do anything if the font is `unspecified'. This can
3363 happen during frame creation. */
3364 && (font
= LFACE_FONT (lface
),
3365 ! UNSPECIFIEDP (font
)))
3367 if (FONT_SPEC_P (font
))
3369 font
= font_load_for_lface (f
, XVECTOR (lface
)->u
.contents
, font
);
3372 ASET (lface
, LFACE_FONT_INDEX
, font
);
3374 f
->default_face_done_p
= 0;
3375 Fmodify_frame_parameters (frame
, list1 (Fcons (Qfont
, font
)));
3379 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3380 Sinternal_face_x_get_resource
, 2, 3, 0,
3381 doc
: /* Get the value of X resource RESOURCE, class CLASS.
3382 Returned value is for the display of frame FRAME. If FRAME is not
3383 specified or nil, use selected frame. This function exists because
3384 ordinary `x-get-resource' doesn't take a frame argument. */)
3385 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3387 Lisp_Object value
= Qnil
;
3390 CHECK_STRING (resource
);
3391 CHECK_STRING (class);
3392 f
= decode_live_frame (frame
);
3394 value
= display_x_get_resource (FRAME_DISPLAY_INFO (f
),
3395 resource
, class, Qnil
, Qnil
);
3401 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3402 If VALUE is "on" or "true", return t. If VALUE is "off" or
3403 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3404 error; if SIGNAL_P is zero, return 0. */
3407 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3409 Lisp_Object result
= make_number (0);
3411 eassert (STRINGP (value
));
3413 if (xstrcasecmp (SSDATA (value
), "on") == 0
3414 || xstrcasecmp (SSDATA (value
), "true") == 0)
3416 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3417 || xstrcasecmp (SSDATA (value
), "false") == 0)
3419 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3420 result
= Qunspecified
;
3422 signal_error ("Invalid face attribute value from X resource", value
);
3428 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3429 Finternal_set_lisp_face_attribute_from_resource
,
3430 Sinternal_set_lisp_face_attribute_from_resource
,
3431 3, 4, 0, doc
: /* */)
3432 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3434 CHECK_SYMBOL (face
);
3435 CHECK_SYMBOL (attr
);
3436 CHECK_STRING (value
);
3438 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3439 value
= Qunspecified
;
3440 else if (EQ (attr
, QCheight
))
3442 value
= Fstring_to_number (value
, make_number (10));
3443 if (XINT (value
) <= 0)
3444 signal_error ("Invalid face height from X resource", value
);
3446 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3447 value
= face_boolean_x_resource_value (value
, 1);
3448 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3449 value
= intern (SSDATA (value
));
3450 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3451 value
= face_boolean_x_resource_value (value
, 1);
3452 else if (EQ (attr
, QCunderline
)
3453 || EQ (attr
, QCoverline
)
3454 || EQ (attr
, QCstrike_through
))
3456 Lisp_Object boolean_value
;
3458 /* If the result of face_boolean_x_resource_value is t or nil,
3459 VALUE does NOT specify a color. */
3460 boolean_value
= face_boolean_x_resource_value (value
, 0);
3461 if (SYMBOLP (boolean_value
))
3462 value
= boolean_value
;
3464 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3465 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3467 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3470 #endif /* HAVE_WINDOW_SYSTEM */
3473 /***********************************************************************
3475 ***********************************************************************/
3477 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3479 /* Make menus on frame F appear as specified by the `menu' face. */
3482 x_update_menu_appearance (struct frame
*f
)
3484 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
3488 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3493 ptrdiff_t bufsize
= sizeof line
;
3494 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3495 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3496 const char *myname
= SSDATA (Vx_resource_name
);
3499 const char *popup_path
= "popup_menu";
3501 const char *popup_path
= "menu.popup";
3504 if (STRINGP (LFACE_FOREGROUND (lface
)))
3506 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3508 SDATA (LFACE_FOREGROUND (lface
)));
3509 XrmPutLineResource (&rdb
, line
);
3510 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3511 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3512 XrmPutLineResource (&rdb
, line
);
3516 if (STRINGP (LFACE_BACKGROUND (lface
)))
3518 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3520 SDATA (LFACE_BACKGROUND (lface
)));
3521 XrmPutLineResource (&rdb
, line
);
3523 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3524 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3525 XrmPutLineResource (&rdb
, line
);
3530 /* On Solaris 5.8, it's been reported that the `menu' face
3531 can be unspecified here, during startup. Why this
3532 happens remains unknown. -- cyd */
3533 && FONTP (LFACE_FONT (lface
))
3534 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3535 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3536 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3537 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3538 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3539 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3541 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3543 const char *suffix
= "List";
3546 #if defined HAVE_X_I18N
3548 const char *suffix
= "Set";
3550 const char *suffix
= "";
3557 #if defined HAVE_X_I18N
3558 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3560 char *fontsetname
= SSDATA (xlfd
);
3562 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3563 myname
, suffix
, fontsetname
);
3564 XrmPutLineResource (&rdb
, line
);
3566 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3567 myname
, popup_path
, suffix
, fontsetname
);
3568 XrmPutLineResource (&rdb
, line
);
3570 if (fontsetname
!= SSDATA (xlfd
))
3571 xfree (fontsetname
);
3575 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3576 free_frame_menubar (f
);
3583 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3586 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3587 Sface_attribute_relative_p
,
3589 doc
: /* Check whether a face attribute value is relative.
3590 Specifically, this function returns t if the attribute ATTRIBUTE
3591 with the value VALUE is relative.
3593 A relative value is one that doesn't entirely override whatever is
3594 inherited from another face. For most possible attributes,
3595 the only relative value that users see is `unspecified'.
3596 However, for :height, floating point values are also relative. */)
3597 (Lisp_Object attribute
, Lisp_Object value
)
3599 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3601 else if (EQ (attribute
, QCheight
))
3602 return INTEGERP (value
) ? Qnil
: Qt
;
3607 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3609 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3610 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3611 the result will be absolute, otherwise it will be relative. */)
3612 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3614 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3616 else if (EQ (attribute
, QCheight
))
3617 return merge_face_heights (value1
, value2
, value1
);
3623 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3624 Sinternal_get_lisp_face_attribute
,
3626 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3627 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3628 face attribute name, signal an error.
3629 If the optional argument FRAME is given, report on face SYMBOL in that
3630 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3631 frames). If FRAME is omitted or nil, use the selected frame. */)
3632 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3634 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3635 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 1), value
= Qnil
;
3637 CHECK_SYMBOL (symbol
);
3638 CHECK_SYMBOL (keyword
);
3640 if (EQ (keyword
, QCfamily
))
3641 value
= LFACE_FAMILY (lface
);
3642 else if (EQ (keyword
, QCfoundry
))
3643 value
= LFACE_FOUNDRY (lface
);
3644 else if (EQ (keyword
, QCheight
))
3645 value
= LFACE_HEIGHT (lface
);
3646 else if (EQ (keyword
, QCweight
))
3647 value
= LFACE_WEIGHT (lface
);
3648 else if (EQ (keyword
, QCslant
))
3649 value
= LFACE_SLANT (lface
);
3650 else if (EQ (keyword
, QCunderline
))
3651 value
= LFACE_UNDERLINE (lface
);
3652 else if (EQ (keyword
, QCoverline
))
3653 value
= LFACE_OVERLINE (lface
);
3654 else if (EQ (keyword
, QCstrike_through
))
3655 value
= LFACE_STRIKE_THROUGH (lface
);
3656 else if (EQ (keyword
, QCbox
))
3657 value
= LFACE_BOX (lface
);
3658 else if (EQ (keyword
, QCinverse_video
)
3659 || EQ (keyword
, QCreverse_video
))
3660 value
= LFACE_INVERSE (lface
);
3661 else if (EQ (keyword
, QCforeground
))
3662 value
= LFACE_FOREGROUND (lface
);
3663 else if (EQ (keyword
, QCbackground
))
3664 value
= LFACE_BACKGROUND (lface
);
3665 else if (EQ (keyword
, QCstipple
))
3666 value
= LFACE_STIPPLE (lface
);
3667 else if (EQ (keyword
, QCwidth
))
3668 value
= LFACE_SWIDTH (lface
);
3669 else if (EQ (keyword
, QCinherit
))
3670 value
= LFACE_INHERIT (lface
);
3671 else if (EQ (keyword
, QCfont
))
3672 value
= LFACE_FONT (lface
);
3673 else if (EQ (keyword
, QCfontset
))
3674 value
= LFACE_FONTSET (lface
);
3676 signal_error ("Invalid face attribute name", keyword
);
3678 if (IGNORE_DEFFACE_P (value
))
3679 return Qunspecified
;
3685 DEFUN ("internal-lisp-face-attribute-values",
3686 Finternal_lisp_face_attribute_values
,
3687 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3688 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3689 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3692 Lisp_Object result
= Qnil
;
3694 CHECK_SYMBOL (attr
);
3696 if (EQ (attr
, QCunderline
) || EQ (attr
, QCoverline
)
3697 || EQ (attr
, QCstrike_through
)
3698 || EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3699 result
= list2 (Qt
, Qnil
);
3705 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3706 Sinternal_merge_in_global_face
, 2, 2, 0,
3707 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3708 Default face attributes override any local face attributes. */)
3709 (Lisp_Object face
, Lisp_Object frame
)
3712 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3713 struct frame
*f
= XFRAME (frame
);
3715 CHECK_LIVE_FRAME (frame
);
3716 global_lface
= lface_from_face_name (NULL
, face
, 1);
3717 local_lface
= lface_from_face_name (f
, face
, 0);
3718 if (NILP (local_lface
))
3719 local_lface
= Finternal_make_lisp_face (face
, frame
);
3721 /* Make every specified global attribute override the local one.
3722 BEWARE!! This is only used from `face-set-after-frame-default' where
3723 the local frame is defined from default specs in `face-defface-spec'
3724 and those should be overridden by global settings. Hence the strange
3725 "global before local" priority. */
3726 lvec
= XVECTOR (local_lface
)->u
.contents
;
3727 gvec
= XVECTOR (global_lface
)->u
.contents
;
3728 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3729 if (IGNORE_DEFFACE_P (gvec
[i
]))
3730 ASET (local_lface
, i
, Qunspecified
);
3731 else if (! UNSPECIFIEDP (gvec
[i
]))
3732 ASET (local_lface
, i
, AREF (global_lface
, i
));
3734 /* If the default face was changed, update the face cache and the
3735 `font' frame parameter. */
3736 if (EQ (face
, Qdefault
))
3738 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3739 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3740 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3742 /* This can be NULL (e.g., in batch mode). */
3745 /* Ensure that the face vector is fully specified by merging
3746 the previously-cached vector. */
3747 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3748 merge_face_vectors (f
, lvec
, attrs
, 0);
3749 vcopy (local_lface
, 0, attrs
, LFACE_VECTOR_SIZE
);
3750 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3752 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3753 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3754 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3755 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3756 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3757 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3758 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3761 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3762 Fmodify_frame_parameters (frame
, list1 (Fcons (Qfont
, name
)));
3765 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3766 Fmodify_frame_parameters (frame
,
3767 list1 (Fcons (Qforeground_color
,
3768 gvec
[LFACE_FOREGROUND_INDEX
])));
3770 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3771 Fmodify_frame_parameters (frame
,
3772 list1 (Fcons (Qbackground_color
,
3773 gvec
[LFACE_BACKGROUND_INDEX
])));
3781 /* The following function is implemented for compatibility with 20.2.
3782 The function is used in x-resolve-fonts when it is asked to
3783 return fonts with the same size as the font of a face. This is
3784 done in fontset.el. */
3786 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3787 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3788 The font name is, by default, for ASCII characters.
3789 If the optional argument FRAME is given, report on face FACE in that frame.
3790 If FRAME is t, report on the defaults for face FACE (for new frames).
3791 The font default for a face is either nil, or a list
3792 of the form (bold), (italic) or (bold italic).
3793 If FRAME is omitted or nil, use the selected frame. And, in this case,
3794 if the optional third argument CHARACTER is given,
3795 return the font name used for CHARACTER. */)
3796 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3800 Lisp_Object result
= Qnil
;
3801 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3803 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3804 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3805 result
= Fcons (Qbold
, result
);
3807 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3808 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3809 result
= Fcons (Qitalic
, result
);
3815 struct frame
*f
= decode_live_frame (frame
);
3816 int face_id
= lookup_named_face (f
, face
, 1);
3817 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3821 #ifdef HAVE_WINDOW_SYSTEM
3822 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3824 CHECK_CHARACTER (character
);
3825 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3826 fface
= FACE_FROM_ID (f
, face_id
);
3829 ? fface
->font
->props
[FONT_NAME_INDEX
]
3831 #else /* !HAVE_WINDOW_SYSTEM */
3832 return build_string (FRAME_MSDOS_P (f
)
3834 : FRAME_W32_P (f
) ? "w32term"
3841 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3842 all attributes are `equal'. Tries to be fast because this function
3843 is called quite often. */
3846 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3848 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3849 and the other is specified. */
3850 if (XTYPE (v1
) != XTYPE (v2
))
3859 if (SBYTES (v1
) != SBYTES (v2
))
3862 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3869 return !NILP (Fequal (v1
, v2
));
3874 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3875 all attributes are `equal'. Tries to be fast because this function
3876 is called quite often. */
3879 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3884 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3885 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3891 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3892 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3893 doc
: /* True if FACE1 and FACE2 are equal.
3894 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3895 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3896 If FRAME is omitted or nil, use the selected frame. */)
3897 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3901 Lisp_Object lface1
, lface2
;
3903 /* Don't use decode_window_system_frame here because this function
3904 is called before X frames exist. At that time, if FRAME is nil,
3905 selected_frame will be used which is the frame dumped with
3906 Emacs. That frame is not an X frame. */
3907 f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3909 lface1
= lface_from_face_name (f
, face1
, 1);
3910 lface2
= lface_from_face_name (f
, face2
, 1);
3911 equal_p
= lface_equal_p (XVECTOR (lface1
)->u
.contents
,
3912 XVECTOR (lface2
)->u
.contents
);
3913 return equal_p
? Qt
: Qnil
;
3917 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3918 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3919 doc
: /* True if FACE has no attribute specified.
3920 If the optional argument FRAME is given, report on face FACE in that frame.
3921 If FRAME is t, report on the defaults for face FACE (for new frames).
3922 If FRAME is omitted or nil, use the selected frame. */)
3923 (Lisp_Object face
, Lisp_Object frame
)
3925 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3926 Lisp_Object lface
= lface_from_face_name (f
, face
, 1);
3929 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3930 if (!UNSPECIFIEDP (AREF (lface
, i
)))
3933 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3937 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
3939 doc
: /* Return an alist of frame-local faces defined on FRAME.
3940 For internal use only. */)
3943 return decode_live_frame (frame
)->face_alist
;
3947 /* Return a hash code for Lisp string STRING with case ignored. Used
3948 below in computing a hash value for a Lisp face. */
3951 hash_string_case_insensitive (Lisp_Object string
)
3953 const unsigned char *s
;
3955 eassert (STRINGP (string
));
3956 for (s
= SDATA (string
); *s
; ++s
)
3957 hash
= (hash
<< 1) ^ c_tolower (*s
);
3962 /* Return a hash code for face attribute vector V. */
3965 lface_hash (Lisp_Object
*v
)
3967 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
3968 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
3969 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
3970 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
3971 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
3972 ^ XHASH (v
[LFACE_SLANT_INDEX
])
3973 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
3974 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
3977 #ifdef HAVE_WINDOW_SYSTEM
3979 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
3980 considering charsets/registries). They do if they specify the same
3981 family, point size, weight, width, slant, and font. Both
3982 LFACE1 and LFACE2 must be fully-specified. */
3985 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
3987 eassert (lface_fully_specified_p (lface1
)
3988 && lface_fully_specified_p (lface2
));
3989 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
3990 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
3991 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
3992 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
3993 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
3994 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
3995 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
3996 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
3997 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
3998 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
3999 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4000 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4001 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4002 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4006 #endif /* HAVE_WINDOW_SYSTEM */
4008 /***********************************************************************
4010 ***********************************************************************/
4012 /* Allocate and return a new realized face for Lisp face attribute
4015 static struct face
*
4016 make_realized_face (Lisp_Object
*attr
)
4018 struct face
*face
= xzalloc (sizeof *face
);
4019 face
->ascii_face
= face
;
4020 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4025 /* Free realized face FACE, including its X resources. FACE may
4029 free_realized_face (struct frame
*f
, struct face
*face
)
4033 #ifdef HAVE_WINDOW_SYSTEM
4034 if (FRAME_WINDOW_P (f
))
4036 /* Free fontset of FACE if it is ASCII face. */
4037 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4038 free_face_fontset (f
, face
);
4043 font_done_for_face (f
, face
);
4044 x_free_gc (f
, face
->gc
);
4049 free_face_colors (f
, face
);
4050 x_destroy_bitmap (f
, face
->stipple
);
4052 #endif /* HAVE_WINDOW_SYSTEM */
4059 /* Prepare face FACE for subsequent display on frame F. This
4060 allocated GCs if they haven't been allocated yet or have been freed
4061 by clearing the face cache. */
4064 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4066 #ifdef HAVE_WINDOW_SYSTEM
4067 eassert (FRAME_WINDOW_P (f
));
4072 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4074 xgcv
.foreground
= face
->foreground
;
4075 xgcv
.background
= face
->background
;
4076 #ifdef HAVE_X_WINDOWS
4077 xgcv
.graphics_exposures
= False
;
4081 #ifdef HAVE_X_WINDOWS
4084 xgcv
.fill_style
= FillOpaqueStippled
;
4085 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4086 mask
|= GCFillStyle
| GCStipple
;
4089 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4091 font_prepare_for_face (f
, face
);
4094 #endif /* HAVE_WINDOW_SYSTEM */
4098 /* Returns the `distance' between the colors X and Y. */
4101 color_distance (XColor
*x
, XColor
*y
)
4103 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4104 Quoting from that paper:
4106 This formula has results that are very close to L*u*v* (with the
4107 modified lightness curve) and, more importantly, it is a more even
4108 algorithm: it does not have a range of colors where it suddenly
4109 gives far from optimal results.
4111 See <http://www.compuphase.com/cmetric.htm> for more info. */
4113 long r
= (x
->red
- y
->red
) >> 8;
4114 long g
= (x
->green
- y
->green
) >> 8;
4115 long b
= (x
->blue
- y
->blue
) >> 8;
4116 long r_mean
= (x
->red
+ y
->red
) >> 9;
4119 (((512 + r_mean
) * r
* r
) >> 8)
4121 + (((767 - r_mean
) * b
* b
) >> 8);
4125 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4126 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4127 COLOR1 and COLOR2 may be either strings containing the color name,
4128 or lists of the form (RED GREEN BLUE).
4129 If FRAME is unspecified or nil, the current frame is used. */)
4130 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4132 struct frame
*f
= decode_live_frame (frame
);
4133 XColor cdef1
, cdef2
;
4135 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4136 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4137 signal_error ("Invalid color", color1
);
4138 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4139 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4140 signal_error ("Invalid color", color2
);
4142 return make_number (color_distance (&cdef1
, &cdef2
));
4146 /***********************************************************************
4148 ***********************************************************************/
4150 /* Return a new face cache for frame F. */
4152 static struct face_cache
*
4153 make_face_cache (struct frame
*f
)
4155 struct face_cache
*c
= xmalloc (sizeof *c
);
4157 c
->buckets
= xzalloc (FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
);
4160 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4162 c
->menu_face_changed_p
= menu_face_changed_default
;
4166 #ifdef HAVE_WINDOW_SYSTEM
4168 /* Clear out all graphics contexts for all realized faces, except for
4169 the basic faces. This should be done from time to time just to avoid
4170 keeping too many graphics contexts that are no longer needed. */
4173 clear_face_gcs (struct face_cache
*c
)
4175 if (c
&& FRAME_WINDOW_P (c
->f
))
4178 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4180 struct face
*face
= c
->faces_by_id
[i
];
4181 if (face
&& face
->gc
)
4185 font_done_for_face (c
->f
, face
);
4186 x_free_gc (c
->f
, face
->gc
);
4194 #endif /* HAVE_WINDOW_SYSTEM */
4196 /* Free all realized faces in face cache C, including basic faces.
4197 C may be null. If faces are freed, make sure the frame's current
4198 matrix is marked invalid, so that a display caused by an expose
4199 event doesn't try to use faces we destroyed. */
4202 free_realized_faces (struct face_cache
*c
)
4207 struct frame
*f
= c
->f
;
4209 /* We must block input here because we can't process X events
4210 safely while only some faces are freed, or when the frame's
4211 current matrix still references freed faces. */
4214 for (i
= 0; i
< c
->used
; ++i
)
4216 free_realized_face (f
, c
->faces_by_id
[i
]);
4217 c
->faces_by_id
[i
] = NULL
;
4221 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4222 memset (c
->buckets
, 0, size
);
4224 /* Must do a thorough redisplay the next time. Mark current
4225 matrices as invalid because they will reference faces freed
4226 above. This function is also called when a frame is
4227 destroyed. In this case, the root window of F is nil. */
4228 if (WINDOWP (f
->root_window
))
4230 clear_current_matrices (f
);
4231 ++windows_or_buffers_changed
;
4239 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4240 This is done after attributes of a named face have been changed,
4241 because we can't tell which realized faces depend on that face. */
4244 free_all_realized_faces (Lisp_Object frame
)
4249 FOR_EACH_FRAME (rest
, frame
)
4250 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4253 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4257 /* Free face cache C and faces in it, including their X resources. */
4260 free_face_cache (struct face_cache
*c
)
4264 free_realized_faces (c
);
4266 xfree (c
->faces_by_id
);
4272 /* Cache realized face FACE in face cache C. HASH is the hash value
4273 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4274 FACE), insert the new face to the beginning of the collision list
4275 of the face hash table of C. Otherwise, add the new face to the
4276 end of the collision list. This way, lookup_face can quickly find
4277 that a requested face is not cached. */
4280 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4282 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4286 if (face
->ascii_face
!= face
)
4288 struct face
*last
= c
->buckets
[i
];
4299 c
->buckets
[i
] = face
;
4300 face
->prev
= face
->next
= NULL
;
4306 face
->next
= c
->buckets
[i
];
4308 face
->next
->prev
= face
;
4309 c
->buckets
[i
] = face
;
4312 /* Find a free slot in C->faces_by_id and use the index of the free
4313 slot as FACE->id. */
4314 for (i
= 0; i
< c
->used
; ++i
)
4315 if (c
->faces_by_id
[i
] == NULL
)
4320 /* Check that FACE got a unique id. */
4325 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4326 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4332 #endif /* GLYPH_DEBUG */
4334 /* Maybe enlarge C->faces_by_id. */
4337 if (c
->used
== c
->size
)
4338 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4339 sizeof *c
->faces_by_id
);
4343 c
->faces_by_id
[i
] = face
;
4347 /* Remove face FACE from cache C. */
4350 uncache_face (struct face_cache
*c
, struct face
*face
)
4352 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4355 face
->prev
->next
= face
->next
;
4357 c
->buckets
[i
] = face
->next
;
4360 face
->next
->prev
= face
->prev
;
4362 c
->faces_by_id
[face
->id
] = NULL
;
4363 if (face
->id
== c
->used
)
4368 /* Look up a realized face with face attributes ATTR in the face cache
4369 of frame F. The face will be used to display ASCII characters.
4370 Value is the ID of the face found. If no suitable face is found,
4371 realize a new one. */
4374 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4376 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4381 eassert (cache
!= NULL
);
4382 check_lface_attrs (attr
);
4384 /* Look up ATTR in the face cache. */
4385 hash
= lface_hash (attr
);
4386 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4388 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4390 if (face
->ascii_face
!= face
)
4392 /* There's no more ASCII face. */
4396 if (face
->hash
== hash
4397 && lface_equal_p (face
->lface
, attr
))
4401 /* If not found, realize a new face. */
4403 face
= realize_face (cache
, attr
, -1);
4406 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4407 #endif /* GLYPH_DEBUG */
4412 #ifdef HAVE_WINDOW_SYSTEM
4413 /* Look up a realized face that has the same attributes as BASE_FACE
4414 except for the font in the face cache of frame F. If FONT-OBJECT
4415 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4416 the face has no font. Value is the ID of the face found. If no
4417 suitable face is found, realize a new one. */
4420 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4422 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4427 eassert (cache
!= NULL
);
4428 base_face
= base_face
->ascii_face
;
4429 hash
= lface_hash (base_face
->lface
);
4430 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4432 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4434 if (face
->ascii_face
== face
)
4436 if (face
->ascii_face
== base_face
4437 && face
->font
== (NILP (font_object
) ? NULL
4438 : XFONT_OBJECT (font_object
))
4439 && lface_equal_p (face
->lface
, base_face
->lface
))
4443 /* If not found, realize a new face. */
4444 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4447 #endif /* HAVE_WINDOW_SYSTEM */
4449 /* Return the face id of the realized face for named face SYMBOL on
4450 frame F suitable for displaying ASCII characters. Value is -1 if
4451 the face couldn't be determined, which might happen if the default
4452 face isn't realized and cannot be realized. */
4455 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4457 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4458 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4459 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4461 if (default_face
== NULL
)
4463 if (!realize_basic_faces (f
))
4465 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4466 if (default_face
== NULL
)
4467 emacs_abort (); /* realize_basic_faces must have set it up */
4470 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4473 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4474 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4476 return lookup_face (f
, attrs
);
4480 /* Return the display face-id of the basic face whose canonical face-id
4481 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4482 basic face has bee remapped via Vface_remapping_alist. This function is
4483 conservative: if something goes wrong, it will simply return FACE_ID
4484 rather than signal an error. */
4487 lookup_basic_face (struct frame
*f
, int face_id
)
4489 Lisp_Object name
, mapping
;
4490 int remapped_face_id
;
4492 if (NILP (Vface_remapping_alist
))
4493 return face_id
; /* Nothing to do. */
4497 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4498 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4499 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4500 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4501 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4502 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4503 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4504 case BORDER_FACE_ID
: name
= Qborder
; break;
4505 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4506 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4507 case MENU_FACE_ID
: name
= Qmenu
; break;
4510 emacs_abort (); /* the caller is supposed to pass us a basic face id */
4513 /* Do a quick scan through Vface_remapping_alist, and return immediately
4514 if there is no remapping for face NAME. This is just an optimization
4515 for the very common no-remapping case. */
4516 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4518 return face_id
; /* Give up. */
4520 /* If there is a remapping entry, lookup the face using NAME, which will
4521 handle the remapping too. */
4522 remapped_face_id
= lookup_named_face (f
, name
, 0);
4523 if (remapped_face_id
< 0)
4524 return face_id
; /* Give up. */
4526 return remapped_face_id
;
4530 /* Return a face for charset ASCII that is like the face with id
4531 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4532 STEPS < 0 means larger. Value is the id of the face. */
4535 smaller_face (struct frame
*f
, int face_id
, int steps
)
4537 #ifdef HAVE_WINDOW_SYSTEM
4539 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4540 int pt
, last_pt
, last_height
;
4543 struct face
*new_face
;
4545 /* If not called for an X frame, just return the original face. */
4546 if (FRAME_TERMCAP_P (f
))
4549 /* Try in increments of 1/2 pt. */
4550 delta
= steps
< 0 ? 5 : -5;
4551 steps
= eabs (steps
);
4553 face
= FACE_FROM_ID (f
, face_id
);
4554 memcpy (attrs
, face
->lface
, sizeof attrs
);
4555 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4556 new_face_id
= face_id
;
4557 last_height
= FONT_HEIGHT (face
->font
);
4561 /* Give up if we cannot find a font within 10pt. */
4562 && eabs (last_pt
- pt
) < 100)
4564 /* Look up a face for a slightly smaller/larger font. */
4566 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4567 new_face_id
= lookup_face (f
, attrs
);
4568 new_face
= FACE_FROM_ID (f
, new_face_id
);
4570 /* If height changes, count that as one step. */
4571 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4572 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4575 last_height
= FONT_HEIGHT (new_face
->font
);
4582 #else /* not HAVE_WINDOW_SYSTEM */
4586 #endif /* not HAVE_WINDOW_SYSTEM */
4590 /* Return a face for charset ASCII that is like the face with id
4591 FACE_ID on frame F, but has height HEIGHT. */
4594 face_with_height (struct frame
*f
, int face_id
, int height
)
4596 #ifdef HAVE_WINDOW_SYSTEM
4598 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4600 if (FRAME_TERMCAP_P (f
)
4604 face
= FACE_FROM_ID (f
, face_id
);
4605 memcpy (attrs
, face
->lface
, sizeof attrs
);
4606 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4607 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4608 face_id
= lookup_face (f
, attrs
);
4609 #endif /* HAVE_WINDOW_SYSTEM */
4615 /* Return the face id of the realized face for named face SYMBOL on
4616 frame F suitable for displaying ASCII characters, and use
4617 attributes of the face FACE_ID for attributes that aren't
4618 completely specified by SYMBOL. This is like lookup_named_face,
4619 except that the default attributes come from FACE_ID, not from the
4620 default face. FACE_ID is assumed to be already realized. */
4623 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4626 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4627 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4628 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4633 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4636 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4637 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4638 return lookup_face (f
, attrs
);
4641 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4642 Sface_attributes_as_vector
, 1, 1, 0,
4643 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4647 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4649 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->u
.contents
,
4656 /***********************************************************************
4657 Face capability testing
4658 ***********************************************************************/
4661 /* If the distance (as returned by color_distance) between two colors is
4662 less than this, then they are considered the same, for determining
4663 whether a color is supported or not. The range of values is 0-65535. */
4665 #define TTY_SAME_COLOR_THRESHOLD 10000
4667 #ifdef HAVE_WINDOW_SYSTEM
4669 /* Return non-zero if all the face attributes in ATTRS are supported
4670 on the window-system frame F.
4672 The definition of `supported' is somewhat heuristic, but basically means
4673 that a face containing all the attributes in ATTRS, when merged with the
4674 default face for display, can be represented in a way that's
4676 \(1) different in appearance than the default face, and
4677 \(2) `close in spirit' to what the attributes specify, if not exact. */
4680 x_supports_face_attributes_p (struct frame
*f
,
4681 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4682 struct face
*def_face
)
4684 Lisp_Object
*def_attrs
= def_face
->lface
;
4686 /* Check that other specified attributes are different that the default
4688 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4689 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4690 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4691 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4692 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4693 def_attrs
[LFACE_INVERSE_INDEX
]))
4694 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4695 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4696 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4697 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4698 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4699 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4700 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4701 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4702 def_attrs
[LFACE_STIPPLE_INDEX
]))
4703 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4704 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4705 def_attrs
[LFACE_OVERLINE_INDEX
]))
4706 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4707 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4708 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4709 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4710 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4711 def_attrs
[LFACE_BOX_INDEX
])))
4714 /* Check font-related attributes, as those are the most commonly
4715 "unsupported" on a window-system (because of missing fonts). */
4716 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4717 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4718 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4719 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4720 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4721 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4725 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4728 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4730 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4732 face_id
= lookup_face (f
, merged_attrs
);
4733 face
= FACE_FROM_ID (f
, face_id
);
4736 error ("Cannot make face");
4738 /* If the font is the same, or no font is found, then not
4740 if (face
->font
== def_face
->font
4743 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4744 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4748 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4749 || face
->font
->driver
->case_sensitive
)
4751 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4752 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4753 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4754 s2
, make_number (0), Qnil
, Qt
), Qt
))
4760 /* Everything checks out, this face is supported. */
4764 #endif /* HAVE_WINDOW_SYSTEM */
4766 /* Return non-zero if all the face attributes in ATTRS are supported
4769 The definition of `supported' is somewhat heuristic, but basically means
4770 that a face containing all the attributes in ATTRS, when merged
4771 with the default face for display, can be represented in a way that's
4773 \(1) different in appearance than the default face, and
4774 \(2) `close in spirit' to what the attributes specify, if not exact.
4776 Point (2) implies that a `:weight black' attribute will be satisfied
4777 by any terminal that can display bold, and a `:foreground "yellow"' as
4778 long as the terminal can display a yellowish color, but `:slant italic'
4779 will _not_ be satisfied by the tty display code's automatic
4780 substitution of a `dim' face for italic. */
4783 tty_supports_face_attributes_p (struct frame
*f
,
4784 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4785 struct face
*def_face
)
4788 Lisp_Object val
, fg
, bg
;
4789 XColor fg_tty_color
, fg_std_color
;
4790 XColor bg_tty_color
, bg_std_color
;
4791 unsigned test_caps
= 0;
4792 Lisp_Object
*def_attrs
= def_face
->lface
;
4794 /* First check some easy-to-check stuff; ttys support none of the
4795 following attributes, so we can just return false if any are requested
4796 (even if `nominal' values are specified, we should still return false,
4797 as that will be the same value that the default face uses). We
4798 consider :slant unsupportable on ttys, even though the face code
4799 actually `fakes' them using a dim attribute if possible. This is
4800 because the faked result is too different from what the face
4802 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4803 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4804 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4805 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4806 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4807 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4808 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4809 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4812 /* Test for terminal `capabilities' (non-color character attributes). */
4814 /* font weight (bold/dim) */
4815 val
= attrs
[LFACE_WEIGHT_INDEX
];
4816 if (!UNSPECIFIEDP (val
)
4817 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4819 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4823 if (def_weight
> 100)
4824 return 0; /* same as default */
4825 test_caps
= TTY_CAP_BOLD
;
4827 else if (weight
< 100)
4829 if (def_weight
< 100)
4830 return 0; /* same as default */
4831 test_caps
= TTY_CAP_DIM
;
4833 else if (def_weight
== 100)
4834 return 0; /* same as default */
4838 val
= attrs
[LFACE_SLANT_INDEX
];
4839 if (!UNSPECIFIEDP (val
)
4840 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4842 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4843 if (slant
== 100 || slant
== def_slant
)
4844 return 0; /* same as default */
4846 test_caps
|= TTY_CAP_ITALIC
;
4850 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4851 if (!UNSPECIFIEDP (val
))
4854 return 0; /* ttys can't use colored underlines */
4855 else if (EQ (CAR_SAFE (val
), QCstyle
) && EQ (CAR_SAFE (CDR_SAFE (val
)), Qwave
))
4856 return 0; /* ttys can't use wave underlines */
4857 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4858 return 0; /* same as default */
4860 test_caps
|= TTY_CAP_UNDERLINE
;
4864 val
= attrs
[LFACE_INVERSE_INDEX
];
4865 if (!UNSPECIFIEDP (val
))
4867 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4868 return 0; /* same as default */
4870 test_caps
|= TTY_CAP_INVERSE
;
4874 /* Color testing. */
4876 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4877 we use them when calling `tty_capable_p' below, even if the face
4878 specifies no colors. */
4879 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4880 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4882 /* Check if foreground color is close enough. */
4883 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4886 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4888 if (face_attr_equal_p (fg
, def_fg
))
4889 return 0; /* same as default */
4890 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4891 return 0; /* not a valid color */
4892 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4893 > TTY_SAME_COLOR_THRESHOLD
)
4894 return 0; /* displayed color is too different */
4896 /* Make sure the color is really different than the default. */
4898 XColor def_fg_color
;
4899 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
4900 && (color_distance (&fg_tty_color
, &def_fg_color
)
4901 <= TTY_SAME_COLOR_THRESHOLD
))
4906 /* Check if background color is close enough. */
4907 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
4910 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
4912 if (face_attr_equal_p (bg
, def_bg
))
4913 return 0; /* same as default */
4914 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
4915 return 0; /* not a valid color */
4916 else if (color_distance (&bg_tty_color
, &bg_std_color
)
4917 > TTY_SAME_COLOR_THRESHOLD
)
4918 return 0; /* displayed color is too different */
4920 /* Make sure the color is really different than the default. */
4922 XColor def_bg_color
;
4923 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
4924 && (color_distance (&bg_tty_color
, &def_bg_color
)
4925 <= TTY_SAME_COLOR_THRESHOLD
))
4930 /* If both foreground and background are requested, see if the
4931 distance between them is OK. We just check to see if the distance
4932 between the tty's foreground and background is close enough to the
4933 distance between the standard foreground and background. */
4934 if (STRINGP (fg
) && STRINGP (bg
))
4937 = (color_distance (&fg_std_color
, &bg_std_color
)
4938 - color_distance (&fg_tty_color
, &bg_tty_color
));
4939 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
4940 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
4945 /* See if the capabilities we selected above are supported, with the
4947 if (test_caps
!= 0 &&
4948 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
4949 bg_tty_color
.pixel
))
4953 /* Hmmm, everything checks out, this terminal must support this face. */
4958 DEFUN ("display-supports-face-attributes-p",
4959 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
4961 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
4962 The optional argument DISPLAY can be a display name, a frame, or
4963 nil (meaning the selected frame's display).
4965 The definition of `supported' is somewhat heuristic, but basically means
4966 that a face containing all the attributes in ATTRIBUTES, when merged
4967 with the default face for display, can be represented in a way that's
4969 \(1) different in appearance than the default face, and
4970 \(2) `close in spirit' to what the attributes specify, if not exact.
4972 Point (2) implies that a `:weight black' attribute will be satisfied by
4973 any display that can display bold, and a `:foreground \"yellow\"' as long
4974 as it can display a yellowish color, but `:slant italic' will _not_ be
4975 satisfied by the tty display code's automatic substitution of a `dim'
4976 face for italic. */)
4977 (Lisp_Object attributes
, Lisp_Object display
)
4979 int supports
= 0, i
;
4982 struct face
*def_face
;
4983 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4985 if (noninteractive
|| !initialized
)
4986 /* We may not be able to access low-level face information in batch
4987 mode, or before being dumped, and this function is not going to
4988 be very useful in those cases anyway, so just give up. */
4992 frame
= selected_frame
;
4993 else if (FRAMEP (display
))
4997 /* Find any frame on DISPLAY. */
5001 FOR_EACH_FRAME (tail
, frame
)
5002 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5003 XFRAME (frame
)->param_alist
)),
5008 CHECK_LIVE_FRAME (frame
);
5011 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5012 attrs
[i
] = Qunspecified
;
5013 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5015 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5016 if (def_face
== NULL
)
5018 if (! realize_basic_faces (f
))
5019 error ("Cannot realize default face");
5020 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5021 if (def_face
== NULL
)
5022 emacs_abort (); /* realize_basic_faces must have set it up */
5025 /* Dispatch to the appropriate handler. */
5026 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5027 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5028 #ifdef HAVE_WINDOW_SYSTEM
5030 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5033 return supports
? Qt
: Qnil
;
5037 /***********************************************************************
5039 ***********************************************************************/
5041 DEFUN ("internal-set-font-selection-order",
5042 Finternal_set_font_selection_order
,
5043 Sinternal_set_font_selection_order
, 1, 1, 0,
5044 doc
: /* Set font selection order for face font selection to ORDER.
5045 ORDER must be a list of length 4 containing the symbols `:width',
5046 `:height', `:weight', and `:slant'. Face attributes appearing
5047 first in ORDER are matched first, e.g. if `:height' appears before
5048 `:weight' in ORDER, font selection first tries to find a font with
5049 a suitable height, and then tries to match the font weight.
5055 int indices
[DIM (font_sort_order
)];
5058 memset (indices
, 0, sizeof indices
);
5062 CONSP (list
) && i
< DIM (indices
);
5063 list
= XCDR (list
), ++i
)
5065 Lisp_Object attr
= XCAR (list
);
5068 if (EQ (attr
, QCwidth
))
5070 else if (EQ (attr
, QCheight
))
5071 xlfd
= XLFD_POINT_SIZE
;
5072 else if (EQ (attr
, QCweight
))
5074 else if (EQ (attr
, QCslant
))
5079 if (indices
[i
] != 0)
5084 if (!NILP (list
) || i
!= DIM (indices
))
5085 signal_error ("Invalid font sort order", order
);
5086 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5087 if (indices
[i
] == 0)
5088 signal_error ("Invalid font sort order", order
);
5090 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5092 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5093 free_all_realized_faces (Qnil
);
5096 font_update_sort_order (font_sort_order
);
5102 DEFUN ("internal-set-alternative-font-family-alist",
5103 Finternal_set_alternative_font_family_alist
,
5104 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5105 doc
: /* Define alternative font families to try in face font selection.
5106 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5107 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5108 be found. Value is ALIST. */)
5111 Lisp_Object entry
, tail
, tail2
;
5114 alist
= Fcopy_sequence (alist
);
5115 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5117 entry
= XCAR (tail
);
5119 entry
= Fcopy_sequence (entry
);
5120 XSETCAR (tail
, entry
);
5121 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5122 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5125 Vface_alternative_font_family_alist
= alist
;
5126 free_all_realized_faces (Qnil
);
5131 DEFUN ("internal-set-alternative-font-registry-alist",
5132 Finternal_set_alternative_font_registry_alist
,
5133 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5134 doc
: /* Define alternative font registries to try in face font selection.
5135 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5136 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5137 be found. Value is ALIST. */)
5140 Lisp_Object entry
, tail
, tail2
;
5143 alist
= Fcopy_sequence (alist
);
5144 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5146 entry
= XCAR (tail
);
5148 entry
= Fcopy_sequence (entry
);
5149 XSETCAR (tail
, entry
);
5150 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5151 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5153 Vface_alternative_font_registry_alist
= alist
;
5154 free_all_realized_faces (Qnil
);
5159 #ifdef HAVE_WINDOW_SYSTEM
5161 /* Return the fontset id of the base fontset name or alias name given
5162 by the fontset attribute of ATTRS. Value is -1 if the fontset
5163 attribute of ATTRS doesn't name a fontset. */
5166 face_fontset (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5170 name
= attrs
[LFACE_FONTSET_INDEX
];
5171 if (!STRINGP (name
))
5173 return fs_query_fontset (name
, 0);
5176 #endif /* HAVE_WINDOW_SYSTEM */
5180 /***********************************************************************
5182 ***********************************************************************/
5184 /* Realize basic faces on frame F. Value is zero if frame parameters
5185 of F don't contain enough information needed to realize the default
5189 realize_basic_faces (struct frame
*f
)
5192 ptrdiff_t count
= SPECPDL_INDEX ();
5194 /* Block input here so that we won't be surprised by an X expose
5195 event, for instance, without having the faces set up. */
5197 specbind (Qscalable_fonts_allowed
, Qt
);
5199 if (realize_default_face (f
))
5201 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5202 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5203 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5204 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5205 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5206 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5207 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5208 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5209 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5210 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5211 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5213 /* Reflect changes in the `menu' face in menu bars. */
5214 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5216 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5217 #ifdef USE_X_TOOLKIT
5218 if (FRAME_WINDOW_P (f
))
5219 x_update_menu_appearance (f
);
5226 unbind_to (count
, Qnil
);
5232 /* Realize the default face on frame F. If the face is not fully
5233 specified, make it fully-specified. Attributes of the default face
5234 that are not explicitly specified are taken from frame parameters. */
5237 realize_default_face (struct frame
*f
)
5239 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5241 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5244 /* If the `default' face is not yet known, create it. */
5245 lface
= lface_from_face_name (f
, Qdefault
, 0);
5249 XSETFRAME (frame
, f
);
5250 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5253 #ifdef HAVE_WINDOW_SYSTEM
5254 if (FRAME_WINDOW_P (f
))
5256 Lisp_Object font_object
;
5258 XSETFONT (font_object
, FRAME_FONT (f
));
5259 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5260 ASET (lface
, LFACE_FONTSET_INDEX
, fontset_name (FRAME_FONTSET (f
)));
5261 f
->default_face_done_p
= 1;
5263 #endif /* HAVE_WINDOW_SYSTEM */
5265 if (!FRAME_WINDOW_P (f
))
5267 ASET (lface
, LFACE_FAMILY_INDEX
, build_string ("default"));
5268 ASET (lface
, LFACE_FOUNDRY_INDEX
, LFACE_FAMILY (lface
));
5269 ASET (lface
, LFACE_SWIDTH_INDEX
, Qnormal
);
5270 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (1));
5271 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5272 ASET (lface
, LFACE_WEIGHT_INDEX
, Qnormal
);
5273 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5274 ASET (lface
, LFACE_SLANT_INDEX
, Qnormal
);
5275 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5276 ASET (lface
, LFACE_FONTSET_INDEX
, Qnil
);
5279 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5280 ASET (lface
, LFACE_UNDERLINE_INDEX
, Qnil
);
5282 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5283 ASET (lface
, LFACE_OVERLINE_INDEX
, Qnil
);
5285 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5286 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, Qnil
);
5288 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5289 ASET (lface
, LFACE_BOX_INDEX
, Qnil
);
5291 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5292 ASET (lface
, LFACE_INVERSE_INDEX
, Qnil
);
5294 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5296 /* This function is called so early that colors are not yet
5297 set in the frame parameter list. */
5298 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5300 if (CONSP (color
) && STRINGP (XCDR (color
)))
5301 ASET (lface
, LFACE_FOREGROUND_INDEX
, XCDR (color
));
5302 else if (FRAME_WINDOW_P (f
))
5304 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5305 ASET (lface
, LFACE_FOREGROUND_INDEX
, build_string (unspecified_fg
));
5310 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5312 /* This function is called so early that colors are not yet
5313 set in the frame parameter list. */
5314 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5315 if (CONSP (color
) && STRINGP (XCDR (color
)))
5316 ASET (lface
, LFACE_BACKGROUND_INDEX
, XCDR (color
));
5317 else if (FRAME_WINDOW_P (f
))
5319 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5320 ASET (lface
, LFACE_BACKGROUND_INDEX
, build_string (unspecified_bg
));
5325 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5326 ASET (lface
, LFACE_STIPPLE_INDEX
, Qnil
);
5328 /* Realize the face; it must be fully-specified now. */
5329 eassert (lface_fully_specified_p (XVECTOR (lface
)->u
.contents
));
5330 check_lface (lface
);
5331 memcpy (attrs
, XVECTOR (lface
)->u
.contents
, sizeof attrs
);
5332 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5334 #ifdef HAVE_WINDOW_SYSTEM
5335 #ifdef HAVE_X_WINDOWS
5336 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5338 /* This can happen when making a frame on a display that does
5339 not support the default font. */
5343 /* Otherwise, the font specified for the frame was not
5344 acceptable as a font for the default face (perhaps because
5345 auto-scaled fonts are rejected), so we must adjust the frame
5347 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5349 #endif /* HAVE_X_WINDOWS */
5350 #endif /* HAVE_WINDOW_SYSTEM */
5355 /* Realize basic faces other than the default face in face cache C.
5356 SYMBOL is the face name, ID is the face id the realized face must
5357 have. The default face must have been realized already. */
5360 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5362 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5363 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5364 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5365 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5367 /* The default face must exist and be fully specified. */
5368 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5369 check_lface_attrs (attrs
);
5370 eassert (lface_fully_specified_p (attrs
));
5372 /* If SYMBOL isn't know as a face, create it. */
5376 XSETFRAME (frame
, f
);
5377 lface
= Finternal_make_lisp_face (symbol
, frame
);
5380 /* Merge SYMBOL's face with the default face. */
5381 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5382 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5384 /* Realize the face. */
5385 realize_face (c
, attrs
, id
);
5389 /* Realize the fully-specified face with attributes ATTRS in face
5390 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5391 non-negative, it is an ID of face to remove before caching the new
5392 face. Value is a pointer to the newly created realized face. */
5394 static struct face
*
5395 realize_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
5400 /* LFACE must be fully specified. */
5401 eassert (cache
!= NULL
);
5402 check_lface_attrs (attrs
);
5404 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5406 /* Remove the former face. */
5407 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5408 uncache_face (cache
, former_face
);
5409 free_realized_face (cache
->f
, former_face
);
5410 SET_FRAME_GARBAGED (cache
->f
);
5413 if (FRAME_WINDOW_P (cache
->f
))
5414 face
= realize_x_face (cache
, attrs
);
5415 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5416 face
= realize_tty_face (cache
, attrs
);
5417 else if (FRAME_INITIAL_P (cache
->f
))
5419 /* Create a dummy face. */
5420 face
= make_realized_face (attrs
);
5425 /* Insert the new face. */
5426 cache_face (cache
, face
, lface_hash (attrs
));
5431 #ifdef HAVE_WINDOW_SYSTEM
5432 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5433 same attributes as BASE_FACE except for the font on frame F.
5434 FONT-OBJECT may be nil, in which case, realized a face of
5437 static struct face
*
5438 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5439 struct face
*base_face
)
5441 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5444 face
= xmalloc (sizeof *face
);
5449 = (! NILP (font_object
)
5450 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5451 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5453 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5454 face
->colors_copied_bitwise_p
= 1;
5455 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5458 cache_face (cache
, face
, face
->hash
);
5462 #endif /* HAVE_WINDOW_SYSTEM */
5465 /* Realize the fully-specified face with attributes ATTRS in face
5466 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5467 the new face doesn't share font with the default face, a fontname
5468 is allocated from the heap and set in `font_name' of the new face,
5469 but it is not yet loaded here. Value is a pointer to the newly
5470 created realized face. */
5472 static struct face
*
5473 realize_x_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5475 struct face
*face
= NULL
;
5476 #ifdef HAVE_WINDOW_SYSTEM
5477 struct face
*default_face
;
5479 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5481 eassert (FRAME_WINDOW_P (cache
->f
));
5483 /* Allocate a new realized face. */
5484 face
= make_realized_face (attrs
);
5485 face
->ascii_face
= face
;
5489 /* Determine the font to use. Most of the time, the font will be
5490 the same as the font of the default face, so try that first. */
5491 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5493 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5495 face
->font
= default_face
->font
;
5497 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5501 /* If the face attribute ATTRS specifies a fontset, use it as
5502 the base of a new realized fontset. Otherwise, use the same
5503 base fontset as of the default face. The base determines
5504 registry and encoding of a font. It may also determine
5505 foundry and family. The other fields of font name pattern
5506 are constructed from ATTRS. */
5507 int fontset
= face_fontset (attrs
);
5509 /* If we are realizing the default face, ATTRS should specify a
5510 fontset. In other words, if FONTSET is -1, we are not
5511 realizing the default face, thus the default face should have
5512 already been realized. */
5516 fontset
= default_face
->fontset
;
5520 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5521 attrs
[LFACE_FONT_INDEX
]
5522 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5523 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5525 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5526 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5536 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5537 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5538 face
->overstrike
= 1;
5540 /* Load colors, and set remaining attributes. */
5542 load_face_colors (f
, face
, attrs
);
5545 box
= attrs
[LFACE_BOX_INDEX
];
5548 /* A simple box of line width 1 drawn in color given by
5550 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5552 face
->box
= FACE_SIMPLE_BOX
;
5553 face
->box_line_width
= 1;
5555 else if (INTEGERP (box
))
5557 /* Simple box of specified line width in foreground color of the
5559 eassert (XINT (box
) != 0);
5560 face
->box
= FACE_SIMPLE_BOX
;
5561 face
->box_line_width
= XINT (box
);
5562 face
->box_color
= face
->foreground
;
5563 face
->box_color_defaulted_p
= 1;
5565 else if (CONSP (box
))
5567 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5568 being one of `raised' or `sunken'. */
5569 face
->box
= FACE_SIMPLE_BOX
;
5570 face
->box_color
= face
->foreground
;
5571 face
->box_color_defaulted_p
= 1;
5572 face
->box_line_width
= 1;
5576 Lisp_Object keyword
, value
;
5578 keyword
= XCAR (box
);
5586 if (EQ (keyword
, QCline_width
))
5588 if (INTEGERP (value
) && XINT (value
) != 0)
5589 face
->box_line_width
= XINT (value
);
5591 else if (EQ (keyword
, QCcolor
))
5593 if (STRINGP (value
))
5595 face
->box_color
= load_color (f
, face
, value
,
5597 face
->use_box_color_for_shadows_p
= 1;
5600 else if (EQ (keyword
, QCstyle
))
5602 if (EQ (value
, Qreleased_button
))
5603 face
->box
= FACE_RAISED_BOX
;
5604 else if (EQ (value
, Qpressed_button
))
5605 face
->box
= FACE_SUNKEN_BOX
;
5610 /* Text underline, overline, strike-through. */
5612 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5613 if (EQ (underline
, Qt
))
5615 /* Use default color (same as foreground color). */
5616 face
->underline_p
= 1;
5617 face
->underline_type
= FACE_UNDER_LINE
;
5618 face
->underline_defaulted_p
= 1;
5619 face
->underline_color
= 0;
5621 else if (STRINGP (underline
))
5623 /* Use specified color. */
5624 face
->underline_p
= 1;
5625 face
->underline_type
= FACE_UNDER_LINE
;
5626 face
->underline_defaulted_p
= 0;
5627 face
->underline_color
5628 = load_color (f
, face
, underline
,
5629 LFACE_UNDERLINE_INDEX
);
5631 else if (NILP (underline
))
5633 face
->underline_p
= 0;
5634 face
->underline_defaulted_p
= 0;
5635 face
->underline_color
= 0;
5637 else if (CONSP (underline
))
5639 /* `(:color COLOR :style STYLE)'.
5640 STYLE being one of `line' or `wave'. */
5641 face
->underline_p
= 1;
5642 face
->underline_color
= 0;
5643 face
->underline_defaulted_p
= 1;
5644 face
->underline_type
= FACE_UNDER_LINE
;
5646 /* FIXME? This is also not robust about checking the precise form.
5647 See comments in Finternal_set_lisp_face_attribute. */
5648 while (CONSP (underline
))
5650 Lisp_Object keyword
, value
;
5652 keyword
= XCAR (underline
);
5653 underline
= XCDR (underline
);
5655 if (!CONSP (underline
))
5657 value
= XCAR (underline
);
5658 underline
= XCDR (underline
);
5660 if (EQ (keyword
, QCcolor
))
5662 if (EQ (value
, Qforeground_color
))
5664 face
->underline_defaulted_p
= 1;
5665 face
->underline_color
= 0;
5667 else if (STRINGP (value
))
5669 face
->underline_defaulted_p
= 0;
5670 face
->underline_color
= load_color (f
, face
, value
,
5671 LFACE_UNDERLINE_INDEX
);
5674 else if (EQ (keyword
, QCstyle
))
5676 if (EQ (value
, Qline
))
5677 face
->underline_type
= FACE_UNDER_LINE
;
5678 else if (EQ (value
, Qwave
))
5679 face
->underline_type
= FACE_UNDER_WAVE
;
5684 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5685 if (STRINGP (overline
))
5687 face
->overline_color
5688 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5689 LFACE_OVERLINE_INDEX
);
5690 face
->overline_p
= 1;
5692 else if (EQ (overline
, Qt
))
5694 face
->overline_color
= face
->foreground
;
5695 face
->overline_color_defaulted_p
= 1;
5696 face
->overline_p
= 1;
5699 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5700 if (STRINGP (strike_through
))
5702 face
->strike_through_color
5703 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5704 LFACE_STRIKE_THROUGH_INDEX
);
5705 face
->strike_through_p
= 1;
5707 else if (EQ (strike_through
, Qt
))
5709 face
->strike_through_color
= face
->foreground
;
5710 face
->strike_through_color_defaulted_p
= 1;
5711 face
->strike_through_p
= 1;
5714 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5715 if (!NILP (stipple
))
5716 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5717 #endif /* HAVE_WINDOW_SYSTEM */
5723 /* Map a specified color of face FACE on frame F to a tty color index.
5724 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5725 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5726 default foreground/background colors. */
5729 map_tty_color (struct frame
*f
, struct face
*face
,
5730 enum lface_attribute_index idx
, int *defaulted
)
5732 Lisp_Object frame
, color
, def
;
5733 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5734 unsigned long default_pixel
=
5735 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5736 unsigned long pixel
= default_pixel
;
5738 unsigned long default_other_pixel
=
5739 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5742 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5744 XSETFRAME (frame
, f
);
5745 color
= face
->lface
[idx
];
5749 && CONSP (Vtty_defined_color_alist
)
5750 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5753 /* Associations in tty-defined-color-alist are of the form
5754 (NAME INDEX R G B). We need the INDEX part. */
5755 pixel
= XINT (XCAR (XCDR (def
)));
5758 if (pixel
== default_pixel
&& STRINGP (color
))
5760 pixel
= load_color (f
, face
, color
, idx
);
5763 /* If the foreground of the default face is the default color,
5764 use the foreground color defined by the frame. */
5765 if (FRAME_MSDOS_P (f
))
5767 if (pixel
== default_pixel
5768 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5771 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5773 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5774 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5777 else if (pixel
== default_other_pixel
)
5780 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5782 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5783 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5791 face
->foreground
= pixel
;
5793 face
->background
= pixel
;
5797 /* Realize the fully-specified face with attributes ATTRS in face
5798 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5799 Value is a pointer to the newly created realized face. */
5801 static struct face
*
5802 realize_tty_face (struct face_cache
*cache
,
5803 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5807 int face_colors_defaulted
= 0;
5808 struct frame
*f
= cache
->f
;
5810 /* Frame must be a termcap frame. */
5811 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5813 /* Allocate a new realized face. */
5814 face
= make_realized_face (attrs
);
5816 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5819 /* Map face attributes to TTY appearances. */
5820 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5821 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5823 face
->tty_bold_p
= 1;
5825 face
->tty_italic_p
= 1;
5826 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5827 face
->tty_underline_p
= 1;
5828 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5829 face
->tty_reverse_p
= 1;
5831 /* Map color names to color indices. */
5832 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5833 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5835 /* Swap colors if face is inverse-video. If the colors are taken
5836 from the frame colors, they are already inverted, since the
5837 frame-creation function calls x-handle-reverse-video. */
5838 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5840 unsigned long tem
= face
->foreground
;
5841 face
->foreground
= face
->background
;
5842 face
->background
= tem
;
5845 if (tty_suppress_bold_inverse_default_colors_p
5847 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5848 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5849 face
->tty_bold_p
= 0;
5855 DEFUN ("tty-suppress-bold-inverse-default-colors",
5856 Ftty_suppress_bold_inverse_default_colors
,
5857 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5858 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5859 SUPPRESS non-nil means suppress it.
5860 This affects bold faces on TTYs whose foreground is the default background
5861 color of the display and whose background is the default foreground color.
5862 For such faces, the bold face attribute is ignored if this variable
5864 (Lisp_Object suppress
)
5866 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5867 ++face_change_count
;
5873 /***********************************************************************
5875 ***********************************************************************/
5877 /* Return the ID of the face to use to display character CH with face
5878 property PROP on frame F in current_buffer. */
5881 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5885 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5890 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5891 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5895 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5896 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5897 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5898 merge_face_ref (f
, prop
, attrs
, 1, 0);
5899 face_id
= lookup_face (f
, attrs
);
5905 /* Return the face ID associated with buffer position POS for
5906 displaying ASCII characters. Return in *ENDPTR the position at
5907 which a different face is needed, as far as text properties and
5908 overlays are concerned. W is a window displaying current_buffer.
5910 REGION_BEG, REGION_END delimit the region, so it can be
5913 LIMIT is a position not to scan beyond. That is to limit the time
5914 this function can take.
5916 If MOUSE is non-zero, use the character's mouse-face, not its face.
5918 BASE_FACE_ID, if non-negative, specifies a base face id to use
5919 instead of DEFAULT_FACE_ID.
5921 The face returned is suitable for displaying ASCII characters. */
5924 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
5925 ptrdiff_t region_beg
, ptrdiff_t region_end
,
5926 ptrdiff_t *endptr
, ptrdiff_t limit
,
5927 int mouse
, int base_face_id
)
5929 struct frame
*f
= XFRAME (w
->frame
);
5930 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5931 Lisp_Object prop
, position
;
5932 ptrdiff_t i
, noverlays
;
5933 Lisp_Object
*overlay_vec
;
5935 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5936 Lisp_Object limit1
, end
;
5937 struct face
*default_face
;
5939 /* W must display the current buffer. We could write this function
5940 to use the frame and buffer of W, but right now it doesn't. */
5941 /* eassert (XBUFFER (w->contents) == current_buffer); */
5943 XSETFASTINT (position
, pos
);
5946 if (pos
< region_beg
&& region_beg
< endpos
)
5947 endpos
= region_beg
;
5949 /* Get the `face' or `mouse_face' text property at POS, and
5950 determine the next position at which the property changes. */
5951 prop
= Fget_text_property (position
, propname
, w
->contents
);
5952 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5953 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
5955 endpos
= XINT (end
);
5957 /* Look at properties from overlays. */
5959 ptrdiff_t next_overlay
;
5961 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
5962 if (next_overlay
< endpos
)
5963 endpos
= next_overlay
;
5971 if (base_face_id
>= 0)
5972 face_id
= base_face_id
;
5973 else if (NILP (Vface_remapping_alist
))
5974 face_id
= DEFAULT_FACE_ID
;
5976 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
5978 default_face
= FACE_FROM_ID (f
, face_id
);
5981 /* Optimize common cases where we can use the default face. */
5984 && !(pos
>= region_beg
&& pos
< region_end
))
5985 return default_face
->id
;
5987 /* Begin with attributes from the default face. */
5988 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5990 /* Merge in attributes specified via text properties. */
5992 merge_face_ref (f
, prop
, attrs
, 1, 0);
5994 /* Now merge the overlay data. */
5995 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
5996 for (i
= 0; i
< noverlays
; i
++)
6001 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6003 merge_face_ref (f
, prop
, attrs
, 1, 0);
6005 oend
= OVERLAY_END (overlay_vec
[i
]);
6006 oendpos
= OVERLAY_POSITION (oend
);
6007 if (oendpos
< endpos
)
6011 /* If in the region, merge in the region face. */
6012 if (pos
>= region_beg
&& pos
< region_end
)
6014 merge_named_face (f
, Qregion
, attrs
, 0);
6016 if (region_end
< endpos
)
6017 endpos
= region_end
;
6022 /* Look up a realized face with the given face attributes,
6023 or realize a new one for ASCII characters. */
6024 return lookup_face (f
, attrs
);
6027 /* Return the face ID at buffer position POS for displaying ASCII
6028 characters associated with overlay strings for overlay OVERLAY.
6030 Like face_at_buffer_position except for OVERLAY. Currently it
6031 simply disregards the `face' properties of all overlays. */
6034 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6035 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6036 ptrdiff_t *endptr
, ptrdiff_t limit
,
6037 int mouse
, Lisp_Object overlay
)
6039 struct frame
*f
= XFRAME (w
->frame
);
6040 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6041 Lisp_Object prop
, position
;
6043 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6044 Lisp_Object limit1
, end
;
6045 struct face
*default_face
;
6047 /* W must display the current buffer. We could write this function
6048 to use the frame and buffer of W, but right now it doesn't. */
6049 /* eassert (XBUFFER (w->contents) == current_buffer); */
6051 XSETFASTINT (position
, pos
);
6054 if (pos
< region_beg
&& region_beg
< endpos
)
6055 endpos
= region_beg
;
6057 /* Get the `face' or `mouse_face' text property at POS, and
6058 determine the next position at which the property changes. */
6059 prop
= Fget_text_property (position
, propname
, w
->contents
);
6060 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6061 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
6063 endpos
= XINT (end
);
6067 /* Optimize common case where we can use the default face. */
6069 && !(pos
>= region_beg
&& pos
< region_end
)
6070 && NILP (Vface_remapping_alist
))
6071 return DEFAULT_FACE_ID
;
6073 /* Begin with attributes from the default face. */
6074 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6075 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6077 /* Merge in attributes specified via text properties. */
6079 merge_face_ref (f
, prop
, attrs
, 1, 0);
6081 /* If in the region, merge in the region face. */
6082 if (pos
>= region_beg
&& pos
< region_end
)
6084 merge_named_face (f
, Qregion
, attrs
, 0);
6086 if (region_end
< endpos
)
6087 endpos
= region_end
;
6092 /* Look up a realized face with the given face attributes,
6093 or realize a new one for ASCII characters. */
6094 return lookup_face (f
, attrs
);
6098 /* Compute the face at character position POS in Lisp string STRING on
6099 window W, for ASCII characters.
6101 If STRING is an overlay string, it comes from position BUFPOS in
6102 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6103 not an overlay string. W must display the current buffer.
6104 REGION_BEG and REGION_END give the start and end positions of the
6105 region; both are -1 if no region is visible.
6107 BASE_FACE_ID is the id of a face to merge with. For strings coming
6108 from overlays or the `display' property it is the face at BUFPOS.
6110 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6112 Set *ENDPTR to the next position where to check for faces in
6113 STRING; -1 if the face is constant from POS to the end of the
6116 Value is the id of the face to use. The face returned is suitable
6117 for displaying ASCII characters. */
6120 face_at_string_position (struct window
*w
, Lisp_Object string
,
6121 ptrdiff_t pos
, ptrdiff_t bufpos
,
6122 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6123 ptrdiff_t *endptr
, enum face_id base_face_id
,
6126 Lisp_Object prop
, position
, end
, limit
;
6127 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6128 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6129 struct face
*base_face
;
6130 bool multibyte_p
= STRING_MULTIBYTE (string
);
6131 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6133 /* Get the value of the face property at the current position within
6134 STRING. Value is nil if there is no face property. */
6135 XSETFASTINT (position
, pos
);
6136 prop
= Fget_text_property (position
, prop_name
, string
);
6138 /* Get the next position at which to check for faces. Value of end
6139 is nil if face is constant all the way to the end of the string.
6140 Otherwise it is a string position where to check faces next.
6141 Limit is the maximum position up to which to check for property
6142 changes in Fnext_single_property_change. Strings are usually
6143 short, so set the limit to the end of the string. */
6144 XSETFASTINT (limit
, SCHARS (string
));
6145 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6147 *endptr
= XFASTINT (end
);
6151 base_face
= FACE_FROM_ID (f
, base_face_id
);
6152 eassert (base_face
);
6154 /* Optimize the default case that there is no face property and we
6155 are not in the region. */
6157 && (base_face_id
!= DEFAULT_FACE_ID
6158 /* BUFPOS <= 0 means STRING is not an overlay string, so
6159 that the region doesn't have to be taken into account. */
6161 || bufpos
< region_beg
6162 || bufpos
>= region_end
)
6164 /* We can't realize faces for different charsets differently
6165 if we don't have fonts, so we can stop here if not working
6166 on a window-system frame. */
6167 || !FRAME_WINDOW_P (f
)
6168 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6169 return base_face
->id
;
6171 /* Begin with attributes from the base face. */
6172 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6174 /* Merge in attributes specified via text properties. */
6176 merge_face_ref (f
, prop
, attrs
, 1, 0);
6178 /* If in the region, merge in the region face. */
6180 && bufpos
>= region_beg
6181 && bufpos
< region_end
)
6182 merge_named_face (f
, Qregion
, attrs
, 0);
6184 /* Look up a realized face with the given face attributes,
6185 or realize a new one for ASCII characters. */
6186 return lookup_face (f
, attrs
);
6190 /* Merge a face into a realized face.
6192 F is frame where faces are (to be) realized.
6194 FACE_NAME is named face to merge.
6196 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6198 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6200 BASE_FACE_ID is realized face to merge into.
6206 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6209 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6210 struct face
*base_face
;
6212 base_face
= FACE_FROM_ID (f
, base_face_id
);
6214 return base_face_id
;
6216 if (EQ (face_name
, Qt
))
6218 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6219 return base_face_id
;
6220 face_name
= lface_id_to_name
[face_id
];
6221 /* When called during make-frame, lookup_derived_face may fail
6222 if the faces are uninitialized. Don't signal an error. */
6223 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6224 return (face_id
>= 0 ? face_id
: base_face_id
);
6227 /* Begin with attributes from the base face. */
6228 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6230 if (!NILP (face_name
))
6232 if (!merge_named_face (f
, face_name
, attrs
, 0))
6233 return base_face_id
;
6239 return base_face_id
;
6240 face
= FACE_FROM_ID (f
, face_id
);
6242 return base_face_id
;
6243 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6246 /* Look up a realized face with the given face attributes,
6247 or realize a new one for ASCII characters. */
6248 return lookup_face (f
, attrs
);
6253 #ifndef HAVE_X_WINDOWS
6254 DEFUN ("x-load-color-file", Fx_load_color_file
,
6255 Sx_load_color_file
, 1, 1, 0,
6256 doc
: /* Create an alist of color entries from an external file.
6258 The file should define one named RGB color per line like so:
6260 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6261 (Lisp_Object filename
)
6264 Lisp_Object cmap
= Qnil
;
6265 Lisp_Object abspath
;
6267 CHECK_STRING (filename
);
6268 abspath
= Fexpand_file_name (filename
, Qnil
);
6271 fp
= emacs_fopen (SSDATA (abspath
), "rt");
6275 int red
, green
, blue
;
6278 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6279 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6282 int color
= RGB (red
, green
, blue
);
6284 int color
= (red
<< 16) | (green
<< 8) | blue
;
6286 char *name
= buf
+ num
;
6287 ptrdiff_t len
= strlen (name
);
6288 len
-= 0 < len
&& name
[len
- 1] == '\n';
6289 cmap
= Fcons (Fcons (make_string (name
, len
), make_number (color
)),
6301 /***********************************************************************
6303 ***********************************************************************/
6307 /* Print the contents of the realized face FACE to stderr. */
6310 dump_realized_face (struct face
*face
)
6312 fprintf (stderr
, "ID: %d\n", face
->id
);
6313 #ifdef HAVE_X_WINDOWS
6314 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6316 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6318 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6319 fprintf (stderr
, "background: 0x%lx (%s)\n",
6321 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6323 fprintf (stderr
, "font_name: %s (%s)\n",
6324 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6325 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6326 #ifdef HAVE_X_WINDOWS
6327 fprintf (stderr
, "font = %p\n", face
->font
);
6329 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6330 fprintf (stderr
, "underline: %d (%s)\n",
6332 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6333 fprintf (stderr
, "hash: %d\n", face
->hash
);
6337 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6344 fprintf (stderr
, "font selection order: ");
6345 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6346 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6347 fprintf (stderr
, "\n");
6349 fprintf (stderr
, "alternative fonts: ");
6350 debug_print (Vface_alternative_font_family_alist
);
6351 fprintf (stderr
, "\n");
6353 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6354 Fdump_face (make_number (i
));
6360 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6362 error ("Not a valid face");
6363 dump_realized_face (face
);
6370 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6371 0, 0, 0, doc
: /* */)
6374 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6375 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6376 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6380 #endif /* GLYPH_DEBUG */
6384 /***********************************************************************
6386 ***********************************************************************/
6389 syms_of_xfaces (void)
6391 DEFSYM (Qface
, "face");
6392 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6393 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6394 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6396 /* Lisp face attribute keywords. */
6397 DEFSYM (QCfamily
, ":family");
6398 DEFSYM (QCheight
, ":height");
6399 DEFSYM (QCweight
, ":weight");
6400 DEFSYM (QCslant
, ":slant");
6401 DEFSYM (QCunderline
, ":underline");
6402 DEFSYM (QCinverse_video
, ":inverse-video");
6403 DEFSYM (QCreverse_video
, ":reverse-video");
6404 DEFSYM (QCforeground
, ":foreground");
6405 DEFSYM (QCbackground
, ":background");
6406 DEFSYM (QCstipple
, ":stipple");
6407 DEFSYM (QCwidth
, ":width");
6408 DEFSYM (QCfont
, ":font");
6409 DEFSYM (QCfontset
, ":fontset");
6410 DEFSYM (QCbold
, ":bold");
6411 DEFSYM (QCitalic
, ":italic");
6412 DEFSYM (QCoverline
, ":overline");
6413 DEFSYM (QCstrike_through
, ":strike-through");
6414 DEFSYM (QCbox
, ":box");
6415 DEFSYM (QCinherit
, ":inherit");
6417 /* Symbols used for Lisp face attribute values. */
6418 DEFSYM (QCcolor
, ":color");
6419 DEFSYM (QCline_width
, ":line-width");
6420 DEFSYM (QCstyle
, ":style");
6421 DEFSYM (Qline
, "line");
6422 DEFSYM (Qwave
, "wave");
6423 DEFSYM (Qreleased_button
, "released-button");
6424 DEFSYM (Qpressed_button
, "pressed-button");
6425 DEFSYM (Qnormal
, "normal");
6426 DEFSYM (Qextra_light
, "extra-light");
6427 DEFSYM (Qlight
, "light");
6428 DEFSYM (Qsemi_light
, "semi-light");
6429 DEFSYM (Qsemi_bold
, "semi-bold");
6430 DEFSYM (Qbold
, "bold");
6431 DEFSYM (Qextra_bold
, "extra-bold");
6432 DEFSYM (Qultra_bold
, "ultra-bold");
6433 DEFSYM (Qoblique
, "oblique");
6434 DEFSYM (Qitalic
, "italic");
6435 DEFSYM (Qbackground_color
, "background-color");
6436 DEFSYM (Qforeground_color
, "foreground-color");
6437 DEFSYM (Qunspecified
, "unspecified");
6438 DEFSYM (QCignore_defface
, ":ignore-defface");
6440 DEFSYM (Qface_alias
, "face-alias");
6441 DEFSYM (Qdefault
, "default");
6442 DEFSYM (Qtool_bar
, "tool-bar");
6443 DEFSYM (Qregion
, "region");
6444 DEFSYM (Qfringe
, "fringe");
6445 DEFSYM (Qheader_line
, "header-line");
6446 DEFSYM (Qscroll_bar
, "scroll-bar");
6447 DEFSYM (Qmenu
, "menu");
6448 DEFSYM (Qcursor
, "cursor");
6449 DEFSYM (Qborder
, "border");
6450 DEFSYM (Qmouse
, "mouse");
6451 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6452 DEFSYM (Qvertical_border
, "vertical-border");
6453 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6454 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6455 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6456 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6457 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6459 Vparam_value_alist
= list1 (Fcons (Qnil
, Qnil
));
6460 staticpro (&Vparam_value_alist
);
6461 Vface_alternative_font_family_alist
= Qnil
;
6462 staticpro (&Vface_alternative_font_family_alist
);
6463 Vface_alternative_font_registry_alist
= Qnil
;
6464 staticpro (&Vface_alternative_font_registry_alist
);
6466 defsubr (&Sinternal_make_lisp_face
);
6467 defsubr (&Sinternal_lisp_face_p
);
6468 defsubr (&Sinternal_set_lisp_face_attribute
);
6469 #ifdef HAVE_WINDOW_SYSTEM
6470 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6472 defsubr (&Scolor_gray_p
);
6473 defsubr (&Scolor_supported_p
);
6474 #ifndef HAVE_X_WINDOWS
6475 defsubr (&Sx_load_color_file
);
6477 defsubr (&Sface_attribute_relative_p
);
6478 defsubr (&Smerge_face_attribute
);
6479 defsubr (&Sinternal_get_lisp_face_attribute
);
6480 defsubr (&Sinternal_lisp_face_attribute_values
);
6481 defsubr (&Sinternal_lisp_face_equal_p
);
6482 defsubr (&Sinternal_lisp_face_empty_p
);
6483 defsubr (&Sinternal_copy_lisp_face
);
6484 defsubr (&Sinternal_merge_in_global_face
);
6485 defsubr (&Sface_font
);
6486 defsubr (&Sframe_face_alist
);
6487 defsubr (&Sdisplay_supports_face_attributes_p
);
6488 defsubr (&Scolor_distance
);
6489 defsubr (&Sinternal_set_font_selection_order
);
6490 defsubr (&Sinternal_set_alternative_font_family_alist
);
6491 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6492 defsubr (&Sface_attributes_as_vector
);
6494 defsubr (&Sdump_face
);
6495 defsubr (&Sshow_face_resources
);
6496 #endif /* GLYPH_DEBUG */
6497 defsubr (&Sclear_face_cache
);
6498 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6500 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6501 defsubr (&Sdump_colors
);
6504 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6505 doc
: /* List of global face definitions (for internal use only.) */);
6506 Vface_new_frame_defaults
= Qnil
;
6508 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6509 doc
: /* Default stipple pattern used on monochrome displays.
6510 This stipple pattern is used on monochrome displays
6511 instead of shades of gray for a face background color.
6512 See `set-face-stipple' for possible values for this variable. */);
6513 Vface_default_stipple
= build_pure_c_string ("gray3");
6515 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6516 doc
: /* An alist of defined terminal colors and their RGB values.
6517 See the docstring of `tty-color-alist' for the details. */);
6518 Vtty_defined_color_alist
= Qnil
;
6520 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6521 doc
: /* Allowed scalable fonts.
6522 A value of nil means don't allow any scalable fonts.
6523 A value of t means allow any scalable font.
6524 Otherwise, value must be a list of regular expressions. A font may be
6525 scaled if its name matches a regular expression in the list.
6526 Note that if value is nil, a scalable font might still be used, if no
6527 other font of the appropriate family and registry is available. */);
6528 Vscalable_fonts_allowed
= Qnil
;
6530 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6531 doc
: /* List of ignored fonts.
6532 Each element is a regular expression that matches names of fonts to
6534 Vface_ignored_fonts
= Qnil
;
6536 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6537 doc
: /* Alist of face remappings.
6538 Each element is of the form:
6540 (FACE . REPLACEMENT),
6542 which causes display of the face FACE to use REPLACEMENT instead.
6543 REPLACEMENT is a face specification, i.e. one of the following:
6546 (2) a property list of attribute/value pairs, or
6547 (3) a list in which each element has the form of (1) or (2).
6549 List values for REPLACEMENT are merged to form the final face
6550 specification, with earlier entries taking precedence, in the same as
6551 as in the `face' text property.
6553 Face-name remapping cycles are suppressed; recursive references use
6554 the underlying face instead of the remapped face. So a remapping of
6557 (FACE EXTRA-FACE... FACE)
6561 (FACE (FACE-ATTR VAL ...) FACE)
6563 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6564 existing definition of FACE. Note that this isn't necessary for the
6565 default face, since every face inherits from the default face.
6567 If this variable is made buffer-local, the face remapping takes effect
6568 only in that buffer. For instance, the mode my-mode could define a
6569 face `my-mode-default', and then in the mode setup function, do:
6571 (set (make-local-variable 'face-remapping-alist)
6572 '((default my-mode-default)))).
6574 Because Emacs normally only redraws screen areas when the underlying
6575 buffer contents change, you may need to call `redraw-display' after
6576 changing this variable for it to take effect. */);
6577 Vface_remapping_alist
= Qnil
;
6579 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6580 doc
: /* Alist of fonts vs the rescaling factors.
6581 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6582 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6583 RESCALE-RATIO is a floating point number to specify how much larger
6584 \(or smaller) font we should use. For instance, if a face requests
6585 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6586 Vface_font_rescale_alist
= Qnil
;
6588 #ifdef HAVE_WINDOW_SYSTEM
6589 defsubr (&Sbitmap_spec_p
);
6590 defsubr (&Sx_list_fonts
);
6591 defsubr (&Sinternal_face_x_get_resource
);
6592 defsubr (&Sx_family_fonts
);