1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2014 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 /* Size of hash table of realized faces in face caches (should be a
279 #define FACE_CACHE_BUCKETS_SIZE 1001
281 /* Keyword symbols used for face attribute names. */
283 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
284 static Lisp_Object QCunderline
;
285 static Lisp_Object QCinverse_video
, QCstipple
;
286 Lisp_Object QCforeground
, QCbackground
;
288 static Lisp_Object QCfont
, QCbold
, QCitalic
;
289 static Lisp_Object QCreverse_video
;
290 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
291 static Lisp_Object QCfontset
, QCdistant_foreground
;
293 /* Symbols used for attribute values. */
297 static Lisp_Object Qline
, Qwave
;
298 Lisp_Object Qextra_light
, Qlight
;
299 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
300 Lisp_Object Qoblique
;
302 static Lisp_Object Qreleased_button
, Qpressed_button
;
303 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
304 Lisp_Object Qunspecified
; /* used in dosfns.c */
305 static Lisp_Object QCignore_defface
;
307 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
309 /* The name of the function to call when the background of the frame
310 has changed, frame_set_background_mode. */
312 static Lisp_Object Qframe_set_background_mode
;
314 /* Names of basic faces. */
316 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
317 static Lisp_Object Qregion
;
318 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
319 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
320 Lisp_Object Qmode_line_inactive
;
321 static Lisp_Object Qvertical_border
;
322 static Lisp_Object Qwindow_divider
;
323 static Lisp_Object Qwindow_divider_first_pixel
;
324 static Lisp_Object Qwindow_divider_last_pixel
;
326 /* The symbol `face-alias'. A symbols having that property is an
327 alias for another face. Value of the property is the name of
330 static Lisp_Object Qface_alias
;
332 /* Alist of alternative font families. Each element is of the form
333 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
334 try FAMILY1, then FAMILY2, ... */
336 Lisp_Object Vface_alternative_font_family_alist
;
338 /* Alist of alternative font registries. Each element is of the form
339 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
340 loaded, try REGISTRY1, then REGISTRY2, ... */
342 Lisp_Object Vface_alternative_font_registry_alist
;
344 /* Allowed scalable fonts. A value of nil means don't allow any
345 scalable fonts. A value of t means allow the use of any scalable
346 font. Otherwise, value must be a list of regular expressions. A
347 font may be scaled if its name matches a regular expression in the
350 static Lisp_Object Qscalable_fonts_allowed
;
352 /* The symbols `foreground-color' and `background-color' which can be
353 used as part of a `face' property. This is for compatibility with
356 Lisp_Object Qforeground_color
, Qbackground_color
;
358 /* The symbols `face' and `mouse-face' used as text properties. */
362 /* Property for basic faces which other faces cannot inherit. */
364 static Lisp_Object Qface_no_inherit
;
366 /* Error symbol for wrong_type_argument in load_pixmap. */
368 static Lisp_Object Qbitmap_spec_p
;
370 /* The next ID to assign to Lisp faces. */
372 static int next_lface_id
;
374 /* A vector mapping Lisp face Id's to face names. */
376 static Lisp_Object
*lface_id_to_name
;
377 static ptrdiff_t lface_id_to_name_size
;
379 /* TTY color-related functions (defined in tty-colors.el). */
381 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
383 /* The name of the function used to compute colors on TTYs. */
385 static Lisp_Object Qtty_color_alist
;
387 #ifdef HAVE_WINDOW_SYSTEM
389 /* Counter for calls to clear_face_cache. If this counter reaches
390 CLEAR_FONT_TABLE_COUNT, and a frame has more than
391 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
393 static int clear_font_table_count
;
394 #define CLEAR_FONT_TABLE_COUNT 100
395 #define CLEAR_FONT_TABLE_NFONTS 10
397 #endif /* HAVE_WINDOW_SYSTEM */
399 /* Non-zero means face attributes have been changed since the last
400 redisplay. Used in redisplay_internal. */
402 int face_change_count
;
404 /* Non-zero means don't display bold text if a face's foreground
405 and background colors are the inverse of the default colors of the
406 display. This is a kluge to suppress `bold black' foreground text
407 which is hard to read on an LCD monitor. */
409 static int tty_suppress_bold_inverse_default_colors_p
;
411 /* A list of the form `((x . y))' used to avoid consing in
412 Finternal_set_lisp_face_attribute. */
414 static Lisp_Object Vparam_value_alist
;
416 /* The total number of colors currently allocated. */
419 static int ncolors_allocated
;
420 static int npixmaps_allocated
;
424 /* Non-zero means the definition of the `menu' face for new frames has
427 static int menu_face_changed_default
;
429 struct named_merge_point
;
431 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
433 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
434 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
435 static bool realize_basic_faces (struct frame
*);
436 static bool realize_default_face (struct frame
*);
437 static void realize_named_face (struct frame
*, Lisp_Object
, int);
438 static struct face_cache
*make_face_cache (struct frame
*);
439 static void free_face_cache (struct face_cache
*);
440 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
441 int, struct named_merge_point
*);
442 static int color_distance (XColor
*x
, XColor
*y
);
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
< ARRAYELTS (color_count
); ++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
, unsigned long *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 unsigned long *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
, unsigned long 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 faces early (Bug#17889). */
680 if (!realize_basic_faces (f
))
685 /* Free face cache of frame F. Called from frame-dependent
686 resource freeing function, e.g. (x|tty)_free_frame_resources. */
689 free_frame_faces (struct frame
*f
)
691 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
695 free_face_cache (face_cache
);
696 FRAME_FACE_CACHE (f
) = NULL
;
699 #ifdef HAVE_WINDOW_SYSTEM
700 if (FRAME_WINDOW_P (f
))
702 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
705 --image_cache
->refcount
;
706 if (image_cache
->refcount
== 0)
707 free_image_cache (f
);
710 #endif /* HAVE_WINDOW_SYSTEM */
714 /* Clear face caches, and recompute basic faces for frame F. Call
715 this after changing frame parameters on which those faces depend,
716 or when realized faces have been freed due to changing attributes
720 recompute_basic_faces (struct frame
*f
)
722 if (FRAME_FACE_CACHE (f
))
724 clear_face_cache (0);
725 if (!realize_basic_faces (f
))
731 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
732 try to free unused fonts, too. */
735 clear_face_cache (int clear_fonts_p
)
737 #ifdef HAVE_WINDOW_SYSTEM
738 Lisp_Object tail
, frame
;
741 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
743 /* From time to time see if we can unload some fonts. This also
744 frees all realized faces on all frames. Fonts needed by
745 faces will be loaded again when faces are realized again. */
746 clear_font_table_count
= 0;
748 FOR_EACH_FRAME (tail
, frame
)
750 struct frame
*f
= XFRAME (frame
);
751 if (FRAME_WINDOW_P (f
)
752 && FRAME_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
754 clear_font_cache (f
);
755 free_all_realized_faces (frame
);
761 /* Clear GCs of realized faces. */
762 FOR_EACH_FRAME (tail
, frame
)
764 struct frame
*f
= XFRAME (frame
);
765 if (FRAME_WINDOW_P (f
))
766 clear_face_gcs (FRAME_FACE_CACHE (f
));
768 clear_image_caches (Qnil
);
770 #endif /* HAVE_WINDOW_SYSTEM */
774 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
775 doc
: /* Clear face caches on all frames.
776 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
777 (Lisp_Object thoroughly
)
779 clear_face_cache (!NILP (thoroughly
));
781 windows_or_buffers_changed
= 53;
786 /***********************************************************************
788 ***********************************************************************/
790 #ifdef HAVE_WINDOW_SYSTEM
792 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
793 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
794 A bitmap specification is either a string, a file name, or a list
795 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
796 HEIGHT is its height, and DATA is a string containing the bits of
797 the pixmap. Bits are stored row by row, each row occupies
798 \(WIDTH + 7)/8 bytes. */)
803 if (STRINGP (object
))
804 /* If OBJECT is a string, it's a file name. */
806 else if (CONSP (object
))
808 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
809 HEIGHT must be ints > 0, and DATA must be string large
810 enough to hold a bitmap of the specified size. */
811 Lisp_Object width
, height
, data
;
813 height
= width
= data
= Qnil
;
817 width
= XCAR (object
);
818 object
= XCDR (object
);
821 height
= XCAR (object
);
822 object
= XCDR (object
);
824 data
= XCAR (object
);
829 && RANGED_INTEGERP (1, width
, INT_MAX
)
830 && RANGED_INTEGERP (1, height
, INT_MAX
))
832 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
834 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
839 return pixmap_p
? Qt
: Qnil
;
843 /* Load a bitmap according to NAME (which is either a file name or a
844 pixmap spec) for use on frame F. Value is the bitmap_id (see
845 xfns.c). If NAME is nil, return with a bitmap id of zero. If
846 bitmap cannot be loaded, display a message saying so, and return
850 load_pixmap (struct frame
*f
, Lisp_Object name
)
857 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
862 /* Decode a bitmap spec into a bitmap. */
867 w
= XINT (Fcar (name
));
868 h
= XINT (Fcar (Fcdr (name
)));
869 bits
= Fcar (Fcdr (Fcdr (name
)));
871 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
876 /* It must be a string -- a file name. */
877 bitmap_id
= x_create_bitmap_from_file (f
, name
);
883 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
889 ++npixmaps_allocated
;
896 #endif /* HAVE_WINDOW_SYSTEM */
900 /***********************************************************************
902 ***********************************************************************/
904 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
905 RGB_LIST should contain (at least) 3 lisp integers.
906 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
909 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
911 #define PARSE_RGB_LIST_FIELD(field) \
912 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
914 color->field = XINT (XCAR (rgb_list)); \
915 rgb_list = XCDR (rgb_list); \
920 PARSE_RGB_LIST_FIELD (red
);
921 PARSE_RGB_LIST_FIELD (green
);
922 PARSE_RGB_LIST_FIELD (blue
);
928 /* Lookup on frame F the color described by the lisp string COLOR.
929 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
930 non-zero, then the `standard' definition of the same color is
934 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
937 Lisp_Object frame
, color_desc
;
939 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
942 XSETFRAME (frame
, f
);
944 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
945 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
949 if (! INTEGERP (XCAR (XCDR (color_desc
))))
952 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
954 rgb
= XCDR (XCDR (color_desc
));
955 if (! parse_rgb_list (rgb
, tty_color
))
958 /* Should we fill in STD_COLOR too? */
961 /* Default STD_COLOR to the same as TTY_COLOR. */
962 *std_color
= *tty_color
;
964 /* Do a quick check to see if the returned descriptor is
965 actually _exactly_ equal to COLOR, otherwise we have to
966 lookup STD_COLOR separately. If it's impossible to lookup
967 a standard color, we just give up and use TTY_COLOR. */
968 if ((!STRINGP (XCAR (color_desc
))
969 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
970 && !NILP (Ffboundp (Qtty_color_standard_values
)))
972 /* Look up STD_COLOR separately. */
973 rgb
= call1 (Qtty_color_standard_values
, color
);
974 if (! parse_rgb_list (rgb
, std_color
))
981 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
982 /* We were called early during startup, and the colors are not
983 yet set up in tty-defined-color-alist. Don't return a failure
984 indication, since this produces the annoying "Unable to
985 load color" messages in the *Messages* buffer. */
988 /* tty-color-desc seems to have returned a bad value. */
992 /* A version of defined_color for non-X frames. */
995 tty_defined_color (struct frame
*f
, const char *color_name
,
996 XColor
*color_def
, bool alloc
)
1001 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1003 color_def
->blue
= 0;
1004 color_def
->green
= 0;
1007 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1009 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1011 if (strcmp (color_name
, "unspecified-fg") == 0)
1012 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1013 else if (strcmp (color_name
, "unspecified-bg") == 0)
1014 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1017 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1024 /* Decide if color named COLOR_NAME is valid for the display
1025 associated with the frame F; if so, return the rgb values in
1026 COLOR_DEF. If ALLOC, allocate a new colormap cell.
1028 This does the right thing for any type of frame. */
1031 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1034 if (!FRAME_WINDOW_P (f
))
1035 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1036 #ifdef HAVE_X_WINDOWS
1037 else if (FRAME_X_P (f
))
1038 return x_defined_color (f
, color_name
, color_def
, alloc
);
1041 else if (FRAME_W32_P (f
))
1042 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1045 else if (FRAME_NS_P (f
))
1046 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1053 /* Given the index IDX of a tty color on frame F, return its name, a
1057 tty_color_name (struct frame
*f
, int idx
)
1059 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1062 Lisp_Object coldesc
;
1064 XSETFRAME (frame
, f
);
1065 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1067 if (!NILP (coldesc
))
1068 return XCAR (coldesc
);
1071 /* We can have an MS-DOS frame under -nw for a short window of
1072 opportunity before internal_terminal_init is called. DTRT. */
1073 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1074 return msdos_stdcolor_name (idx
);
1077 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1078 return build_string (unspecified_fg
);
1079 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1080 return build_string (unspecified_bg
);
1082 return Qunspecified
;
1086 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1089 The criterion implemented here is not a terribly sophisticated one. */
1092 face_color_gray_p (struct frame
*f
, const char *color_name
)
1097 if (defined_color (f
, color_name
, &color
, 0))
1098 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1099 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1101 ((eabs (color
.red
- color
.green
)
1102 < max (color
.red
, color
.green
) / 20)
1103 && (eabs (color
.green
- color
.blue
)
1104 < max (color
.green
, color
.blue
) / 20)
1105 && (eabs (color
.blue
- color
.red
)
1106 < max (color
.blue
, color
.red
) / 20)));
1114 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1115 BACKGROUND_P non-zero means the color will be used as background
1119 face_color_supported_p (struct frame
*f
, const char *color_name
,
1125 XSETFRAME (frame
, f
);
1127 #ifdef HAVE_WINDOW_SYSTEM
1129 ? (!NILP (Fxw_display_color_p (frame
))
1130 || xstrcasecmp (color_name
, "black") == 0
1131 || xstrcasecmp (color_name
, "white") == 0
1133 && face_color_gray_p (f
, color_name
))
1134 || (!NILP (Fx_display_grayscale_p (frame
))
1135 && face_color_gray_p (f
, color_name
)))
1138 tty_defined_color (f
, color_name
, ¬_used
, 0);
1142 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1143 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1144 FRAME specifies the frame and thus the display for interpreting COLOR.
1145 If FRAME is nil or omitted, use the selected frame. */)
1146 (Lisp_Object color
, Lisp_Object frame
)
1148 CHECK_STRING (color
);
1149 return (face_color_gray_p (decode_any_frame (frame
), SSDATA (color
))
1154 DEFUN ("color-supported-p", Fcolor_supported_p
,
1155 Scolor_supported_p
, 1, 3, 0,
1156 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1157 BACKGROUND-P non-nil means COLOR is used as a background.
1158 Otherwise, this function tells whether it can be used as a foreground.
1159 If FRAME is nil or omitted, use the selected frame.
1160 COLOR must be a valid color name. */)
1161 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1163 CHECK_STRING (color
);
1164 return (face_color_supported_p (decode_any_frame (frame
),
1165 SSDATA (color
), !NILP (background_p
))
1170 static unsigned long
1171 load_color2 (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1172 enum lface_attribute_index target_index
, XColor
*color
)
1174 eassert (STRINGP (name
));
1175 eassert (target_index
== LFACE_FOREGROUND_INDEX
1176 || target_index
== LFACE_BACKGROUND_INDEX
1177 || target_index
== LFACE_UNDERLINE_INDEX
1178 || target_index
== LFACE_OVERLINE_INDEX
1179 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1180 || target_index
== LFACE_BOX_INDEX
);
1182 /* if the color map is full, defined_color will return a best match
1183 to the values in an existing cell. */
1184 if (!defined_color (f
, SSDATA (name
), color
, 1))
1186 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1188 switch (target_index
)
1190 case LFACE_FOREGROUND_INDEX
:
1191 face
->foreground_defaulted_p
= 1;
1192 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1195 case LFACE_BACKGROUND_INDEX
:
1196 face
->background_defaulted_p
= 1;
1197 color
->pixel
= FRAME_BACKGROUND_PIXEL (f
);
1200 case LFACE_UNDERLINE_INDEX
:
1201 face
->underline_defaulted_p
= 1;
1202 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1205 case LFACE_OVERLINE_INDEX
:
1206 face
->overline_color_defaulted_p
= 1;
1207 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1210 case LFACE_STRIKE_THROUGH_INDEX
:
1211 face
->strike_through_color_defaulted_p
= 1;
1212 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1215 case LFACE_BOX_INDEX
:
1216 face
->box_color_defaulted_p
= 1;
1217 color
->pixel
= FRAME_FOREGROUND_PIXEL (f
);
1226 ++ncolors_allocated
;
1229 return color
->pixel
;
1232 /* Load color with name NAME for use by face FACE on frame F.
1233 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1234 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1235 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1236 pixel color. If color cannot be loaded, display a message, and
1237 return the foreground, background or underline color of F, but
1238 record that fact in flags of the face so that we don't try to free
1242 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1243 enum lface_attribute_index target_index
)
1246 return load_color2 (f
, face
, name
, target_index
, &color
);
1250 #ifdef HAVE_WINDOW_SYSTEM
1252 #define NEAR_SAME_COLOR_THRESHOLD 30000
1254 /* Load colors for face FACE which is used on frame F. Colors are
1255 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1256 of ATTRS. If the background color specified is not supported on F,
1257 try to emulate gray colors with a stipple from Vface_default_stipple. */
1260 load_face_colors (struct frame
*f
, struct face
*face
,
1261 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1263 Lisp_Object fg
, bg
, dfg
;
1266 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1267 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1269 /* Swap colors if face is inverse-video. */
1270 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1278 /* Check for support for foreground, not for background because
1279 face_color_supported_p is smart enough to know that grays are
1280 "supported" as background because we are supposed to use stipple
1282 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1283 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1285 x_destroy_bitmap (f
, face
->stipple
);
1286 face
->stipple
= load_pixmap (f
, Vface_default_stipple
);
1289 face
->background
= load_color2 (f
, face
, bg
, LFACE_BACKGROUND_INDEX
, &xbg
);
1290 face
->foreground
= load_color2 (f
, face
, fg
, LFACE_FOREGROUND_INDEX
, &xfg
);
1292 dfg
= attrs
[LFACE_DISTANT_FOREGROUND_INDEX
];
1293 if (!NILP (dfg
) && !UNSPECIFIEDP (dfg
)
1294 && color_distance (&xbg
, &xfg
) < NEAR_SAME_COLOR_THRESHOLD
)
1296 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1297 face
->background
= load_color (f
, face
, dfg
, LFACE_BACKGROUND_INDEX
);
1299 face
->foreground
= load_color (f
, face
, dfg
, LFACE_FOREGROUND_INDEX
);
1303 #ifdef HAVE_X_WINDOWS
1305 /* Free color PIXEL on frame F. */
1308 unload_color (struct frame
*f
, unsigned long pixel
)
1313 x_free_colors (f
, &pixel
, 1);
1318 /* Free colors allocated for FACE. */
1321 free_face_colors (struct frame
*f
, struct face
*face
)
1323 /* PENDING(NS): need to do something here? */
1325 if (face
->colors_copied_bitwise_p
)
1330 if (!face
->foreground_defaulted_p
)
1332 x_free_colors (f
, &face
->foreground
, 1);
1333 IF_DEBUG (--ncolors_allocated
);
1336 if (!face
->background_defaulted_p
)
1338 x_free_colors (f
, &face
->background
, 1);
1339 IF_DEBUG (--ncolors_allocated
);
1342 if (face
->underline_p
1343 && !face
->underline_defaulted_p
)
1345 x_free_colors (f
, &face
->underline_color
, 1);
1346 IF_DEBUG (--ncolors_allocated
);
1349 if (face
->overline_p
1350 && !face
->overline_color_defaulted_p
)
1352 x_free_colors (f
, &face
->overline_color
, 1);
1353 IF_DEBUG (--ncolors_allocated
);
1356 if (face
->strike_through_p
1357 && !face
->strike_through_color_defaulted_p
)
1359 x_free_colors (f
, &face
->strike_through_color
, 1);
1360 IF_DEBUG (--ncolors_allocated
);
1363 if (face
->box
!= FACE_NO_BOX
1364 && !face
->box_color_defaulted_p
)
1366 x_free_colors (f
, &face
->box_color
, 1);
1367 IF_DEBUG (--ncolors_allocated
);
1373 #endif /* HAVE_X_WINDOWS */
1375 #endif /* HAVE_WINDOW_SYSTEM */
1379 /***********************************************************************
1381 ***********************************************************************/
1383 /* An enumerator for each field of an XLFD font name. */
1404 /* An enumerator for each possible slant value of a font. Taken from
1405 the XLFD specification. */
1413 XLFD_SLANT_REVERSE_ITALIC
,
1414 XLFD_SLANT_REVERSE_OBLIQUE
,
1418 /* Relative font weight according to XLFD documentation. */
1422 XLFD_WEIGHT_UNKNOWN
,
1423 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1424 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1425 XLFD_WEIGHT_LIGHT
, /* 30 */
1426 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1427 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1428 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1429 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1430 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1431 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1434 /* Relative proportionate width. */
1438 XLFD_SWIDTH_UNKNOWN
,
1439 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1440 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1441 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1442 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1443 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1444 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1445 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1446 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1447 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1450 /* Order by which font selection chooses fonts. The default values
1451 mean `first, find a best match for the font width, then for the
1452 font height, then for weight, then for slant.' This variable can be
1453 set via set-face-font-sort-order. */
1455 static int font_sort_order
[4];
1457 #ifdef HAVE_WINDOW_SYSTEM
1459 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1462 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1464 Lisp_Object
const *p1
= v1
;
1465 Lisp_Object
const *p2
= v2
;
1466 Lisp_Object font1
= *p1
;
1467 Lisp_Object font2
= *p2
;
1470 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1472 enum font_property_index idx
= font_props_for_sorting
[i
];
1473 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1476 if (idx
<= FONT_REGISTRY_INDEX
)
1479 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1481 result
= STRINGP (val2
) ? 1 : 0;
1485 if (INTEGERP (val1
))
1486 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1487 ? XINT (val1
) > XINT (val2
)
1490 result
= INTEGERP (val2
) ? 1 : 0;
1498 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1499 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1500 If FAMILY is omitted or nil, list all families.
1501 Otherwise, FAMILY must be a string, possibly containing wildcards
1503 If FRAME is omitted or nil, use the selected frame.
1504 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1505 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1506 FAMILY is the font family name. POINT-SIZE is the size of the
1507 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1508 width, weight and slant of the font. These symbols are the same as for
1509 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1510 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1511 giving the registry and encoding of the font.
1512 The result list is sorted according to the current setting of
1513 the face font sort order. */)
1514 (Lisp_Object family
, Lisp_Object frame
)
1516 Lisp_Object font_spec
, list
, *drivers
, vec
;
1517 struct frame
*f
= decode_live_frame (frame
);
1518 ptrdiff_t i
, nfonts
;
1523 font_spec
= Ffont_spec (0, NULL
);
1526 CHECK_STRING (family
);
1527 font_parse_family_registry (family
, Qnil
, font_spec
);
1530 list
= font_list_entities (f
, font_spec
);
1534 /* Sort the font entities. */
1535 for (i
= 0; i
< 4; i
++)
1536 switch (font_sort_order
[i
])
1539 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1540 case XLFD_POINT_SIZE
:
1541 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1543 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1545 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1547 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1548 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1549 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1550 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1552 ndrivers
= XINT (Flength (list
));
1553 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1554 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1555 drivers
[i
] = XCAR (list
);
1556 vec
= Fvconcat (ndrivers
, drivers
);
1557 nfonts
= ASIZE (vec
);
1559 qsort (XVECTOR (vec
)->contents
, nfonts
, word_size
,
1560 compare_fonts_by_sort_order
);
1563 for (i
= nfonts
- 1; i
>= 0; --i
)
1565 Lisp_Object font
= AREF (vec
, i
);
1566 Lisp_Object v
= make_uninit_vector (8);
1568 Lisp_Object spacing
;
1570 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1571 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1572 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1574 ASET (v
, 2, make_number (point
));
1575 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1576 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1577 spacing
= Ffont_get (font
, QCspacing
);
1578 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1579 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1580 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1582 result
= Fcons (v
, result
);
1589 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1590 doc
: /* Return a list of the names of available fonts matching PATTERN.
1591 If optional arguments FACE and FRAME are specified, return only fonts
1592 the same size as FACE on FRAME.
1594 PATTERN should be a string containing a font name in the XLFD,
1595 Fontconfig, or GTK format. A font name given in the XLFD format may
1596 contain wildcard characters:
1597 the * character matches any substring, and
1598 the ? character matches any single character.
1599 PATTERN is case-insensitive.
1601 The return value is a list of strings, suitable as arguments to
1604 Fonts Emacs can't use may or may not be excluded
1605 even if they match PATTERN and FACE.
1606 The optional fourth argument MAXIMUM sets a limit on how many
1607 fonts to match. The first MAXIMUM fonts are reported.
1608 The optional fifth argument WIDTH, if specified, is a number of columns
1609 occupied by a character of a font. In that case, return only fonts
1610 the WIDTH times as wide as FACE on FRAME. */)
1611 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1612 Lisp_Object maximum
, Lisp_Object width
)
1615 int size
, avgwidth
IF_LINT (= 0);
1617 check_window_system (NULL
);
1618 CHECK_STRING (pattern
);
1620 if (! NILP (maximum
))
1621 CHECK_NATNUM (maximum
);
1624 CHECK_NUMBER (width
);
1626 /* We can't simply call decode_window_system_frame because
1627 this function may be called before any frame is created. */
1628 f
= decode_live_frame (frame
);
1629 if (! FRAME_WINDOW_P (f
))
1631 /* Perhaps we have not yet created any frame. */
1637 XSETFRAME (frame
, f
);
1639 /* Determine the width standard for comparison with the fonts we find. */
1645 /* This is of limited utility since it works with character
1646 widths. Keep it for compatibility. --gerd. */
1647 int face_id
= lookup_named_face (f
, face
, 0);
1648 struct face
*width_face
= (face_id
< 0
1650 : FACE_FROM_ID (f
, face_id
));
1652 if (width_face
&& width_face
->font
)
1654 size
= width_face
->font
->pixel_size
;
1655 avgwidth
= width_face
->font
->average_width
;
1659 size
= FRAME_FONT (f
)->pixel_size
;
1660 avgwidth
= FRAME_FONT (f
)->average_width
;
1663 avgwidth
*= XINT (width
);
1667 Lisp_Object font_spec
;
1668 Lisp_Object args
[2], tail
;
1670 font_spec
= font_spec_from_name (pattern
);
1671 if (!FONTP (font_spec
))
1672 signal_error ("Invalid font name", pattern
);
1676 Ffont_put (font_spec
, QCsize
, make_number (size
));
1677 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1679 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1680 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1682 Lisp_Object font_entity
;
1684 font_entity
= XCAR (tail
);
1685 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1686 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1687 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1689 /* This is a scalable font. For backward compatibility,
1690 we set the specified size. */
1691 font_entity
= copy_font_spec (font_entity
);
1692 ASET (font_entity
, FONT_SIZE_INDEX
,
1693 AREF (font_spec
, FONT_SIZE_INDEX
));
1695 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1698 /* We don't have to check fontsets. */
1700 args
[1] = list_fontsets (f
, pattern
, size
);
1701 return Fnconc (2, args
);
1705 #endif /* HAVE_WINDOW_SYSTEM */
1708 /***********************************************************************
1710 ***********************************************************************/
1712 /* Access face attributes of face LFACE, a Lisp vector. */
1714 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1715 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1716 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1717 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1718 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1719 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1720 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1721 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1722 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1723 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1724 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1725 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1726 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1727 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1728 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1729 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1730 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1731 #define LFACE_DISTANT_FOREGROUND(LFACE) \
1732 AREF ((LFACE), LFACE_DISTANT_FOREGROUND_INDEX)
1734 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1735 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1737 #define LFACEP(LFACE) \
1739 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1740 && EQ (AREF (LFACE, 0), Qface))
1745 /* Check consistency of Lisp face attribute vector ATTRS. */
1748 check_lface_attrs (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
1750 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1751 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1752 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1753 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1754 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1755 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1756 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1757 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1758 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1759 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1760 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1761 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1762 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1763 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1764 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1765 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1766 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1767 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1768 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1769 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1770 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1771 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1772 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1773 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1774 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1775 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1776 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1777 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1778 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1779 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1780 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1781 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1782 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1783 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1784 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1785 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1786 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1787 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1788 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1789 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1790 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1791 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1792 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1793 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1794 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1795 eassert (UNSPECIFIEDP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
1796 || IGNORE_DEFFACE_P (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
1797 || STRINGP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
]));
1798 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1799 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1800 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1801 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1802 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1803 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1804 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1805 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1806 #ifdef HAVE_WINDOW_SYSTEM
1807 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1808 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1809 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1810 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1811 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1812 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1813 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1814 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1815 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1816 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1821 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1824 check_lface (Lisp_Object lface
)
1828 eassert (LFACEP (lface
));
1829 check_lface_attrs (XVECTOR (lface
)->contents
);
1833 #else /* not GLYPH_DEBUG */
1835 #define check_lface_attrs(attrs) (void) 0
1836 #define check_lface(lface) (void) 0
1838 #endif /* GLYPH_DEBUG */
1842 /* Face-merge cycle checking. */
1844 enum named_merge_point_kind
1846 NAMED_MERGE_POINT_NORMAL
,
1847 NAMED_MERGE_POINT_REMAP
1850 /* A `named merge point' is simply a point during face-merging where we
1851 look up a face by name. We keep a stack of which named lookups we're
1852 currently processing so that we can easily detect cycles, using a
1853 linked- list of struct named_merge_point structures, typically
1854 allocated on the stack frame of the named lookup functions which are
1855 active (so no consing is required). */
1856 struct named_merge_point
1858 Lisp_Object face_name
;
1859 enum named_merge_point_kind named_merge_point_kind
;
1860 struct named_merge_point
*prev
;
1864 /* If a face merging cycle is detected for FACE_NAME, return 0,
1865 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1866 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1867 pointed to by NAMED_MERGE_POINTS, and return 1. */
1870 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1871 Lisp_Object face_name
,
1872 enum named_merge_point_kind named_merge_point_kind
,
1873 struct named_merge_point
**named_merge_points
)
1875 struct named_merge_point
*prev
;
1877 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1878 if (EQ (face_name
, prev
->face_name
))
1880 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1881 /* A cycle, so fail. */
1883 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1884 /* A remap `hides ' any previous normal merge points
1885 (because the remap means that it's actually different face),
1886 so as we know the current merge point must be normal, we
1887 can just assume it's OK. */
1891 new_named_merge_point
->face_name
= face_name
;
1892 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1893 new_named_merge_point
->prev
= *named_merge_points
;
1895 *named_merge_points
= new_named_merge_point
;
1901 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1902 to make it a symbol. If FACE_NAME is an alias for another face,
1903 return that face's name.
1905 Return default face in case of errors. */
1908 resolve_face_name (Lisp_Object face_name
, int signal_p
)
1910 Lisp_Object orig_face
;
1911 Lisp_Object tortoise
, hare
;
1913 if (STRINGP (face_name
))
1914 face_name
= intern (SSDATA (face_name
));
1916 if (NILP (face_name
) || !SYMBOLP (face_name
))
1919 orig_face
= face_name
;
1920 tortoise
= hare
= face_name
;
1925 hare
= Fget (hare
, Qface_alias
);
1926 if (NILP (hare
) || !SYMBOLP (hare
))
1930 hare
= Fget (hare
, Qface_alias
);
1931 if (NILP (hare
) || !SYMBOLP (hare
))
1934 tortoise
= Fget (tortoise
, Qface_alias
);
1935 if (EQ (hare
, tortoise
))
1938 xsignal1 (Qcircular_list
, orig_face
);
1947 /* Return the face definition of FACE_NAME on frame F. F null means
1948 return the definition for new frames. FACE_NAME may be a string or
1949 a symbol (apparently Emacs 20.2 allowed strings as face names in
1950 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
1951 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
1952 is zero, value is nil if FACE_NAME is not a valid face name. */
1954 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
1960 lface
= assq_no_quit (face_name
, f
->face_alist
);
1962 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
1965 lface
= XCDR (lface
);
1967 signal_error ("Invalid face", face_name
);
1969 check_lface (lface
);
1974 /* Return the face definition of FACE_NAME on frame F. F null means
1975 return the definition for new frames. FACE_NAME may be a string or
1976 a symbol (apparently Emacs 20.2 allowed strings as face names in
1977 face text properties; Ediff uses that). If FACE_NAME is an alias
1978 for another face, return that face's definition. If SIGNAL_P is
1979 non-zero, signal an error if FACE_NAME is not a valid face name.
1980 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
1983 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
1985 face_name
= resolve_face_name (face_name
, signal_p
);
1986 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
1990 /* Get face attributes of face FACE_NAME from frame-local faces on
1991 frame F. Store the resulting attributes in ATTRS which must point
1992 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
1993 is non-zero, signal an error if FACE_NAME does not name a face.
1994 Otherwise, value is zero if FACE_NAME is not a face. */
1997 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
1998 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
2003 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2006 memcpy (attrs
, XVECTOR (lface
)->contents
,
2007 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2009 return !NILP (lface
);
2012 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2013 F. Store the resulting attributes in ATTRS which must point to a
2014 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2015 alias for another face, use that face's definition. If SIGNAL_P is
2016 non-zero, signal an error if FACE_NAME does not name a face.
2017 Otherwise, value is zero if FACE_NAME is not a face. */
2020 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2021 Lisp_Object attrs
[LFACE_VECTOR_SIZE
], int signal_p
,
2022 struct named_merge_point
*named_merge_points
)
2024 Lisp_Object face_remapping
;
2026 face_name
= resolve_face_name (face_name
, signal_p
);
2028 /* See if SYMBOL has been remapped to some other face (usually this
2029 is done buffer-locally). */
2030 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2031 if (CONSP (face_remapping
))
2033 struct named_merge_point named_merge_point
;
2035 if (push_named_merge_point (&named_merge_point
,
2036 face_name
, NAMED_MERGE_POINT_REMAP
,
2037 &named_merge_points
))
2041 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2042 attrs
[i
] = Qunspecified
;
2044 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2045 signal_p
, named_merge_points
);
2049 /* Default case, no remapping. */
2050 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2054 /* Non-zero if all attributes in face attribute vector ATTRS are
2055 specified, i.e. are non-nil. */
2058 lface_fully_specified_p (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
2062 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2063 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
2064 && i
!= LFACE_DISTANT_FOREGROUND_INDEX
)
2065 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2068 return i
== LFACE_VECTOR_SIZE
;
2071 #ifdef HAVE_WINDOW_SYSTEM
2073 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2074 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2075 exception is `font' attribute. It is set to FONT_OBJECT regardless
2079 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2080 Lisp_Object font_object
, int force_p
)
2083 struct font
*font
= XFONT_OBJECT (font_object
);
2085 /* Set attributes only if unspecified, otherwise face defaults for
2086 new frames would never take effect. If the font doesn't have a
2087 specific property, set a normal value for that. */
2089 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2091 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2093 ASET (lface
, LFACE_FAMILY_INDEX
, SYMBOL_NAME (family
));
2096 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2098 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2100 ASET (lface
, LFACE_FOUNDRY_INDEX
, SYMBOL_NAME (foundry
));
2103 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2105 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, FRAME_RES_Y (f
));
2108 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (pt
));
2111 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2113 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2114 ASET (lface
, LFACE_WEIGHT_INDEX
, ! NILP (val
) ? val
:Qnormal
);
2116 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2118 val
= FONT_SLANT_FOR_FACE (font_object
);
2119 ASET (lface
, LFACE_SLANT_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2121 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2123 val
= FONT_WIDTH_FOR_FACE (font_object
);
2124 ASET (lface
, LFACE_SWIDTH_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2127 ASET (lface
, LFACE_FONT_INDEX
, font_object
);
2131 #endif /* HAVE_WINDOW_SYSTEM */
2134 /* Merges the face height FROM with the face height TO, and returns the
2135 merged height. If FROM is an invalid height, then INVALID is
2136 returned instead. FROM and TO may be either absolute face heights or
2137 `relative' heights; the returned value is always an absolute height
2138 unless both FROM and TO are relative. */
2141 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2143 Lisp_Object result
= invalid
;
2145 if (INTEGERP (from
))
2146 /* FROM is absolute, just use it as is. */
2148 else if (FLOATP (from
))
2149 /* FROM is a scale, use it to adjust TO. */
2152 /* relative X absolute => absolute */
2153 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2154 else if (FLOATP (to
))
2155 /* relative X relative => relative */
2156 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2157 else if (UNSPECIFIEDP (to
))
2160 else if (FUNCTIONP (from
))
2161 /* FROM is a function, which use to adjust TO. */
2163 /* Call function with current height as argument.
2164 From is the new height. */
2165 result
= safe_call1 (from
, to
);
2167 /* Ensure that if TO was absolute, so is the result. */
2168 if (INTEGERP (to
) && !INTEGERP (result
))
2176 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2177 store the resulting attributes in TO, which must be already be
2178 completely specified and contain only absolute attributes. Every
2179 specified attribute of FROM overrides the corresponding attribute of
2180 TO; relative attributes in FROM are merged with the absolute value in
2181 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2182 loops in face inheritance/remapping; it should be 0 when called from
2186 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2187 struct named_merge_point
*named_merge_points
)
2190 Lisp_Object font
= Qnil
;
2192 /* If FROM inherits from some other faces, merge their attributes into
2193 TO before merging FROM's direct attributes. Note that an :inherit
2194 attribute of `unspecified' is the same as one of nil; we never
2195 merge :inherit attributes, so nil is more correct, but lots of
2196 other code uses `unspecified' as a generic value for face attributes. */
2197 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2198 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2199 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2201 if (FONT_SPEC_P (from
[LFACE_FONT_INDEX
]))
2203 if (!UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2204 font
= merge_font_spec (from
[LFACE_FONT_INDEX
], to
[LFACE_FONT_INDEX
]);
2206 font
= copy_font_spec (from
[LFACE_FONT_INDEX
]);
2207 to
[LFACE_FONT_INDEX
] = font
;
2210 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2211 if (!UNSPECIFIEDP (from
[i
]))
2213 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2215 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2216 font_clear_prop (to
, FONT_SIZE_INDEX
);
2218 else if (i
!= LFACE_FONT_INDEX
&& ! EQ (to
[i
], from
[i
]))
2221 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2222 font_clear_prop (to
,
2223 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2224 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2225 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2226 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2227 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2228 : FONT_SLANT_INDEX
));
2232 /* If FROM specifies a font spec, make its contents take precedence
2233 over :family and other attributes. This is needed for face
2234 remapping using :font to work. */
2238 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
2239 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
));
2240 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
2241 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
));
2242 if (! NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
2243 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (font
);
2244 if (! NILP (AREF (font
, FONT_SLANT_INDEX
)))
2245 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (font
);
2246 if (! NILP (AREF (font
, FONT_WIDTH_INDEX
)))
2247 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (font
);
2248 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
2251 /* TO is always an absolute face, which should inherit from nothing.
2252 We blindly copy the :inherit attribute above and fix it up here. */
2253 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2256 /* Merge the named face FACE_NAME on frame F, into the vector of face
2257 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2258 inheritance. Returns true if FACE_NAME is a valid face name and
2259 merging succeeded. */
2262 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2263 struct named_merge_point
*named_merge_points
)
2265 struct named_merge_point named_merge_point
;
2267 if (push_named_merge_point (&named_merge_point
,
2268 face_name
, NAMED_MERGE_POINT_NORMAL
,
2269 &named_merge_points
))
2271 struct gcpro gcpro1
;
2272 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2273 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2277 GCPRO1 (named_merge_point
.face_name
);
2278 merge_face_vectors (f
, from
, to
, named_merge_points
);
2289 /* Merge face attributes from the lisp `face reference' FACE_REF on
2290 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2291 problems with FACE_REF cause an error message to be shown. Return
2292 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2293 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2294 list structure; it may be 0 for most callers.
2296 FACE_REF may be a single face specification or a list of such
2297 specifications. Each face specification can be:
2299 1. A symbol or string naming a Lisp face.
2301 2. A property list of the form (KEYWORD VALUE ...) where each
2302 KEYWORD is a face attribute name, and value is an appropriate value
2305 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2306 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2307 for compatibility with 20.2.
2309 Face specifications earlier in lists take precedence over later
2313 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2314 int err_msgs
, struct named_merge_point
*named_merge_points
)
2316 int ok
= 1; /* Succeed without an error? */
2318 if (CONSP (face_ref
))
2320 Lisp_Object first
= XCAR (face_ref
);
2322 if (EQ (first
, Qforeground_color
)
2323 || EQ (first
, Qbackground_color
))
2325 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2326 . COLOR). COLOR must be a string. */
2327 Lisp_Object color_name
= XCDR (face_ref
);
2328 Lisp_Object color
= first
;
2330 if (STRINGP (color_name
))
2332 if (EQ (color
, Qforeground_color
))
2333 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2335 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2340 add_to_log ("Invalid face color", color_name
, Qnil
);
2344 else if (SYMBOLP (first
)
2345 && *SDATA (SYMBOL_NAME (first
)) == ':')
2347 /* Assume this is the property list form. */
2348 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2350 Lisp_Object keyword
= XCAR (face_ref
);
2351 Lisp_Object value
= XCAR (XCDR (face_ref
));
2354 /* Specifying `unspecified' is a no-op. */
2355 if (EQ (value
, Qunspecified
))
2357 else if (EQ (keyword
, QCfamily
))
2359 if (STRINGP (value
))
2361 to
[LFACE_FAMILY_INDEX
] = value
;
2362 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2367 else if (EQ (keyword
, QCfoundry
))
2369 if (STRINGP (value
))
2371 to
[LFACE_FOUNDRY_INDEX
] = value
;
2372 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2377 else if (EQ (keyword
, QCheight
))
2379 Lisp_Object new_height
=
2380 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2382 if (! NILP (new_height
))
2384 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2385 font_clear_prop (to
, FONT_SIZE_INDEX
);
2390 else if (EQ (keyword
, QCweight
))
2392 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2394 to
[LFACE_WEIGHT_INDEX
] = value
;
2395 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2400 else if (EQ (keyword
, QCslant
))
2402 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2404 to
[LFACE_SLANT_INDEX
] = value
;
2405 font_clear_prop (to
, FONT_SLANT_INDEX
);
2410 else if (EQ (keyword
, QCunderline
))
2416 to
[LFACE_UNDERLINE_INDEX
] = value
;
2420 else if (EQ (keyword
, QCoverline
))
2425 to
[LFACE_OVERLINE_INDEX
] = value
;
2429 else if (EQ (keyword
, QCstrike_through
))
2434 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2438 else if (EQ (keyword
, QCbox
))
2441 value
= make_number (1);
2442 if (INTEGERP (value
)
2446 to
[LFACE_BOX_INDEX
] = value
;
2450 else if (EQ (keyword
, QCinverse_video
)
2451 || EQ (keyword
, QCreverse_video
))
2453 if (EQ (value
, Qt
) || NILP (value
))
2454 to
[LFACE_INVERSE_INDEX
] = value
;
2458 else if (EQ (keyword
, QCforeground
))
2460 if (STRINGP (value
))
2461 to
[LFACE_FOREGROUND_INDEX
] = value
;
2465 else if (EQ (keyword
, QCdistant_foreground
))
2467 if (STRINGP (value
))
2468 to
[LFACE_DISTANT_FOREGROUND_INDEX
] = value
;
2472 else if (EQ (keyword
, QCbackground
))
2474 if (STRINGP (value
))
2475 to
[LFACE_BACKGROUND_INDEX
] = value
;
2479 else if (EQ (keyword
, QCstipple
))
2481 #if defined (HAVE_WINDOW_SYSTEM)
2482 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2483 if (!NILP (pixmap_p
))
2484 to
[LFACE_STIPPLE_INDEX
] = value
;
2487 #endif /* HAVE_WINDOW_SYSTEM */
2489 else if (EQ (keyword
, QCwidth
))
2491 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2493 to
[LFACE_SWIDTH_INDEX
] = value
;
2494 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2499 else if (EQ (keyword
, QCfont
))
2502 to
[LFACE_FONT_INDEX
] = value
;
2506 else if (EQ (keyword
, QCinherit
))
2508 /* This is not really very useful; it's just like a
2509 normal face reference. */
2510 if (! merge_face_ref (f
, value
, to
,
2511 err_msgs
, named_merge_points
))
2519 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2523 face_ref
= XCDR (XCDR (face_ref
));
2528 /* This is a list of face refs. Those at the beginning of the
2529 list take precedence over what follows, so we have to merge
2530 from the end backwards. */
2531 Lisp_Object next
= XCDR (face_ref
);
2534 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2536 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2542 /* FACE_REF ought to be a face name. */
2543 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2544 if (!ok
&& err_msgs
)
2545 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2552 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2553 Sinternal_make_lisp_face
, 1, 2, 0,
2554 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2555 If FACE was not known as a face before, create a new one.
2556 If optional argument FRAME is specified, make a frame-local face
2557 for that frame. Otherwise operate on the global face definition.
2558 Value is a vector of face attributes. */)
2559 (Lisp_Object face
, Lisp_Object frame
)
2561 Lisp_Object global_lface
, lface
;
2565 CHECK_SYMBOL (face
);
2566 global_lface
= lface_from_face_name (NULL
, face
, 0);
2570 CHECK_LIVE_FRAME (frame
);
2572 lface
= lface_from_face_name (f
, face
, 0);
2575 f
= NULL
, lface
= Qnil
;
2577 /* Add a global definition if there is none. */
2578 if (NILP (global_lface
))
2580 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2582 ASET (global_lface
, 0, Qface
);
2583 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2584 Vface_new_frame_defaults
);
2586 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2587 face id to Lisp face is given by the vector lface_id_to_name.
2588 The mapping from Lisp face to Lisp face id is given by the
2589 property `face' of the Lisp face name. */
2590 if (next_lface_id
== lface_id_to_name_size
)
2592 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2593 sizeof *lface_id_to_name
);
2595 lface_id_to_name
[next_lface_id
] = face
;
2596 Fput (face
, Qface
, make_number (next_lface_id
));
2600 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2601 ASET (global_lface
, i
, Qunspecified
);
2603 /* Add a frame-local definition. */
2608 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2610 ASET (lface
, 0, Qface
);
2611 fset_face_alist (f
, Fcons (Fcons (face
, lface
), f
->face_alist
));
2614 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2615 ASET (lface
, i
, Qunspecified
);
2618 lface
= global_lface
;
2620 /* Changing a named face means that all realized faces depending on
2621 that face are invalid. Since we cannot tell which realized faces
2622 depend on the face, make sure they are all removed. This is done
2623 by incrementing face_change_count. The next call to
2624 init_iterator will then free realized faces. */
2625 if (NILP (Fget (face
, Qface_no_inherit
)))
2627 ++face_change_count
;
2628 windows_or_buffers_changed
= 54;
2631 eassert (LFACEP (lface
));
2632 check_lface (lface
);
2637 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2638 Sinternal_lisp_face_p
, 1, 2, 0,
2639 doc
: /* Return non-nil if FACE names a face.
2640 FACE should be a symbol or string.
2641 If optional second argument FRAME is non-nil, check for the
2642 existence of a frame-local face with name FACE on that frame.
2643 Otherwise check for the existence of a global face. */)
2644 (Lisp_Object face
, Lisp_Object frame
)
2648 face
= resolve_face_name (face
, 1);
2652 CHECK_LIVE_FRAME (frame
);
2653 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2656 lface
= lface_from_face_name (NULL
, face
, 0);
2662 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2663 Sinternal_copy_lisp_face
, 4, 4, 0,
2664 doc
: /* Copy face FROM to TO.
2665 If FRAME is t, copy the global face definition of FROM.
2666 Otherwise, copy the frame-local definition of FROM on FRAME.
2667 If NEW-FRAME is a frame, copy that data into the frame-local
2668 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2669 FRAME controls where the data is copied to.
2671 The value is TO. */)
2672 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2674 Lisp_Object lface
, copy
;
2676 CHECK_SYMBOL (from
);
2681 /* Copy global definition of FROM. We don't make copies of
2682 strings etc. because 20.2 didn't do it either. */
2683 lface
= lface_from_face_name (NULL
, from
, 1);
2684 copy
= Finternal_make_lisp_face (to
, Qnil
);
2688 /* Copy frame-local definition of FROM. */
2689 if (NILP (new_frame
))
2691 CHECK_LIVE_FRAME (frame
);
2692 CHECK_LIVE_FRAME (new_frame
);
2693 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2694 copy
= Finternal_make_lisp_face (to
, new_frame
);
2697 vcopy (copy
, 0, XVECTOR (lface
)->contents
, LFACE_VECTOR_SIZE
);
2699 /* Changing a named face means that all realized faces depending on
2700 that face are invalid. Since we cannot tell which realized faces
2701 depend on the face, make sure they are all removed. This is done
2702 by incrementing face_change_count. The next call to
2703 init_iterator will then free realized faces. */
2704 if (NILP (Fget (to
, Qface_no_inherit
)))
2706 ++face_change_count
;
2707 windows_or_buffers_changed
= 55;
2714 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2715 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2716 doc
: /* Set attribute ATTR of FACE to VALUE.
2717 FRAME being a frame means change the face on that frame.
2718 FRAME nil means change the face of the selected frame.
2719 FRAME t means change the default for new frames.
2720 FRAME 0 means change the face on all frames, and change the default
2722 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2725 Lisp_Object old_value
= Qnil
;
2726 /* Set one of enum font_property_index (> 0) if ATTR is one of
2727 font-related attributes other than QCfont and QCfontset. */
2728 enum font_property_index prop_index
= 0;
2730 CHECK_SYMBOL (face
);
2731 CHECK_SYMBOL (attr
);
2733 face
= resolve_face_name (face
, 1);
2735 /* If FRAME is 0, change face on all frames, and change the
2736 default for new frames. */
2737 if (INTEGERP (frame
) && XINT (frame
) == 0)
2740 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2741 FOR_EACH_FRAME (tail
, frame
)
2742 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2746 /* Set lface to the Lisp attribute vector of FACE. */
2749 lface
= lface_from_face_name (NULL
, face
, 1);
2751 /* When updating face-new-frame-defaults, we put :ignore-defface
2752 where the caller wants `unspecified'. This forces the frame
2753 defaults to ignore the defface value. Otherwise, the defface
2754 will take effect, which is generally not what is intended.
2755 The value of that attribute will be inherited from some other
2756 face during face merging. See internal_merge_in_global_face. */
2757 if (UNSPECIFIEDP (value
))
2758 value
= QCignore_defface
;
2763 frame
= selected_frame
;
2765 CHECK_LIVE_FRAME (frame
);
2766 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2768 /* If a frame-local face doesn't exist yet, create one. */
2770 lface
= Finternal_make_lisp_face (face
, frame
);
2773 if (EQ (attr
, QCfamily
))
2775 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2777 CHECK_STRING (value
);
2778 if (SCHARS (value
) == 0)
2779 signal_error ("Invalid face family", value
);
2781 old_value
= LFACE_FAMILY (lface
);
2782 ASET (lface
, LFACE_FAMILY_INDEX
, value
);
2783 prop_index
= FONT_FAMILY_INDEX
;
2785 else if (EQ (attr
, QCfoundry
))
2787 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2789 CHECK_STRING (value
);
2790 if (SCHARS (value
) == 0)
2791 signal_error ("Invalid face foundry", value
);
2793 old_value
= LFACE_FOUNDRY (lface
);
2794 ASET (lface
, LFACE_FOUNDRY_INDEX
, value
);
2795 prop_index
= FONT_FOUNDRY_INDEX
;
2797 else if (EQ (attr
, QCheight
))
2799 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2801 if (EQ (face
, Qdefault
))
2803 /* The default face must have an absolute size. */
2804 if (!INTEGERP (value
) || XINT (value
) <= 0)
2805 signal_error ("Default face height not absolute and positive",
2810 /* For non-default faces, do a test merge with a random
2811 height to see if VALUE's ok. */
2812 Lisp_Object test
= merge_face_heights (value
,
2815 if (!INTEGERP (test
) || XINT (test
) <= 0)
2816 signal_error ("Face height does not produce a positive integer",
2821 old_value
= LFACE_HEIGHT (lface
);
2822 ASET (lface
, LFACE_HEIGHT_INDEX
, value
);
2823 prop_index
= FONT_SIZE_INDEX
;
2825 else if (EQ (attr
, QCweight
))
2827 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2829 CHECK_SYMBOL (value
);
2830 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2831 signal_error ("Invalid face weight", value
);
2833 old_value
= LFACE_WEIGHT (lface
);
2834 ASET (lface
, LFACE_WEIGHT_INDEX
, value
);
2835 prop_index
= FONT_WEIGHT_INDEX
;
2837 else if (EQ (attr
, QCslant
))
2839 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2841 CHECK_SYMBOL (value
);
2842 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2843 signal_error ("Invalid face slant", value
);
2845 old_value
= LFACE_SLANT (lface
);
2846 ASET (lface
, LFACE_SLANT_INDEX
, value
);
2847 prop_index
= FONT_SLANT_INDEX
;
2849 else if (EQ (attr
, QCunderline
))
2853 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2855 else if (NILP (value
) || EQ (value
, Qt
))
2857 else if (STRINGP (value
) && SCHARS (value
) > 0)
2859 else if (CONSP (value
))
2861 Lisp_Object key
, val
, list
;
2864 /* FIXME? This errs on the side of acceptance. Eg it accepts:
2865 (defface foo '((t :underline 'foo) "doc")
2866 Maybe this is intentional, maybe it isn't.
2867 Non-nil symbols other than t are not documented as being valid.
2868 Eg compare with inverse-video, which explicitly rejects them.
2872 while (!NILP (CAR_SAFE(list
)))
2874 key
= CAR_SAFE (list
);
2875 list
= CDR_SAFE (list
);
2876 val
= CAR_SAFE (list
);
2877 list
= CDR_SAFE (list
);
2879 if (NILP (key
) || NILP (val
))
2885 else if (EQ (key
, QCcolor
)
2886 && !(EQ (val
, Qforeground_color
)
2887 || (STRINGP (val
) && SCHARS (val
) > 0)))
2893 else if (EQ (key
, QCstyle
)
2894 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2903 signal_error ("Invalid face underline", value
);
2905 old_value
= LFACE_UNDERLINE (lface
);
2906 ASET (lface
, LFACE_UNDERLINE_INDEX
, value
);
2908 else if (EQ (attr
, QCoverline
))
2910 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2911 if ((SYMBOLP (value
)
2913 && !EQ (value
, Qnil
))
2914 /* Overline color. */
2916 && SCHARS (value
) == 0))
2917 signal_error ("Invalid face overline", value
);
2919 old_value
= LFACE_OVERLINE (lface
);
2920 ASET (lface
, LFACE_OVERLINE_INDEX
, value
);
2922 else if (EQ (attr
, QCstrike_through
))
2924 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2925 if ((SYMBOLP (value
)
2927 && !EQ (value
, Qnil
))
2928 /* Strike-through color. */
2930 && SCHARS (value
) == 0))
2931 signal_error ("Invalid face strike-through", value
);
2933 old_value
= LFACE_STRIKE_THROUGH (lface
);
2934 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, value
);
2936 else if (EQ (attr
, QCbox
))
2940 /* Allow t meaning a simple box of width 1 in foreground color
2943 value
= make_number (1);
2945 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2947 else if (NILP (value
))
2949 else if (INTEGERP (value
))
2950 valid_p
= XINT (value
) != 0;
2951 else if (STRINGP (value
))
2952 valid_p
= SCHARS (value
) > 0;
2953 else if (CONSP (value
))
2969 if (EQ (k
, QCline_width
))
2971 if (!INTEGERP (v
) || XINT (v
) == 0)
2974 else if (EQ (k
, QCcolor
))
2976 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
2979 else if (EQ (k
, QCstyle
))
2981 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
2988 valid_p
= NILP (tem
);
2994 signal_error ("Invalid face box", value
);
2996 old_value
= LFACE_BOX (lface
);
2997 ASET (lface
, LFACE_BOX_INDEX
, value
);
2999 else if (EQ (attr
, QCinverse_video
)
3000 || EQ (attr
, QCreverse_video
))
3002 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3004 CHECK_SYMBOL (value
);
3005 if (!EQ (value
, Qt
) && !NILP (value
))
3006 signal_error ("Invalid inverse-video face attribute value", value
);
3008 old_value
= LFACE_INVERSE (lface
);
3009 ASET (lface
, LFACE_INVERSE_INDEX
, value
);
3011 else if (EQ (attr
, QCforeground
))
3013 /* Compatibility with 20.x. */
3015 value
= Qunspecified
;
3016 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3018 /* Don't check for valid color names here because it depends
3019 on the frame (display) whether the color will be valid
3020 when the face is realized. */
3021 CHECK_STRING (value
);
3022 if (SCHARS (value
) == 0)
3023 signal_error ("Empty foreground color value", value
);
3025 old_value
= LFACE_FOREGROUND (lface
);
3026 ASET (lface
, LFACE_FOREGROUND_INDEX
, value
);
3028 else if (EQ (attr
, QCdistant_foreground
))
3030 /* Compatibility with 20.x. */
3032 value
= Qunspecified
;
3033 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3035 /* Don't check for valid color names here because it depends
3036 on the frame (display) whether the color will be valid
3037 when the face is realized. */
3038 CHECK_STRING (value
);
3039 if (SCHARS (value
) == 0)
3040 signal_error ("Empty distant-foreground color value", value
);
3042 old_value
= LFACE_DISTANT_FOREGROUND (lface
);
3043 ASET (lface
, LFACE_DISTANT_FOREGROUND_INDEX
, value
);
3045 else if (EQ (attr
, QCbackground
))
3047 /* Compatibility with 20.x. */
3049 value
= Qunspecified
;
3050 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3052 /* Don't check for valid color names here because it depends
3053 on the frame (display) whether the color will be valid
3054 when the face is realized. */
3055 CHECK_STRING (value
);
3056 if (SCHARS (value
) == 0)
3057 signal_error ("Empty background color value", value
);
3059 old_value
= LFACE_BACKGROUND (lface
);
3060 ASET (lface
, LFACE_BACKGROUND_INDEX
, value
);
3062 else if (EQ (attr
, QCstipple
))
3064 #if defined (HAVE_WINDOW_SYSTEM)
3065 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3067 && NILP (Fbitmap_spec_p (value
)))
3068 signal_error ("Invalid stipple attribute", value
);
3069 old_value
= LFACE_STIPPLE (lface
);
3070 ASET (lface
, LFACE_STIPPLE_INDEX
, value
);
3071 #endif /* HAVE_WINDOW_SYSTEM */
3073 else if (EQ (attr
, QCwidth
))
3075 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3077 CHECK_SYMBOL (value
);
3078 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3079 signal_error ("Invalid face width", value
);
3081 old_value
= LFACE_SWIDTH (lface
);
3082 ASET (lface
, LFACE_SWIDTH_INDEX
, value
);
3083 prop_index
= FONT_WIDTH_INDEX
;
3085 else if (EQ (attr
, QCfont
))
3087 #ifdef HAVE_WINDOW_SYSTEM
3088 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3090 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3094 old_value
= LFACE_FONT (lface
);
3095 if (! FONTP (value
))
3097 if (STRINGP (value
))
3099 Lisp_Object name
= value
;
3100 int fontset
= fs_query_fontset (name
, 0);
3103 name
= fontset_ascii (fontset
);
3104 value
= font_spec_from_name (name
);
3106 signal_error ("Invalid font name", name
);
3109 signal_error ("Invalid font or font-spec", value
);
3112 f
= XFRAME (selected_frame
);
3115 if (! FONT_OBJECT_P (value
))
3117 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3118 Lisp_Object font_object
;
3120 font_object
= font_load_for_lface (f
, attrs
, value
);
3121 if (NILP (font_object
))
3122 signal_error ("Font not available", value
);
3123 value
= font_object
;
3125 set_lface_from_font (f
, lface
, value
, 1);
3128 ASET (lface
, LFACE_FONT_INDEX
, value
);
3130 #endif /* HAVE_WINDOW_SYSTEM */
3132 else if (EQ (attr
, QCfontset
))
3134 #ifdef HAVE_WINDOW_SYSTEM
3135 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3139 old_value
= LFACE_FONTSET (lface
);
3140 tmp
= Fquery_fontset (value
, Qnil
);
3142 signal_error ("Invalid fontset name", value
);
3143 ASET (lface
, LFACE_FONTSET_INDEX
, value
= tmp
);
3145 #endif /* HAVE_WINDOW_SYSTEM */
3147 else if (EQ (attr
, QCinherit
))
3150 if (SYMBOLP (value
))
3153 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3154 if (!SYMBOLP (XCAR (tail
)))
3157 ASET (lface
, LFACE_INHERIT_INDEX
, value
);
3159 signal_error ("Invalid face inheritance", value
);
3161 else if (EQ (attr
, QCbold
))
3163 old_value
= LFACE_WEIGHT (lface
);
3164 ASET (lface
, LFACE_WEIGHT_INDEX
, NILP (value
) ? Qnormal
: Qbold
);
3165 prop_index
= FONT_WEIGHT_INDEX
;
3167 else if (EQ (attr
, QCitalic
))
3170 old_value
= LFACE_SLANT (lface
);
3171 ASET (lface
, LFACE_SLANT_INDEX
, NILP (value
) ? Qnormal
: Qitalic
);
3172 prop_index
= FONT_SLANT_INDEX
;
3175 signal_error ("Invalid face attribute name", attr
);
3179 /* If a font-related attribute other than QCfont and QCfontset
3180 is specified, and if the original QCfont attribute has a font
3181 (font-spec or font-object), set the corresponding property in
3182 the font to nil so that the font selector doesn't think that
3183 the attribute is mandatory. Also, clear the average
3185 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3188 /* Changing a named face means that all realized faces depending on
3189 that face are invalid. Since we cannot tell which realized faces
3190 depend on the face, make sure they are all removed. This is done
3191 by incrementing face_change_count. The next call to
3192 init_iterator will then free realized faces. */
3194 && NILP (Fget (face
, Qface_no_inherit
))
3195 && NILP (Fequal (old_value
, value
)))
3197 ++face_change_count
;
3198 windows_or_buffers_changed
= 56;
3201 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3202 && NILP (Fequal (old_value
, value
)))
3208 if (EQ (face
, Qdefault
))
3210 #ifdef HAVE_WINDOW_SYSTEM
3211 /* Changed font-related attributes of the `default' face are
3212 reflected in changed `font' frame parameters. */
3214 && (prop_index
|| EQ (attr
, QCfont
))
3215 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3216 set_font_frame_param (frame
, lface
);
3218 #endif /* HAVE_WINDOW_SYSTEM */
3220 if (EQ (attr
, QCforeground
))
3221 param
= Qforeground_color
;
3222 else if (EQ (attr
, QCbackground
))
3223 param
= Qbackground_color
;
3225 #ifdef HAVE_WINDOW_SYSTEM
3227 else if (EQ (face
, Qscroll_bar
))
3229 /* Changing the colors of `scroll-bar' sets frame parameters
3230 `scroll-bar-foreground' and `scroll-bar-background'. */
3231 if (EQ (attr
, QCforeground
))
3232 param
= Qscroll_bar_foreground
;
3233 else if (EQ (attr
, QCbackground
))
3234 param
= Qscroll_bar_background
;
3236 #endif /* not HAVE_NTGUI */
3237 else if (EQ (face
, Qborder
))
3239 /* Changing background color of `border' sets frame parameter
3241 if (EQ (attr
, QCbackground
))
3242 param
= Qborder_color
;
3244 else if (EQ (face
, Qcursor
))
3246 /* Changing background color of `cursor' sets frame parameter
3248 if (EQ (attr
, QCbackground
))
3249 param
= Qcursor_color
;
3251 else if (EQ (face
, Qmouse
))
3253 /* Changing background color of `mouse' sets frame parameter
3255 if (EQ (attr
, QCbackground
))
3256 param
= Qmouse_color
;
3258 #endif /* HAVE_WINDOW_SYSTEM */
3259 else if (EQ (face
, Qmenu
))
3261 /* Indicate that we have to update the menu bar when realizing
3262 faces on FRAME. FRAME t change the default for new frames.
3263 We do this by setting the flag in new face caches. */
3266 struct frame
*f
= XFRAME (frame
);
3267 if (FRAME_FACE_CACHE (f
) == NULL
)
3268 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3269 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3272 menu_face_changed_default
= 1;
3278 /* Update `default-frame-alist', which is used for new frames. */
3280 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3283 /* Update the current frame's parameters. */
3286 cons
= XCAR (Vparam_value_alist
);
3287 XSETCAR (cons
, param
);
3288 XSETCDR (cons
, value
);
3289 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3298 /* Update the corresponding face when frame parameter PARAM on frame F
3299 has been assigned the value NEW_VALUE. */
3302 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3303 Lisp_Object new_value
)
3305 Lisp_Object face
= Qnil
;
3308 /* If there are no faces yet, give up. This is the case when called
3309 from Fx_create_frame, and we do the necessary things later in
3310 face-set-after-frame-defaults. */
3311 if (NILP (f
->face_alist
))
3314 if (EQ (param
, Qforeground_color
))
3317 lface
= lface_from_face_name (f
, face
, 1);
3318 ASET (lface
, LFACE_FOREGROUND_INDEX
,
3319 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3320 realize_basic_faces (f
);
3322 else if (EQ (param
, Qbackground_color
))
3326 /* Changing the background color might change the background
3327 mode, so that we have to load new defface specs.
3328 Call frame-set-background-mode to do that. */
3329 XSETFRAME (frame
, f
);
3330 call1 (Qframe_set_background_mode
, frame
);
3333 lface
= lface_from_face_name (f
, face
, 1);
3334 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3335 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3336 realize_basic_faces (f
);
3338 #ifdef HAVE_WINDOW_SYSTEM
3339 else if (EQ (param
, Qborder_color
))
3342 lface
= lface_from_face_name (f
, face
, 1);
3343 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3344 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3346 else if (EQ (param
, Qcursor_color
))
3349 lface
= lface_from_face_name (f
, face
, 1);
3350 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3351 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3353 else if (EQ (param
, Qmouse_color
))
3356 lface
= lface_from_face_name (f
, face
, 1);
3357 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3358 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3362 /* Changing a named face means that all realized faces depending on
3363 that face are invalid. Since we cannot tell which realized faces
3364 depend on the face, make sure they are all removed. This is done
3365 by incrementing face_change_count. The next call to
3366 init_iterator will then free realized faces. */
3368 && NILP (Fget (face
, Qface_no_inherit
)))
3370 ++face_change_count
;
3371 windows_or_buffers_changed
= 57;
3376 #ifdef HAVE_WINDOW_SYSTEM
3378 /* Set the `font' frame parameter of FRAME determined from the
3379 font-object set in `default' face attributes LFACE. */
3382 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3384 struct frame
*f
= XFRAME (frame
);
3387 if (FRAME_WINDOW_P (f
)
3388 /* Don't do anything if the font is `unspecified'. This can
3389 happen during frame creation. */
3390 && (font
= LFACE_FONT (lface
),
3391 ! UNSPECIFIEDP (font
)))
3393 if (FONT_SPEC_P (font
))
3395 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3398 ASET (lface
, LFACE_FONT_INDEX
, font
);
3400 f
->default_face_done_p
= 0;
3401 Fmodify_frame_parameters (frame
, FRAME_PARAMETER (Qfont
, font
));
3405 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3406 Sinternal_face_x_get_resource
, 2, 3, 0,
3407 doc
: /* Get the value of X resource RESOURCE, class CLASS.
3408 Returned value is for the display of frame FRAME. If FRAME is not
3409 specified or nil, use selected frame. This function exists because
3410 ordinary `x-get-resource' doesn't take a frame argument. */)
3411 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3413 Lisp_Object value
= Qnil
;
3416 CHECK_STRING (resource
);
3417 CHECK_STRING (class);
3418 f
= decode_live_frame (frame
);
3420 value
= display_x_get_resource (FRAME_DISPLAY_INFO (f
),
3421 resource
, class, Qnil
, Qnil
);
3427 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3428 If VALUE is "on" or "true", return t. If VALUE is "off" or
3429 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3430 error; if SIGNAL_P is zero, return 0. */
3433 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3435 Lisp_Object result
= make_number (0);
3437 eassert (STRINGP (value
));
3439 if (xstrcasecmp (SSDATA (value
), "on") == 0
3440 || xstrcasecmp (SSDATA (value
), "true") == 0)
3442 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3443 || xstrcasecmp (SSDATA (value
), "false") == 0)
3445 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3446 result
= Qunspecified
;
3448 signal_error ("Invalid face attribute value from X resource", value
);
3454 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3455 Finternal_set_lisp_face_attribute_from_resource
,
3456 Sinternal_set_lisp_face_attribute_from_resource
,
3457 3, 4, 0, doc
: /* */)
3458 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3460 CHECK_SYMBOL (face
);
3461 CHECK_SYMBOL (attr
);
3462 CHECK_STRING (value
);
3464 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3465 value
= Qunspecified
;
3466 else if (EQ (attr
, QCheight
))
3468 value
= Fstring_to_number (value
, make_number (10));
3469 if (XINT (value
) <= 0)
3470 signal_error ("Invalid face height from X resource", value
);
3472 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3473 value
= face_boolean_x_resource_value (value
, 1);
3474 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3475 value
= intern (SSDATA (value
));
3476 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3477 value
= face_boolean_x_resource_value (value
, 1);
3478 else if (EQ (attr
, QCunderline
)
3479 || EQ (attr
, QCoverline
)
3480 || EQ (attr
, QCstrike_through
))
3482 Lisp_Object boolean_value
;
3484 /* If the result of face_boolean_x_resource_value is t or nil,
3485 VALUE does NOT specify a color. */
3486 boolean_value
= face_boolean_x_resource_value (value
, 0);
3487 if (SYMBOLP (boolean_value
))
3488 value
= boolean_value
;
3490 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3491 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3493 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3496 #endif /* HAVE_WINDOW_SYSTEM */
3499 /***********************************************************************
3501 ***********************************************************************/
3503 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3505 /* Make menus on frame F appear as specified by the `menu' face. */
3508 x_update_menu_appearance (struct frame
*f
)
3510 struct x_display_info
*dpyinfo
= FRAME_DISPLAY_INFO (f
);
3514 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3519 ptrdiff_t bufsize
= sizeof line
;
3520 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3521 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3522 const char *myname
= SSDATA (Vx_resource_name
);
3525 const char *popup_path
= "popup_menu";
3527 const char *popup_path
= "menu.popup";
3530 if (STRINGP (LFACE_FOREGROUND (lface
)))
3532 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3534 SDATA (LFACE_FOREGROUND (lface
)));
3535 XrmPutLineResource (&rdb
, line
);
3536 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3537 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3538 XrmPutLineResource (&rdb
, line
);
3542 if (STRINGP (LFACE_BACKGROUND (lface
)))
3544 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3546 SDATA (LFACE_BACKGROUND (lface
)));
3547 XrmPutLineResource (&rdb
, line
);
3549 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3550 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3551 XrmPutLineResource (&rdb
, line
);
3556 /* On Solaris 5.8, it's been reported that the `menu' face
3557 can be unspecified here, during startup. Why this
3558 happens remains unknown. -- cyd */
3559 && FONTP (LFACE_FONT (lface
))
3560 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3561 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3562 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3563 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3564 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3565 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3567 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3569 const char *suffix
= "List";
3572 #if defined HAVE_X_I18N
3574 const char *suffix
= "Set";
3576 const char *suffix
= "";
3583 #if defined HAVE_X_I18N
3584 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3586 char *fontsetname
= SSDATA (xlfd
);
3588 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3589 myname
, suffix
, fontsetname
);
3590 XrmPutLineResource (&rdb
, line
);
3592 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3593 myname
, popup_path
, suffix
, fontsetname
);
3594 XrmPutLineResource (&rdb
, line
);
3596 if (fontsetname
!= SSDATA (xlfd
))
3597 xfree (fontsetname
);
3601 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3602 free_frame_menubar (f
);
3609 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3612 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3613 Sface_attribute_relative_p
,
3615 doc
: /* Check whether a face attribute value is relative.
3616 Specifically, this function returns t if the attribute ATTRIBUTE
3617 with the value VALUE is relative.
3619 A relative value is one that doesn't entirely override whatever is
3620 inherited from another face. For most possible attributes,
3621 the only relative value that users see is `unspecified'.
3622 However, for :height, floating point values are also relative. */)
3623 (Lisp_Object attribute
, Lisp_Object value
)
3625 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3627 else if (EQ (attribute
, QCheight
))
3628 return INTEGERP (value
) ? Qnil
: Qt
;
3633 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3635 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3636 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3637 the result will be absolute, otherwise it will be relative. */)
3638 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3640 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3642 else if (EQ (attribute
, QCheight
))
3643 return merge_face_heights (value1
, value2
, value1
);
3649 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3650 Sinternal_get_lisp_face_attribute
,
3652 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3653 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3654 face attribute name, signal an error.
3655 If the optional argument FRAME is given, report on face SYMBOL in that
3656 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3657 frames). If FRAME is omitted or nil, use the selected frame. */)
3658 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3660 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3661 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 1), value
= Qnil
;
3663 CHECK_SYMBOL (symbol
);
3664 CHECK_SYMBOL (keyword
);
3666 if (EQ (keyword
, QCfamily
))
3667 value
= LFACE_FAMILY (lface
);
3668 else if (EQ (keyword
, QCfoundry
))
3669 value
= LFACE_FOUNDRY (lface
);
3670 else if (EQ (keyword
, QCheight
))
3671 value
= LFACE_HEIGHT (lface
);
3672 else if (EQ (keyword
, QCweight
))
3673 value
= LFACE_WEIGHT (lface
);
3674 else if (EQ (keyword
, QCslant
))
3675 value
= LFACE_SLANT (lface
);
3676 else if (EQ (keyword
, QCunderline
))
3677 value
= LFACE_UNDERLINE (lface
);
3678 else if (EQ (keyword
, QCoverline
))
3679 value
= LFACE_OVERLINE (lface
);
3680 else if (EQ (keyword
, QCstrike_through
))
3681 value
= LFACE_STRIKE_THROUGH (lface
);
3682 else if (EQ (keyword
, QCbox
))
3683 value
= LFACE_BOX (lface
);
3684 else if (EQ (keyword
, QCinverse_video
)
3685 || EQ (keyword
, QCreverse_video
))
3686 value
= LFACE_INVERSE (lface
);
3687 else if (EQ (keyword
, QCforeground
))
3688 value
= LFACE_FOREGROUND (lface
);
3689 else if (EQ (keyword
, QCdistant_foreground
))
3690 value
= LFACE_DISTANT_FOREGROUND (lface
);
3691 else if (EQ (keyword
, QCbackground
))
3692 value
= LFACE_BACKGROUND (lface
);
3693 else if (EQ (keyword
, QCstipple
))
3694 value
= LFACE_STIPPLE (lface
);
3695 else if (EQ (keyword
, QCwidth
))
3696 value
= LFACE_SWIDTH (lface
);
3697 else if (EQ (keyword
, QCinherit
))
3698 value
= LFACE_INHERIT (lface
);
3699 else if (EQ (keyword
, QCfont
))
3700 value
= LFACE_FONT (lface
);
3701 else if (EQ (keyword
, QCfontset
))
3702 value
= LFACE_FONTSET (lface
);
3704 signal_error ("Invalid face attribute name", keyword
);
3706 if (IGNORE_DEFFACE_P (value
))
3707 return Qunspecified
;
3713 DEFUN ("internal-lisp-face-attribute-values",
3714 Finternal_lisp_face_attribute_values
,
3715 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3716 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3717 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3720 Lisp_Object result
= Qnil
;
3722 CHECK_SYMBOL (attr
);
3724 if (EQ (attr
, QCunderline
) || EQ (attr
, QCoverline
)
3725 || EQ (attr
, QCstrike_through
)
3726 || EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3727 result
= list2 (Qt
, Qnil
);
3733 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3734 Sinternal_merge_in_global_face
, 2, 2, 0,
3735 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3736 Default face attributes override any local face attributes. */)
3737 (Lisp_Object face
, Lisp_Object frame
)
3740 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3741 struct frame
*f
= XFRAME (frame
);
3743 CHECK_LIVE_FRAME (frame
);
3744 global_lface
= lface_from_face_name (NULL
, face
, 1);
3745 local_lface
= lface_from_face_name (f
, face
, 0);
3746 if (NILP (local_lface
))
3747 local_lface
= Finternal_make_lisp_face (face
, frame
);
3749 /* Make every specified global attribute override the local one.
3750 BEWARE!! This is only used from `face-set-after-frame-default' where
3751 the local frame is defined from default specs in `face-defface-spec'
3752 and those should be overridden by global settings. Hence the strange
3753 "global before local" priority. */
3754 lvec
= XVECTOR (local_lface
)->contents
;
3755 gvec
= XVECTOR (global_lface
)->contents
;
3756 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3757 if (IGNORE_DEFFACE_P (gvec
[i
]))
3758 ASET (local_lface
, i
, Qunspecified
);
3759 else if (! UNSPECIFIEDP (gvec
[i
]))
3760 ASET (local_lface
, i
, AREF (global_lface
, i
));
3762 /* If the default face was changed, update the face cache and the
3763 `font' frame parameter. */
3764 if (EQ (face
, Qdefault
))
3766 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3767 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3768 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3770 /* This can be NULL (e.g., in batch mode). */
3773 /* Ensure that the face vector is fully specified by merging
3774 the previously-cached vector. */
3775 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3776 merge_face_vectors (f
, lvec
, attrs
, 0);
3777 vcopy (local_lface
, 0, attrs
, LFACE_VECTOR_SIZE
);
3778 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3780 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3781 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3782 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3783 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3784 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3785 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3786 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3789 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3790 Fmodify_frame_parameters (frame
, FRAME_PARAMETER (Qfont
, name
));
3793 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3794 Fmodify_frame_parameters
3795 (frame
, FRAME_PARAMETER (Qforeground_color
,
3796 gvec
[LFACE_FOREGROUND_INDEX
]));
3798 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3799 Fmodify_frame_parameters
3800 (frame
, FRAME_PARAMETER (Qbackground_color
,
3801 gvec
[LFACE_BACKGROUND_INDEX
]));
3809 /* The following function is implemented for compatibility with 20.2.
3810 The function is used in x-resolve-fonts when it is asked to
3811 return fonts with the same size as the font of a face. This is
3812 done in fontset.el. */
3814 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3815 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3816 The font name is, by default, for ASCII characters.
3817 If the optional argument FRAME is given, report on face FACE in that frame.
3818 If FRAME is t, report on the defaults for face FACE (for new frames).
3819 The font default for a face is either nil, or a list
3820 of the form (bold), (italic) or (bold italic).
3821 If FRAME is omitted or nil, use the selected frame. And, in this case,
3822 if the optional third argument CHARACTER is given,
3823 return the font name used for CHARACTER. */)
3824 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3828 Lisp_Object result
= Qnil
;
3829 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3831 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3832 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3833 result
= Fcons (Qbold
, result
);
3835 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3836 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3837 result
= Fcons (Qitalic
, result
);
3843 struct frame
*f
= decode_live_frame (frame
);
3844 int face_id
= lookup_named_face (f
, face
, 1);
3845 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3849 #ifdef HAVE_WINDOW_SYSTEM
3850 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3852 CHECK_CHARACTER (character
);
3853 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3854 fface
= FACE_FROM_ID (f
, face_id
);
3857 ? fface
->font
->props
[FONT_NAME_INDEX
]
3859 #else /* !HAVE_WINDOW_SYSTEM */
3860 return build_string (FRAME_MSDOS_P (f
)
3862 : FRAME_W32_P (f
) ? "w32term"
3869 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3870 all attributes are `equal'. Tries to be fast because this function
3871 is called quite often. */
3874 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3876 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3877 and the other is specified. */
3878 if (XTYPE (v1
) != XTYPE (v2
))
3887 if (SBYTES (v1
) != SBYTES (v2
))
3890 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3897 return !NILP (Fequal (v1
, v2
));
3902 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3903 all attributes are `equal'. Tries to be fast because this function
3904 is called quite often. */
3907 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3912 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3913 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3919 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3920 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3921 doc
: /* True if FACE1 and FACE2 are equal.
3922 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3923 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3924 If FRAME is omitted or nil, use the selected frame. */)
3925 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3929 Lisp_Object lface1
, lface2
;
3931 /* Don't use decode_window_system_frame here because this function
3932 is called before X frames exist. At that time, if FRAME is nil,
3933 selected_frame will be used which is the frame dumped with
3934 Emacs. That frame is not an X frame. */
3935 f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3937 lface1
= lface_from_face_name (f
, face1
, 1);
3938 lface2
= lface_from_face_name (f
, face2
, 1);
3939 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3940 XVECTOR (lface2
)->contents
);
3941 return equal_p
? Qt
: Qnil
;
3945 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3946 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3947 doc
: /* True if FACE has no attribute specified.
3948 If the optional argument FRAME is given, report on face FACE in that frame.
3949 If FRAME is t, report on the defaults for face FACE (for new frames).
3950 If FRAME is omitted or nil, use the selected frame. */)
3951 (Lisp_Object face
, Lisp_Object frame
)
3953 struct frame
*f
= EQ (frame
, Qt
) ? NULL
: decode_live_frame (frame
);
3954 Lisp_Object lface
= lface_from_face_name (f
, face
, 1);
3957 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3958 if (!UNSPECIFIEDP (AREF (lface
, i
)))
3961 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
3965 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
3967 doc
: /* Return an alist of frame-local faces defined on FRAME.
3968 For internal use only. */)
3971 return decode_live_frame (frame
)->face_alist
;
3975 /* Return a hash code for Lisp string STRING with case ignored. Used
3976 below in computing a hash value for a Lisp face. */
3979 hash_string_case_insensitive (Lisp_Object string
)
3981 const unsigned char *s
;
3983 eassert (STRINGP (string
));
3984 for (s
= SDATA (string
); *s
; ++s
)
3985 hash
= (hash
<< 1) ^ c_tolower (*s
);
3990 /* Return a hash code for face attribute vector V. */
3993 lface_hash (Lisp_Object
*v
)
3995 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
3996 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
3997 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
3998 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
3999 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4000 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4001 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4002 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4005 #ifdef HAVE_WINDOW_SYSTEM
4007 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4008 considering charsets/registries). They do if they specify the same
4009 family, point size, weight, width, slant, and font. Both
4010 LFACE1 and LFACE2 must be fully-specified. */
4013 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4015 eassert (lface_fully_specified_p (lface1
)
4016 && lface_fully_specified_p (lface2
));
4017 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4018 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4019 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4020 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4021 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4022 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4023 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4024 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4025 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4026 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4027 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4028 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4029 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4030 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4034 #endif /* HAVE_WINDOW_SYSTEM */
4036 /***********************************************************************
4038 ***********************************************************************/
4040 /* Allocate and return a new realized face for Lisp face attribute
4043 static struct face
*
4044 make_realized_face (Lisp_Object
*attr
)
4046 enum { off
= offsetof (struct face
, id
) };
4047 struct face
*face
= xmalloc (sizeof *face
);
4049 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4050 memset (&face
->id
, 0, sizeof *face
- off
);
4051 face
->ascii_face
= face
;
4057 /* Free realized face FACE, including its X resources. FACE may
4061 free_realized_face (struct frame
*f
, struct face
*face
)
4065 #ifdef HAVE_WINDOW_SYSTEM
4066 if (FRAME_WINDOW_P (f
))
4068 /* Free fontset of FACE if it is ASCII face. */
4069 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4070 free_face_fontset (f
, face
);
4075 font_done_for_face (f
, face
);
4076 x_free_gc (f
, face
->gc
);
4080 #ifdef HAVE_X_WINDOWS
4081 free_face_colors (f
, face
);
4082 #endif /* HAVE_X_WINDOWS */
4083 x_destroy_bitmap (f
, face
->stipple
);
4085 #endif /* HAVE_WINDOW_SYSTEM */
4091 #ifdef HAVE_WINDOW_SYSTEM
4093 /* Prepare face FACE for subsequent display on frame F. This must be called
4094 before using X resources of FACE to allocate GCs if they haven't been
4095 allocated yet or have been freed by clearing the face cache. */
4098 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4100 eassert (FRAME_WINDOW_P (f
));
4105 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4107 xgcv
.foreground
= face
->foreground
;
4108 xgcv
.background
= face
->background
;
4109 #ifdef HAVE_X_WINDOWS
4110 xgcv
.graphics_exposures
= False
;
4114 #ifdef HAVE_X_WINDOWS
4117 xgcv
.fill_style
= FillOpaqueStippled
;
4118 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4119 mask
|= GCFillStyle
| GCStipple
;
4122 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4124 font_prepare_for_face (f
, face
);
4129 #endif /* HAVE_WINDOW_SYSTEM */
4131 /* Returns the `distance' between the colors X and Y. */
4134 color_distance (XColor
*x
, XColor
*y
)
4136 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4137 Quoting from that paper:
4139 This formula has results that are very close to L*u*v* (with the
4140 modified lightness curve) and, more importantly, it is a more even
4141 algorithm: it does not have a range of colors where it suddenly
4142 gives far from optimal results.
4144 See <http://www.compuphase.com/cmetric.htm> for more info. */
4146 long r
= (x
->red
- y
->red
) >> 8;
4147 long g
= (x
->green
- y
->green
) >> 8;
4148 long b
= (x
->blue
- y
->blue
) >> 8;
4149 long r_mean
= (x
->red
+ y
->red
) >> 9;
4152 (((512 + r_mean
) * r
* r
) >> 8)
4154 + (((767 - r_mean
) * b
* b
) >> 8);
4158 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4159 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4160 COLOR1 and COLOR2 may be either strings containing the color name,
4161 or lists of the form (RED GREEN BLUE).
4162 If FRAME is unspecified or nil, the current frame is used. */)
4163 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4165 struct frame
*f
= decode_live_frame (frame
);
4166 XColor cdef1
, cdef2
;
4168 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4169 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4170 signal_error ("Invalid color", color1
);
4171 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4172 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4173 signal_error ("Invalid color", color2
);
4175 return make_number (color_distance (&cdef1
, &cdef2
));
4179 /***********************************************************************
4181 ***********************************************************************/
4183 /* Return a new face cache for frame F. */
4185 static struct face_cache
*
4186 make_face_cache (struct frame
*f
)
4188 struct face_cache
*c
= xmalloc (sizeof *c
);
4190 c
->buckets
= xzalloc (FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
);
4193 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4195 c
->menu_face_changed_p
= menu_face_changed_default
;
4199 #ifdef HAVE_WINDOW_SYSTEM
4201 /* Clear out all graphics contexts for all realized faces, except for
4202 the basic faces. This should be done from time to time just to avoid
4203 keeping too many graphics contexts that are no longer needed. */
4206 clear_face_gcs (struct face_cache
*c
)
4208 if (c
&& FRAME_WINDOW_P (c
->f
))
4211 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4213 struct face
*face
= c
->faces_by_id
[i
];
4214 if (face
&& face
->gc
)
4218 font_done_for_face (c
->f
, face
);
4219 x_free_gc (c
->f
, face
->gc
);
4227 #endif /* HAVE_WINDOW_SYSTEM */
4229 /* Free all realized faces in face cache C, including basic faces.
4230 C may be null. If faces are freed, make sure the frame's current
4231 matrix is marked invalid, so that a display caused by an expose
4232 event doesn't try to use faces we destroyed. */
4235 free_realized_faces (struct face_cache
*c
)
4240 struct frame
*f
= c
->f
;
4242 /* We must block input here because we can't process X events
4243 safely while only some faces are freed, or when the frame's
4244 current matrix still references freed faces. */
4247 for (i
= 0; i
< c
->used
; ++i
)
4249 free_realized_face (f
, c
->faces_by_id
[i
]);
4250 c
->faces_by_id
[i
] = NULL
;
4254 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4255 memset (c
->buckets
, 0, size
);
4257 /* Must do a thorough redisplay the next time. Mark current
4258 matrices as invalid because they will reference faces freed
4259 above. This function is also called when a frame is
4260 destroyed. In this case, the root window of F is nil. */
4261 if (WINDOWP (f
->root_window
))
4263 clear_current_matrices (f
);
4264 windows_or_buffers_changed
= 58;
4272 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4273 This is done after attributes of a named face have been changed,
4274 because we can't tell which realized faces depend on that face. */
4277 free_all_realized_faces (Lisp_Object frame
)
4282 FOR_EACH_FRAME (rest
, frame
)
4283 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4286 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4290 /* Free face cache C and faces in it, including their X resources. */
4293 free_face_cache (struct face_cache
*c
)
4297 free_realized_faces (c
);
4299 xfree (c
->faces_by_id
);
4305 /* Cache realized face FACE in face cache C. HASH is the hash value
4306 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4307 FACE), insert the new face to the beginning of the collision list
4308 of the face hash table of C. Otherwise, add the new face to the
4309 end of the collision list. This way, lookup_face can quickly find
4310 that a requested face is not cached. */
4313 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4315 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4319 if (face
->ascii_face
!= face
)
4321 struct face
*last
= c
->buckets
[i
];
4332 c
->buckets
[i
] = face
;
4333 face
->prev
= face
->next
= NULL
;
4339 face
->next
= c
->buckets
[i
];
4341 face
->next
->prev
= face
;
4342 c
->buckets
[i
] = face
;
4345 /* Find a free slot in C->faces_by_id and use the index of the free
4346 slot as FACE->id. */
4347 for (i
= 0; i
< c
->used
; ++i
)
4348 if (c
->faces_by_id
[i
] == NULL
)
4353 /* Check that FACE got a unique id. */
4358 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4359 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4365 #endif /* GLYPH_DEBUG */
4367 /* Maybe enlarge C->faces_by_id. */
4370 if (c
->used
== c
->size
)
4371 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4372 sizeof *c
->faces_by_id
);
4376 c
->faces_by_id
[i
] = face
;
4380 /* Remove face FACE from cache C. */
4383 uncache_face (struct face_cache
*c
, struct face
*face
)
4385 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4388 face
->prev
->next
= face
->next
;
4390 c
->buckets
[i
] = face
->next
;
4393 face
->next
->prev
= face
->prev
;
4395 c
->faces_by_id
[face
->id
] = NULL
;
4396 if (face
->id
== c
->used
)
4401 /* Look up a realized face with face attributes ATTR in the face cache
4402 of frame F. The face will be used to display ASCII characters.
4403 Value is the ID of the face found. If no suitable face is found,
4404 realize a new one. */
4407 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4409 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4414 eassert (cache
!= NULL
);
4415 check_lface_attrs (attr
);
4417 /* Look up ATTR in the face cache. */
4418 hash
= lface_hash (attr
);
4419 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4421 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4423 if (face
->ascii_face
!= face
)
4425 /* There's no more ASCII face. */
4429 if (face
->hash
== hash
4430 && lface_equal_p (face
->lface
, attr
))
4434 /* If not found, realize a new face. */
4436 face
= realize_face (cache
, attr
, -1);
4439 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4440 #endif /* GLYPH_DEBUG */
4445 #ifdef HAVE_WINDOW_SYSTEM
4446 /* Look up a realized face that has the same attributes as BASE_FACE
4447 except for the font in the face cache of frame F. If FONT-OBJECT
4448 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4449 the face has no font. Value is the ID of the face found. If no
4450 suitable face is found, realize a new one. */
4453 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4455 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4460 eassert (cache
!= NULL
);
4461 base_face
= base_face
->ascii_face
;
4462 hash
= lface_hash (base_face
->lface
);
4463 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4465 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4467 if (face
->ascii_face
== face
)
4469 if (face
->ascii_face
== base_face
4470 && face
->font
== (NILP (font_object
) ? NULL
4471 : XFONT_OBJECT (font_object
))
4472 && lface_equal_p (face
->lface
, base_face
->lface
))
4476 /* If not found, realize a new face. */
4477 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4480 #endif /* HAVE_WINDOW_SYSTEM */
4482 /* Return the face id of the realized face for named face SYMBOL on
4483 frame F suitable for displaying ASCII characters. Value is -1 if
4484 the face couldn't be determined, which might happen if the default
4485 face isn't realized and cannot be realized. */
4488 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4490 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4491 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4492 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4494 if (default_face
== NULL
)
4496 if (!realize_basic_faces (f
))
4498 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4499 if (default_face
== NULL
)
4500 emacs_abort (); /* realize_basic_faces must have set it up */
4503 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4506 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4507 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4509 return lookup_face (f
, attrs
);
4513 /* Return the display face-id of the basic face whose canonical face-id
4514 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4515 basic face has bee remapped via Vface_remapping_alist. This function is
4516 conservative: if something goes wrong, it will simply return FACE_ID
4517 rather than signal an error. */
4520 lookup_basic_face (struct frame
*f
, int face_id
)
4522 Lisp_Object name
, mapping
;
4523 int remapped_face_id
;
4525 if (NILP (Vface_remapping_alist
))
4526 return face_id
; /* Nothing to do. */
4530 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4531 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4532 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4533 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4534 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4535 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4536 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4537 case BORDER_FACE_ID
: name
= Qborder
; break;
4538 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4539 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4540 case MENU_FACE_ID
: name
= Qmenu
; break;
4543 emacs_abort (); /* the caller is supposed to pass us a basic face id */
4546 /* Do a quick scan through Vface_remapping_alist, and return immediately
4547 if there is no remapping for face NAME. This is just an optimization
4548 for the very common no-remapping case. */
4549 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4551 return face_id
; /* Give up. */
4553 /* If there is a remapping entry, lookup the face using NAME, which will
4554 handle the remapping too. */
4555 remapped_face_id
= lookup_named_face (f
, name
, 0);
4556 if (remapped_face_id
< 0)
4557 return face_id
; /* Give up. */
4559 return remapped_face_id
;
4563 /* Return a face for charset ASCII that is like the face with id
4564 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4565 STEPS < 0 means larger. Value is the id of the face. */
4568 smaller_face (struct frame
*f
, int face_id
, int steps
)
4570 #ifdef HAVE_WINDOW_SYSTEM
4572 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4573 int pt
, last_pt
, last_height
;
4576 struct face
*new_face
;
4578 /* If not called for an X frame, just return the original face. */
4579 if (FRAME_TERMCAP_P (f
))
4582 /* Try in increments of 1/2 pt. */
4583 delta
= steps
< 0 ? 5 : -5;
4584 steps
= eabs (steps
);
4586 face
= FACE_FROM_ID (f
, face_id
);
4587 memcpy (attrs
, face
->lface
, sizeof attrs
);
4588 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4589 new_face_id
= face_id
;
4590 last_height
= FONT_HEIGHT (face
->font
);
4594 /* Give up if we cannot find a font within 10pt. */
4595 && eabs (last_pt
- pt
) < 100)
4597 /* Look up a face for a slightly smaller/larger font. */
4599 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4600 new_face_id
= lookup_face (f
, attrs
);
4601 new_face
= FACE_FROM_ID (f
, new_face_id
);
4603 /* If height changes, count that as one step. */
4604 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4605 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4608 last_height
= FONT_HEIGHT (new_face
->font
);
4615 #else /* not HAVE_WINDOW_SYSTEM */
4619 #endif /* not HAVE_WINDOW_SYSTEM */
4623 /* Return a face for charset ASCII that is like the face with id
4624 FACE_ID on frame F, but has height HEIGHT. */
4627 face_with_height (struct frame
*f
, int face_id
, int height
)
4629 #ifdef HAVE_WINDOW_SYSTEM
4631 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4633 if (FRAME_TERMCAP_P (f
)
4637 face
= FACE_FROM_ID (f
, face_id
);
4638 memcpy (attrs
, face
->lface
, sizeof attrs
);
4639 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4640 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4641 face_id
= lookup_face (f
, attrs
);
4642 #endif /* HAVE_WINDOW_SYSTEM */
4648 /* Return the face id of the realized face for named face SYMBOL on
4649 frame F suitable for displaying ASCII characters, and use
4650 attributes of the face FACE_ID for attributes that aren't
4651 completely specified by SYMBOL. This is like lookup_named_face,
4652 except that the default attributes come from FACE_ID, not from the
4653 default face. FACE_ID is assumed to be already realized. */
4656 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4659 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4660 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4661 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4666 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4669 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4670 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4671 return lookup_face (f
, attrs
);
4674 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4675 Sface_attributes_as_vector
, 1, 1, 0,
4676 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4680 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4682 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4689 /***********************************************************************
4690 Face capability testing
4691 ***********************************************************************/
4694 /* If the distance (as returned by color_distance) between two colors is
4695 less than this, then they are considered the same, for determining
4696 whether a color is supported or not. The range of values is 0-65535. */
4698 #define TTY_SAME_COLOR_THRESHOLD 10000
4700 #ifdef HAVE_WINDOW_SYSTEM
4702 /* Return true if all the face attributes in ATTRS are supported
4703 on the window-system frame F.
4705 The definition of `supported' is somewhat heuristic, but basically means
4706 that a face containing all the attributes in ATTRS, when merged with the
4707 default face for display, can be represented in a way that's
4709 \(1) different in appearance than the default face, and
4710 \(2) `close in spirit' to what the attributes specify, if not exact. */
4713 x_supports_face_attributes_p (struct frame
*f
,
4714 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4715 struct face
*def_face
)
4717 Lisp_Object
*def_attrs
= def_face
->lface
;
4719 /* Check that other specified attributes are different that the default
4721 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4722 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4723 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4724 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4725 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4726 def_attrs
[LFACE_INVERSE_INDEX
]))
4727 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4728 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4729 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4730 || (!UNSPECIFIEDP (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
])
4731 && face_attr_equal_p (attrs
[LFACE_DISTANT_FOREGROUND_INDEX
],
4732 def_attrs
[LFACE_DISTANT_FOREGROUND_INDEX
]))
4733 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4734 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4735 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4736 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4737 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4738 def_attrs
[LFACE_STIPPLE_INDEX
]))
4739 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4740 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4741 def_attrs
[LFACE_OVERLINE_INDEX
]))
4742 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4743 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4744 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4745 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4746 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4747 def_attrs
[LFACE_BOX_INDEX
])))
4750 /* Check font-related attributes, as those are the most commonly
4751 "unsupported" on a window-system (because of missing fonts). */
4752 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4753 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4754 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4755 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4756 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4757 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4761 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4764 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4766 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4768 face_id
= lookup_face (f
, merged_attrs
);
4769 face
= FACE_FROM_ID (f
, face_id
);
4772 error ("Cannot make face");
4774 /* If the font is the same, or no font is found, then not
4776 if (face
->font
== def_face
->font
4779 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4780 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4784 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4785 || face
->font
->driver
->case_sensitive
)
4787 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4788 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4789 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4790 s2
, make_number (0), Qnil
, Qt
), Qt
))
4796 /* Everything checks out, this face is supported. */
4800 #endif /* HAVE_WINDOW_SYSTEM */
4802 /* Return true if all the face attributes in ATTRS are supported
4805 The definition of `supported' is somewhat heuristic, but basically means
4806 that a face containing all the attributes in ATTRS, when merged
4807 with the default face for display, can be represented in a way that's
4809 \(1) different in appearance than the default face, and
4810 \(2) `close in spirit' to what the attributes specify, if not exact.
4812 Point (2) implies that a `:weight black' attribute will be satisfied
4813 by any terminal that can display bold, and a `:foreground "yellow"' as
4814 long as the terminal can display a yellowish color, but `:slant italic'
4815 will _not_ be satisfied by the tty display code's automatic
4816 substitution of a `dim' face for italic. */
4819 tty_supports_face_attributes_p (struct frame
*f
,
4820 Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
4821 struct face
*def_face
)
4824 Lisp_Object val
, fg
, bg
;
4825 XColor fg_tty_color
, fg_std_color
;
4826 XColor bg_tty_color
, bg_std_color
;
4827 unsigned test_caps
= 0;
4828 Lisp_Object
*def_attrs
= def_face
->lface
;
4830 /* First check some easy-to-check stuff; ttys support none of the
4831 following attributes, so we can just return false if any are requested
4832 (even if `nominal' values are specified, we should still return false,
4833 as that will be the same value that the default face uses). We
4834 consider :slant unsupportable on ttys, even though the face code
4835 actually `fakes' them using a dim attribute if possible. This is
4836 because the faked result is too different from what the face
4838 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4839 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4840 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4841 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4842 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4843 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4844 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4845 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4848 /* Test for terminal `capabilities' (non-color character attributes). */
4850 /* font weight (bold/dim) */
4851 val
= attrs
[LFACE_WEIGHT_INDEX
];
4852 if (!UNSPECIFIEDP (val
)
4853 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4855 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4859 if (def_weight
> 100)
4860 return 0; /* same as default */
4861 test_caps
= TTY_CAP_BOLD
;
4863 else if (weight
< 100)
4865 if (def_weight
< 100)
4866 return 0; /* same as default */
4867 test_caps
= TTY_CAP_DIM
;
4869 else if (def_weight
== 100)
4870 return 0; /* same as default */
4874 val
= attrs
[LFACE_SLANT_INDEX
];
4875 if (!UNSPECIFIEDP (val
)
4876 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4878 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4879 if (slant
== 100 || slant
== def_slant
)
4880 return 0; /* same as default */
4882 test_caps
|= TTY_CAP_ITALIC
;
4886 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4887 if (!UNSPECIFIEDP (val
))
4890 return 0; /* ttys can't use colored underlines */
4891 else if (EQ (CAR_SAFE (val
), QCstyle
) && EQ (CAR_SAFE (CDR_SAFE (val
)), Qwave
))
4892 return 0; /* ttys can't use wave underlines */
4893 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4894 return 0; /* same as default */
4896 test_caps
|= TTY_CAP_UNDERLINE
;
4900 val
= attrs
[LFACE_INVERSE_INDEX
];
4901 if (!UNSPECIFIEDP (val
))
4903 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4904 return 0; /* same as default */
4906 test_caps
|= TTY_CAP_INVERSE
;
4910 /* Color testing. */
4912 /* Check if foreground color is close enough. */
4913 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4916 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4918 if (face_attr_equal_p (fg
, def_fg
))
4919 return 0; /* same as default */
4920 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4921 return 0; /* not a valid color */
4922 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4923 > TTY_SAME_COLOR_THRESHOLD
)
4924 return 0; /* displayed color is too different */
4926 /* Make sure the color is really different than the default. */
4928 XColor def_fg_color
;
4929 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
4930 && (color_distance (&fg_tty_color
, &def_fg_color
)
4931 <= TTY_SAME_COLOR_THRESHOLD
))
4936 /* Check if background color is close enough. */
4937 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
4940 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
4942 if (face_attr_equal_p (bg
, def_bg
))
4943 return 0; /* same as default */
4944 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
4945 return 0; /* not a valid color */
4946 else if (color_distance (&bg_tty_color
, &bg_std_color
)
4947 > TTY_SAME_COLOR_THRESHOLD
)
4948 return 0; /* displayed color is too different */
4950 /* Make sure the color is really different than the default. */
4952 XColor def_bg_color
;
4953 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
4954 && (color_distance (&bg_tty_color
, &def_bg_color
)
4955 <= TTY_SAME_COLOR_THRESHOLD
))
4960 /* If both foreground and background are requested, see if the
4961 distance between them is OK. We just check to see if the distance
4962 between the tty's foreground and background is close enough to the
4963 distance between the standard foreground and background. */
4964 if (STRINGP (fg
) && STRINGP (bg
))
4967 = (color_distance (&fg_std_color
, &bg_std_color
)
4968 - color_distance (&fg_tty_color
, &bg_tty_color
));
4969 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
4970 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
4975 /* See if the capabilities we selected above are supported, with the
4977 return tty_capable_p (FRAME_TTY (f
), test_caps
);
4981 DEFUN ("display-supports-face-attributes-p",
4982 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
4984 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
4985 The optional argument DISPLAY can be a display name, a frame, or
4986 nil (meaning the selected frame's display).
4988 The definition of `supported' is somewhat heuristic, but basically means
4989 that a face containing all the attributes in ATTRIBUTES, when merged
4990 with the default face for display, can be represented in a way that's
4992 \(1) different in appearance than the default face, and
4993 \(2) `close in spirit' to what the attributes specify, if not exact.
4995 Point (2) implies that a `:weight black' attribute will be satisfied by
4996 any display that can display bold, and a `:foreground \"yellow\"' as long
4997 as it can display a yellowish color, but `:slant italic' will _not_ be
4998 satisfied by the tty display code's automatic substitution of a `dim'
4999 face for italic. */)
5000 (Lisp_Object attributes
, Lisp_Object display
)
5006 struct face
*def_face
;
5007 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5009 if (noninteractive
|| !initialized
)
5010 /* We may not be able to access low-level face information in batch
5011 mode, or before being dumped, and this function is not going to
5012 be very useful in those cases anyway, so just give up. */
5016 frame
= selected_frame
;
5017 else if (FRAMEP (display
))
5021 /* Find any frame on DISPLAY. */
5025 FOR_EACH_FRAME (tail
, frame
)
5026 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5027 XFRAME (frame
)->param_alist
)),
5032 CHECK_LIVE_FRAME (frame
);
5035 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5036 attrs
[i
] = Qunspecified
;
5037 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5039 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5040 if (def_face
== NULL
)
5042 if (! realize_basic_faces (f
))
5043 error ("Cannot realize default face");
5044 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5045 if (def_face
== NULL
)
5046 emacs_abort (); /* realize_basic_faces must have set it up */
5049 /* Dispatch to the appropriate handler. */
5050 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5051 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5052 #ifdef HAVE_WINDOW_SYSTEM
5054 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5057 return supports
? Qt
: Qnil
;
5061 /***********************************************************************
5063 ***********************************************************************/
5065 DEFUN ("internal-set-font-selection-order",
5066 Finternal_set_font_selection_order
,
5067 Sinternal_set_font_selection_order
, 1, 1, 0,
5068 doc
: /* Set font selection order for face font selection to ORDER.
5069 ORDER must be a list of length 4 containing the symbols `:width',
5070 `:height', `:weight', and `:slant'. Face attributes appearing
5071 first in ORDER are matched first, e.g. if `:height' appears before
5072 `:weight' in ORDER, font selection first tries to find a font with
5073 a suitable height, and then tries to match the font weight.
5079 int indices
[ARRAYELTS (font_sort_order
)];
5082 memset (indices
, 0, sizeof indices
);
5086 CONSP (list
) && i
< ARRAYELTS (indices
);
5087 list
= XCDR (list
), ++i
)
5089 Lisp_Object attr
= XCAR (list
);
5092 if (EQ (attr
, QCwidth
))
5094 else if (EQ (attr
, QCheight
))
5095 xlfd
= XLFD_POINT_SIZE
;
5096 else if (EQ (attr
, QCweight
))
5098 else if (EQ (attr
, QCslant
))
5103 if (indices
[i
] != 0)
5108 if (!NILP (list
) || i
!= ARRAYELTS (indices
))
5109 signal_error ("Invalid font sort order", order
);
5110 for (i
= 0; i
< ARRAYELTS (font_sort_order
); ++i
)
5111 if (indices
[i
] == 0)
5112 signal_error ("Invalid font sort order", order
);
5114 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5116 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5117 free_all_realized_faces (Qnil
);
5120 font_update_sort_order (font_sort_order
);
5126 DEFUN ("internal-set-alternative-font-family-alist",
5127 Finternal_set_alternative_font_family_alist
,
5128 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5129 doc
: /* Define alternative font families to try in face font selection.
5130 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5131 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5132 be found. Value is ALIST. */)
5135 Lisp_Object entry
, tail
, tail2
;
5138 alist
= Fcopy_sequence (alist
);
5139 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5141 entry
= XCAR (tail
);
5143 entry
= Fcopy_sequence (entry
);
5144 XSETCAR (tail
, entry
);
5145 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5146 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5149 Vface_alternative_font_family_alist
= alist
;
5150 free_all_realized_faces (Qnil
);
5155 DEFUN ("internal-set-alternative-font-registry-alist",
5156 Finternal_set_alternative_font_registry_alist
,
5157 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5158 doc
: /* Define alternative font registries to try in face font selection.
5159 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5160 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5161 be found. Value is ALIST. */)
5164 Lisp_Object entry
, tail
, tail2
;
5167 alist
= Fcopy_sequence (alist
);
5168 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5170 entry
= XCAR (tail
);
5172 entry
= Fcopy_sequence (entry
);
5173 XSETCAR (tail
, entry
);
5174 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5175 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5177 Vface_alternative_font_registry_alist
= alist
;
5178 free_all_realized_faces (Qnil
);
5183 #ifdef HAVE_WINDOW_SYSTEM
5185 /* Return the fontset id of the base fontset name or alias name given
5186 by the fontset attribute of ATTRS. Value is -1 if the fontset
5187 attribute of ATTRS doesn't name a fontset. */
5190 face_fontset (Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5194 name
= attrs
[LFACE_FONTSET_INDEX
];
5195 if (!STRINGP (name
))
5197 return fs_query_fontset (name
, 0);
5200 #endif /* HAVE_WINDOW_SYSTEM */
5204 /***********************************************************************
5206 ***********************************************************************/
5208 /* Realize basic faces on frame F. Value is zero if frame parameters
5209 of F don't contain enough information needed to realize the default
5213 realize_basic_faces (struct frame
*f
)
5216 ptrdiff_t count
= SPECPDL_INDEX ();
5218 /* Block input here so that we won't be surprised by an X expose
5219 event, for instance, without having the faces set up. */
5221 specbind (Qscalable_fonts_allowed
, Qt
);
5223 if (realize_default_face (f
))
5225 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5226 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5227 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5228 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5229 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5230 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5231 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5232 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5233 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5234 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5235 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5236 realize_named_face (f
, Qwindow_divider
, WINDOW_DIVIDER_FACE_ID
);
5237 realize_named_face (f
, Qwindow_divider_first_pixel
,
5238 WINDOW_DIVIDER_FIRST_PIXEL_FACE_ID
);
5239 realize_named_face (f
, Qwindow_divider_last_pixel
,
5240 WINDOW_DIVIDER_LAST_PIXEL_FACE_ID
);
5242 /* Reflect changes in the `menu' face in menu bars. */
5243 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5245 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5246 #ifdef USE_X_TOOLKIT
5247 if (FRAME_WINDOW_P (f
))
5248 x_update_menu_appearance (f
);
5255 unbind_to (count
, Qnil
);
5261 /* Realize the default face on frame F. If the face is not fully
5262 specified, make it fully-specified. Attributes of the default face
5263 that are not explicitly specified are taken from frame parameters. */
5266 realize_default_face (struct frame
*f
)
5268 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5270 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5273 /* If the `default' face is not yet known, create it. */
5274 lface
= lface_from_face_name (f
, Qdefault
, 0);
5278 XSETFRAME (frame
, f
);
5279 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5282 #ifdef HAVE_WINDOW_SYSTEM
5283 if (FRAME_WINDOW_P (f
))
5285 Lisp_Object font_object
;
5287 XSETFONT (font_object
, FRAME_FONT (f
));
5288 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5289 ASET (lface
, LFACE_FONTSET_INDEX
, fontset_name (FRAME_FONTSET (f
)));
5290 f
->default_face_done_p
= 1;
5292 #endif /* HAVE_WINDOW_SYSTEM */
5294 if (!FRAME_WINDOW_P (f
))
5296 ASET (lface
, LFACE_FAMILY_INDEX
, build_string ("default"));
5297 ASET (lface
, LFACE_FOUNDRY_INDEX
, LFACE_FAMILY (lface
));
5298 ASET (lface
, LFACE_SWIDTH_INDEX
, Qnormal
);
5299 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (1));
5300 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5301 ASET (lface
, LFACE_WEIGHT_INDEX
, Qnormal
);
5302 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5303 ASET (lface
, LFACE_SLANT_INDEX
, Qnormal
);
5304 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5305 ASET (lface
, LFACE_FONTSET_INDEX
, Qnil
);
5308 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5309 ASET (lface
, LFACE_UNDERLINE_INDEX
, Qnil
);
5311 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5312 ASET (lface
, LFACE_OVERLINE_INDEX
, Qnil
);
5314 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5315 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, Qnil
);
5317 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5318 ASET (lface
, LFACE_BOX_INDEX
, Qnil
);
5320 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5321 ASET (lface
, LFACE_INVERSE_INDEX
, Qnil
);
5323 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5325 /* This function is called so early that colors are not yet
5326 set in the frame parameter list. */
5327 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5329 if (CONSP (color
) && STRINGP (XCDR (color
)))
5330 ASET (lface
, LFACE_FOREGROUND_INDEX
, XCDR (color
));
5331 else if (FRAME_WINDOW_P (f
))
5333 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5334 ASET (lface
, LFACE_FOREGROUND_INDEX
, build_string (unspecified_fg
));
5339 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5341 /* This function is called so early that colors are not yet
5342 set in the frame parameter list. */
5343 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5344 if (CONSP (color
) && STRINGP (XCDR (color
)))
5345 ASET (lface
, LFACE_BACKGROUND_INDEX
, XCDR (color
));
5346 else if (FRAME_WINDOW_P (f
))
5348 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5349 ASET (lface
, LFACE_BACKGROUND_INDEX
, build_string (unspecified_bg
));
5354 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5355 ASET (lface
, LFACE_STIPPLE_INDEX
, Qnil
);
5357 /* Realize the face; it must be fully-specified now. */
5358 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5359 check_lface (lface
);
5360 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5361 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5363 #ifdef HAVE_WINDOW_SYSTEM
5364 #ifdef HAVE_X_WINDOWS
5365 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5367 /* This can happen when making a frame on a display that does
5368 not support the default font. */
5372 /* Otherwise, the font specified for the frame was not
5373 acceptable as a font for the default face (perhaps because
5374 auto-scaled fonts are rejected), so we must adjust the frame
5376 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5378 #endif /* HAVE_X_WINDOWS */
5379 #endif /* HAVE_WINDOW_SYSTEM */
5384 /* Realize basic faces other than the default face in face cache C.
5385 SYMBOL is the face name, ID is the face id the realized face must
5386 have. The default face must have been realized already. */
5389 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5391 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5392 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5393 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5394 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5396 /* The default face must exist and be fully specified. */
5397 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5398 check_lface_attrs (attrs
);
5399 eassert (lface_fully_specified_p (attrs
));
5401 /* If SYMBOL isn't know as a face, create it. */
5405 XSETFRAME (frame
, f
);
5406 lface
= Finternal_make_lisp_face (symbol
, frame
);
5409 /* Merge SYMBOL's face with the default face. */
5410 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5411 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5413 /* Realize the face. */
5414 realize_face (c
, attrs
, id
);
5418 /* Realize the fully-specified face with attributes ATTRS in face
5419 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5420 non-negative, it is an ID of face to remove before caching the new
5421 face. Value is a pointer to the newly created realized face. */
5423 static struct face
*
5424 realize_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
],
5429 /* LFACE must be fully specified. */
5430 eassert (cache
!= NULL
);
5431 check_lface_attrs (attrs
);
5433 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5435 /* Remove the former face. */
5436 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5437 uncache_face (cache
, former_face
);
5438 free_realized_face (cache
->f
, former_face
);
5439 SET_FRAME_GARBAGED (cache
->f
);
5442 if (FRAME_WINDOW_P (cache
->f
))
5443 face
= realize_x_face (cache
, attrs
);
5444 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5445 face
= realize_tty_face (cache
, attrs
);
5446 else if (FRAME_INITIAL_P (cache
->f
))
5448 /* Create a dummy face. */
5449 face
= make_realized_face (attrs
);
5454 /* Insert the new face. */
5455 cache_face (cache
, face
, lface_hash (attrs
));
5460 #ifdef HAVE_WINDOW_SYSTEM
5461 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5462 same attributes as BASE_FACE except for the font on frame F.
5463 FONT-OBJECT may be nil, in which case, realized a face of
5466 static struct face
*
5467 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5468 struct face
*base_face
)
5470 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5473 face
= xmalloc (sizeof *face
);
5477 = (! NILP (font_object
)
5478 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5479 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5481 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5482 face
->colors_copied_bitwise_p
= 1;
5483 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5486 cache_face (cache
, face
, face
->hash
);
5490 #endif /* HAVE_WINDOW_SYSTEM */
5493 /* Realize the fully-specified face with attributes ATTRS in face
5494 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5495 the new face doesn't share font with the default face, a fontname
5496 is allocated from the heap and set in `font_name' of the new face,
5497 but it is not yet loaded here. Value is a pointer to the newly
5498 created realized face. */
5500 static struct face
*
5501 realize_x_face (struct face_cache
*cache
, Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5503 struct face
*face
= NULL
;
5504 #ifdef HAVE_WINDOW_SYSTEM
5505 struct face
*default_face
;
5507 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5509 eassert (FRAME_WINDOW_P (cache
->f
));
5511 /* Allocate a new realized face. */
5512 face
= make_realized_face (attrs
);
5513 face
->ascii_face
= face
;
5517 /* Determine the font to use. Most of the time, the font will be
5518 the same as the font of the default face, so try that first. */
5519 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5521 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5523 face
->font
= default_face
->font
;
5525 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5529 /* If the face attribute ATTRS specifies a fontset, use it as
5530 the base of a new realized fontset. Otherwise, use the same
5531 base fontset as of the default face. The base determines
5532 registry and encoding of a font. It may also determine
5533 foundry and family. The other fields of font name pattern
5534 are constructed from ATTRS. */
5535 int fontset
= face_fontset (attrs
);
5537 /* If we are realizing the default face, ATTRS should specify a
5538 fontset. In other words, if FONTSET is -1, we are not
5539 realizing the default face, thus the default face should have
5540 already been realized. */
5544 fontset
= default_face
->fontset
;
5548 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5549 attrs
[LFACE_FONT_INDEX
]
5550 = font_load_for_lface (f
, attrs
, Ffont_spec (0, NULL
));
5551 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5553 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5554 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5564 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5565 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5566 face
->overstrike
= 1;
5568 /* Load colors, and set remaining attributes. */
5570 load_face_colors (f
, face
, attrs
);
5573 box
= attrs
[LFACE_BOX_INDEX
];
5576 /* A simple box of line width 1 drawn in color given by
5578 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5580 face
->box
= FACE_SIMPLE_BOX
;
5581 face
->box_line_width
= 1;
5583 else if (INTEGERP (box
))
5585 /* Simple box of specified line width in foreground color of the
5587 eassert (XINT (box
) != 0);
5588 face
->box
= FACE_SIMPLE_BOX
;
5589 face
->box_line_width
= XINT (box
);
5590 face
->box_color
= face
->foreground
;
5591 face
->box_color_defaulted_p
= 1;
5593 else if (CONSP (box
))
5595 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5596 being one of `raised' or `sunken'. */
5597 face
->box
= FACE_SIMPLE_BOX
;
5598 face
->box_color
= face
->foreground
;
5599 face
->box_color_defaulted_p
= 1;
5600 face
->box_line_width
= 1;
5604 Lisp_Object keyword
, value
;
5606 keyword
= XCAR (box
);
5614 if (EQ (keyword
, QCline_width
))
5616 if (INTEGERP (value
) && XINT (value
) != 0)
5617 face
->box_line_width
= XINT (value
);
5619 else if (EQ (keyword
, QCcolor
))
5621 if (STRINGP (value
))
5623 face
->box_color
= load_color (f
, face
, value
,
5625 face
->use_box_color_for_shadows_p
= 1;
5628 else if (EQ (keyword
, QCstyle
))
5630 if (EQ (value
, Qreleased_button
))
5631 face
->box
= FACE_RAISED_BOX
;
5632 else if (EQ (value
, Qpressed_button
))
5633 face
->box
= FACE_SUNKEN_BOX
;
5638 /* Text underline, overline, strike-through. */
5640 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5641 if (EQ (underline
, Qt
))
5643 /* Use default color (same as foreground color). */
5644 face
->underline_p
= 1;
5645 face
->underline_type
= FACE_UNDER_LINE
;
5646 face
->underline_defaulted_p
= 1;
5647 face
->underline_color
= 0;
5649 else if (STRINGP (underline
))
5651 /* Use specified color. */
5652 face
->underline_p
= 1;
5653 face
->underline_type
= FACE_UNDER_LINE
;
5654 face
->underline_defaulted_p
= 0;
5655 face
->underline_color
5656 = load_color (f
, face
, underline
,
5657 LFACE_UNDERLINE_INDEX
);
5659 else if (NILP (underline
))
5661 face
->underline_p
= 0;
5662 face
->underline_defaulted_p
= 0;
5663 face
->underline_color
= 0;
5665 else if (CONSP (underline
))
5667 /* `(:color COLOR :style STYLE)'.
5668 STYLE being one of `line' or `wave'. */
5669 face
->underline_p
= 1;
5670 face
->underline_color
= 0;
5671 face
->underline_defaulted_p
= 1;
5672 face
->underline_type
= FACE_UNDER_LINE
;
5674 /* FIXME? This is also not robust about checking the precise form.
5675 See comments in Finternal_set_lisp_face_attribute. */
5676 while (CONSP (underline
))
5678 Lisp_Object keyword
, value
;
5680 keyword
= XCAR (underline
);
5681 underline
= XCDR (underline
);
5683 if (!CONSP (underline
))
5685 value
= XCAR (underline
);
5686 underline
= XCDR (underline
);
5688 if (EQ (keyword
, QCcolor
))
5690 if (EQ (value
, Qforeground_color
))
5692 face
->underline_defaulted_p
= 1;
5693 face
->underline_color
= 0;
5695 else if (STRINGP (value
))
5697 face
->underline_defaulted_p
= 0;
5698 face
->underline_color
= load_color (f
, face
, value
,
5699 LFACE_UNDERLINE_INDEX
);
5702 else if (EQ (keyword
, QCstyle
))
5704 if (EQ (value
, Qline
))
5705 face
->underline_type
= FACE_UNDER_LINE
;
5706 else if (EQ (value
, Qwave
))
5707 face
->underline_type
= FACE_UNDER_WAVE
;
5712 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5713 if (STRINGP (overline
))
5715 face
->overline_color
5716 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5717 LFACE_OVERLINE_INDEX
);
5718 face
->overline_p
= 1;
5720 else if (EQ (overline
, Qt
))
5722 face
->overline_color
= face
->foreground
;
5723 face
->overline_color_defaulted_p
= 1;
5724 face
->overline_p
= 1;
5727 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5728 if (STRINGP (strike_through
))
5730 face
->strike_through_color
5731 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5732 LFACE_STRIKE_THROUGH_INDEX
);
5733 face
->strike_through_p
= 1;
5735 else if (EQ (strike_through
, Qt
))
5737 face
->strike_through_color
= face
->foreground
;
5738 face
->strike_through_color_defaulted_p
= 1;
5739 face
->strike_through_p
= 1;
5742 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5743 if (!NILP (stipple
))
5744 face
->stipple
= load_pixmap (f
, stipple
);
5745 #endif /* HAVE_WINDOW_SYSTEM */
5751 /* Map a specified color of face FACE on frame F to a tty color index.
5752 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5753 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5754 default foreground/background colors. */
5757 map_tty_color (struct frame
*f
, struct face
*face
,
5758 enum lface_attribute_index idx
, int *defaulted
)
5760 Lisp_Object frame
, color
, def
;
5761 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5762 unsigned long default_pixel
=
5763 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5764 unsigned long pixel
= default_pixel
;
5766 unsigned long default_other_pixel
=
5767 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5770 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5772 XSETFRAME (frame
, f
);
5773 color
= face
->lface
[idx
];
5777 && CONSP (Vtty_defined_color_alist
)
5778 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5781 /* Associations in tty-defined-color-alist are of the form
5782 (NAME INDEX R G B). We need the INDEX part. */
5783 pixel
= XINT (XCAR (XCDR (def
)));
5786 if (pixel
== default_pixel
&& STRINGP (color
))
5788 pixel
= load_color (f
, face
, color
, idx
);
5791 /* If the foreground of the default face is the default color,
5792 use the foreground color defined by the frame. */
5793 if (FRAME_MSDOS_P (f
))
5795 if (pixel
== default_pixel
5796 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5799 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5801 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5802 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5805 else if (pixel
== default_other_pixel
)
5808 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5810 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5811 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5819 face
->foreground
= pixel
;
5821 face
->background
= pixel
;
5825 /* Realize the fully-specified face with attributes ATTRS in face
5826 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5827 Value is a pointer to the newly created realized face. */
5829 static struct face
*
5830 realize_tty_face (struct face_cache
*cache
,
5831 Lisp_Object attrs
[LFACE_VECTOR_SIZE
])
5835 int face_colors_defaulted
= 0;
5836 struct frame
*f
= cache
->f
;
5838 /* Frame must be a termcap frame. */
5839 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5841 /* Allocate a new realized face. */
5842 face
= make_realized_face (attrs
);
5844 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5847 /* Map face attributes to TTY appearances. */
5848 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5849 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5851 face
->tty_bold_p
= 1;
5853 face
->tty_italic_p
= 1;
5854 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5855 face
->tty_underline_p
= 1;
5856 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5857 face
->tty_reverse_p
= 1;
5859 /* Map color names to color indices. */
5860 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5861 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5863 /* Swap colors if face is inverse-video. If the colors are taken
5864 from the frame colors, they are already inverted, since the
5865 frame-creation function calls x-handle-reverse-video. */
5866 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5868 unsigned long tem
= face
->foreground
;
5869 face
->foreground
= face
->background
;
5870 face
->background
= tem
;
5873 if (tty_suppress_bold_inverse_default_colors_p
5875 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5876 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5877 face
->tty_bold_p
= 0;
5883 DEFUN ("tty-suppress-bold-inverse-default-colors",
5884 Ftty_suppress_bold_inverse_default_colors
,
5885 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5886 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5887 SUPPRESS non-nil means suppress it.
5888 This affects bold faces on TTYs whose foreground is the default background
5889 color of the display and whose background is the default foreground color.
5890 For such faces, the bold face attribute is ignored if this variable
5892 (Lisp_Object suppress
)
5894 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5895 ++face_change_count
;
5901 /***********************************************************************
5903 ***********************************************************************/
5905 /* Return the ID of the face to use to display character CH with face
5906 property PROP on frame F in current_buffer. */
5909 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5913 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5918 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5919 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5923 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5924 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5925 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5926 merge_face_ref (f
, prop
, attrs
, 1, 0);
5927 face_id
= lookup_face (f
, attrs
);
5933 /* Return the face ID associated with buffer position POS for
5934 displaying ASCII characters. Return in *ENDPTR the position at
5935 which a different face is needed, as far as text properties and
5936 overlays are concerned. W is a window displaying current_buffer.
5938 REGION_BEG, REGION_END delimit the region, so it can be
5941 LIMIT is a position not to scan beyond. That is to limit the time
5942 this function can take.
5944 If MOUSE is non-zero, use the character's mouse-face, not its face.
5946 BASE_FACE_ID, if non-negative, specifies a base face id to use
5947 instead of DEFAULT_FACE_ID.
5949 The face returned is suitable for displaying ASCII characters. */
5952 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
5953 ptrdiff_t *endptr
, ptrdiff_t limit
,
5954 int mouse
, int base_face_id
)
5956 struct frame
*f
= XFRAME (w
->frame
);
5957 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5958 Lisp_Object prop
, position
;
5959 ptrdiff_t i
, noverlays
;
5960 Lisp_Object
*overlay_vec
;
5962 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5963 Lisp_Object limit1
, end
;
5964 struct face
*default_face
;
5966 /* W must display the current buffer. We could write this function
5967 to use the frame and buffer of W, but right now it doesn't. */
5968 /* eassert (XBUFFER (w->contents) == current_buffer); */
5970 XSETFASTINT (position
, pos
);
5974 /* Get the `face' or `mouse_face' text property at POS, and
5975 determine the next position at which the property changes. */
5976 prop
= Fget_text_property (position
, propname
, w
->contents
);
5977 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5978 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
5980 endpos
= XINT (end
);
5982 /* Look at properties from overlays. */
5985 ptrdiff_t next_overlay
;
5987 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
5988 if (next_overlay
< endpos
)
5989 endpos
= next_overlay
;
5997 if (base_face_id
>= 0)
5998 face_id
= base_face_id
;
5999 else if (NILP (Vface_remapping_alist
))
6000 face_id
= DEFAULT_FACE_ID
;
6002 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6004 default_face
= FACE_FROM_ID (f
, face_id
);
6007 /* Optimize common cases where we can use the default face. */
6012 return default_face
->id
;
6015 /* Begin with attributes from the default face. */
6016 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6018 /* Merge in attributes specified via text properties. */
6020 merge_face_ref (f
, prop
, attrs
, 1, 0);
6022 /* Now merge the overlay data. */
6023 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6024 for (i
= 0; i
< noverlays
; i
++)
6029 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6031 merge_face_ref (f
, prop
, attrs
, 1, 0);
6033 oend
= OVERLAY_END (overlay_vec
[i
]);
6034 oendpos
= OVERLAY_POSITION (oend
);
6035 if (oendpos
< endpos
)
6043 /* Look up a realized face with the given face attributes,
6044 or realize a new one for ASCII characters. */
6045 return lookup_face (f
, attrs
);
6048 /* Return the face ID at buffer position POS for displaying ASCII
6049 characters associated with overlay strings for overlay OVERLAY.
6051 Like face_at_buffer_position except for OVERLAY. Currently it
6052 simply disregards the `face' properties of all overlays. */
6055 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6056 ptrdiff_t *endptr
, ptrdiff_t limit
,
6057 int mouse
, Lisp_Object overlay
)
6059 struct frame
*f
= XFRAME (w
->frame
);
6060 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6061 Lisp_Object prop
, position
;
6063 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6064 Lisp_Object limit1
, end
;
6065 struct face
*default_face
;
6067 /* W must display the current buffer. We could write this function
6068 to use the frame and buffer of W, but right now it doesn't. */
6069 /* eassert (XBUFFER (w->contents) == current_buffer); */
6071 XSETFASTINT (position
, pos
);
6075 /* Get the `face' or `mouse_face' text property at POS, and
6076 determine the next position at which the property changes. */
6077 prop
= Fget_text_property (position
, propname
, w
->contents
);
6078 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6079 end
= Fnext_single_property_change (position
, propname
, w
->contents
, limit1
);
6081 endpos
= XINT (end
);
6085 /* Optimize common case where we can use the default face. */
6087 && NILP (Vface_remapping_alist
))
6088 return DEFAULT_FACE_ID
;
6090 /* Begin with attributes from the default face. */
6091 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6092 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6094 /* Merge in attributes specified via text properties. */
6096 merge_face_ref (f
, prop
, attrs
, 1, 0);
6100 /* Look up a realized face with the given face attributes,
6101 or realize a new one for ASCII characters. */
6102 return lookup_face (f
, attrs
);
6106 /* Compute the face at character position POS in Lisp string STRING on
6107 window W, for ASCII characters.
6109 If STRING is an overlay string, it comes from position BUFPOS in
6110 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6111 not an overlay string. W must display the current buffer.
6112 REGION_BEG and REGION_END give the start and end positions of the
6113 region; both are -1 if no region is visible.
6115 BASE_FACE_ID is the id of a face to merge with. For strings coming
6116 from overlays or the `display' property it is the face at BUFPOS.
6118 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6120 Set *ENDPTR to the next position where to check for faces in
6121 STRING; -1 if the face is constant from POS to the end of the
6124 Value is the id of the face to use. The face returned is suitable
6125 for displaying ASCII characters. */
6128 face_at_string_position (struct window
*w
, Lisp_Object string
,
6129 ptrdiff_t pos
, ptrdiff_t bufpos
,
6130 ptrdiff_t *endptr
, enum face_id base_face_id
,
6133 Lisp_Object prop
, position
, end
, limit
;
6134 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6135 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6136 struct face
*base_face
;
6137 bool multibyte_p
= STRING_MULTIBYTE (string
);
6138 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6140 /* Get the value of the face property at the current position within
6141 STRING. Value is nil if there is no face property. */
6142 XSETFASTINT (position
, pos
);
6143 prop
= Fget_text_property (position
, prop_name
, string
);
6145 /* Get the next position at which to check for faces. Value of end
6146 is nil if face is constant all the way to the end of the string.
6147 Otherwise it is a string position where to check faces next.
6148 Limit is the maximum position up to which to check for property
6149 changes in Fnext_single_property_change. Strings are usually
6150 short, so set the limit to the end of the string. */
6151 XSETFASTINT (limit
, SCHARS (string
));
6152 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6154 *endptr
= XFASTINT (end
);
6158 base_face
= FACE_FROM_ID (f
, base_face_id
);
6159 eassert (base_face
);
6161 /* Optimize the default case that there is no face property. */
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 /* Look up a realized face with the given face attributes,
6179 or realize a new one for ASCII characters. */
6180 return lookup_face (f
, attrs
);
6184 /* Merge a face into a realized face.
6186 F is frame where faces are (to be) realized.
6188 FACE_NAME is named face to merge.
6190 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6192 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6194 BASE_FACE_ID is realized face to merge into.
6200 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6203 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6204 struct face
*base_face
;
6206 base_face
= FACE_FROM_ID (f
, base_face_id
);
6208 return base_face_id
;
6210 if (EQ (face_name
, Qt
))
6212 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6213 return base_face_id
;
6214 face_name
= lface_id_to_name
[face_id
];
6215 /* When called during make-frame, lookup_derived_face may fail
6216 if the faces are uninitialized. Don't signal an error. */
6217 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6218 return (face_id
>= 0 ? face_id
: base_face_id
);
6221 /* Begin with attributes from the base face. */
6222 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6224 if (!NILP (face_name
))
6226 if (!merge_named_face (f
, face_name
, attrs
, 0))
6227 return base_face_id
;
6233 return base_face_id
;
6234 face
= FACE_FROM_ID (f
, face_id
);
6236 return base_face_id
;
6237 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6240 /* Look up a realized face with the given face attributes,
6241 or realize a new one for ASCII characters. */
6242 return lookup_face (f
, attrs
);
6247 #ifndef HAVE_X_WINDOWS
6248 DEFUN ("x-load-color-file", Fx_load_color_file
,
6249 Sx_load_color_file
, 1, 1, 0,
6250 doc
: /* Create an alist of color entries from an external file.
6252 The file should define one named RGB color per line like so:
6254 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6255 (Lisp_Object filename
)
6258 Lisp_Object cmap
= Qnil
;
6259 Lisp_Object abspath
;
6261 CHECK_STRING (filename
);
6262 abspath
= Fexpand_file_name (filename
, Qnil
);
6265 fp
= emacs_fopen (SSDATA (abspath
), "rt");
6269 int red
, green
, blue
;
6272 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6273 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6276 int color
= RGB (red
, green
, blue
);
6278 int color
= (red
<< 16) | (green
<< 8) | blue
;
6280 char *name
= buf
+ num
;
6281 ptrdiff_t len
= strlen (name
);
6282 len
-= 0 < len
&& name
[len
- 1] == '\n';
6283 cmap
= Fcons (Fcons (make_string (name
, len
), make_number (color
)),
6295 /***********************************************************************
6297 ***********************************************************************/
6301 /* Print the contents of the realized face FACE to stderr. */
6304 dump_realized_face (struct face
*face
)
6306 fprintf (stderr
, "ID: %d\n", face
->id
);
6307 #ifdef HAVE_X_WINDOWS
6308 fprintf (stderr
, "gc: %p\n", face
->gc
);
6310 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6312 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6313 fprintf (stderr
, "background: 0x%lx (%s)\n",
6315 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6317 fprintf (stderr
, "font_name: %s (%s)\n",
6318 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6319 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6320 #ifdef HAVE_X_WINDOWS
6321 fprintf (stderr
, "font = %p\n", face
->font
);
6323 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6324 fprintf (stderr
, "underline: %d (%s)\n",
6326 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6327 fprintf (stderr
, "hash: %d\n", face
->hash
);
6331 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6338 fprintf (stderr
, "font selection order: ");
6339 for (i
= 0; i
< ARRAYELTS (font_sort_order
); ++i
)
6340 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6341 fprintf (stderr
, "\n");
6343 fprintf (stderr
, "alternative fonts: ");
6344 debug_print (Vface_alternative_font_family_alist
);
6345 fprintf (stderr
, "\n");
6347 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6348 Fdump_face (make_number (i
));
6354 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6356 error ("Not a valid face");
6357 dump_realized_face (face
);
6364 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6365 0, 0, 0, doc
: /* */)
6368 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6369 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6370 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6374 #endif /* GLYPH_DEBUG */
6378 /***********************************************************************
6380 ***********************************************************************/
6383 syms_of_xfaces (void)
6385 DEFSYM (Qface
, "face");
6386 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6387 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6388 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6390 /* Lisp face attribute keywords. */
6391 DEFSYM (QCfamily
, ":family");
6392 DEFSYM (QCheight
, ":height");
6393 DEFSYM (QCweight
, ":weight");
6394 DEFSYM (QCslant
, ":slant");
6395 DEFSYM (QCunderline
, ":underline");
6396 DEFSYM (QCinverse_video
, ":inverse-video");
6397 DEFSYM (QCreverse_video
, ":reverse-video");
6398 DEFSYM (QCforeground
, ":foreground");
6399 DEFSYM (QCbackground
, ":background");
6400 DEFSYM (QCstipple
, ":stipple");
6401 DEFSYM (QCwidth
, ":width");
6402 DEFSYM (QCfont
, ":font");
6403 DEFSYM (QCfontset
, ":fontset");
6404 DEFSYM (QCdistant_foreground
, ":distant-foreground");
6405 DEFSYM (QCbold
, ":bold");
6406 DEFSYM (QCitalic
, ":italic");
6407 DEFSYM (QCoverline
, ":overline");
6408 DEFSYM (QCstrike_through
, ":strike-through");
6409 DEFSYM (QCbox
, ":box");
6410 DEFSYM (QCinherit
, ":inherit");
6412 /* Symbols used for Lisp face attribute values. */
6413 DEFSYM (QCcolor
, ":color");
6414 DEFSYM (QCline_width
, ":line-width");
6415 DEFSYM (QCstyle
, ":style");
6416 DEFSYM (Qline
, "line");
6417 DEFSYM (Qwave
, "wave");
6418 DEFSYM (Qreleased_button
, "released-button");
6419 DEFSYM (Qpressed_button
, "pressed-button");
6420 DEFSYM (Qnormal
, "normal");
6421 DEFSYM (Qextra_light
, "extra-light");
6422 DEFSYM (Qlight
, "light");
6423 DEFSYM (Qsemi_light
, "semi-light");
6424 DEFSYM (Qsemi_bold
, "semi-bold");
6425 DEFSYM (Qbold
, "bold");
6426 DEFSYM (Qextra_bold
, "extra-bold");
6427 DEFSYM (Qultra_bold
, "ultra-bold");
6428 DEFSYM (Qoblique
, "oblique");
6429 DEFSYM (Qitalic
, "italic");
6430 DEFSYM (Qbackground_color
, "background-color");
6431 DEFSYM (Qforeground_color
, "foreground-color");
6432 DEFSYM (Qunspecified
, "unspecified");
6433 DEFSYM (QCignore_defface
, ":ignore-defface");
6435 DEFSYM (Qface_alias
, "face-alias");
6436 DEFSYM (Qdefault
, "default");
6437 DEFSYM (Qtool_bar
, "tool-bar");
6438 DEFSYM (Qregion
, "region");
6439 DEFSYM (Qfringe
, "fringe");
6440 DEFSYM (Qheader_line
, "header-line");
6441 DEFSYM (Qscroll_bar
, "scroll-bar");
6442 DEFSYM (Qmenu
, "menu");
6443 DEFSYM (Qcursor
, "cursor");
6444 DEFSYM (Qborder
, "border");
6445 DEFSYM (Qmouse
, "mouse");
6446 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6447 DEFSYM (Qvertical_border
, "vertical-border");
6448 DEFSYM (Qwindow_divider
, "window-divider");
6449 DEFSYM (Qwindow_divider_first_pixel
, "window-divider-first-pixel");
6450 DEFSYM (Qwindow_divider_last_pixel
, "window-divider-last-pixel");
6451 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6452 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6453 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6454 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6455 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6457 Vparam_value_alist
= list1 (Fcons (Qnil
, Qnil
));
6458 staticpro (&Vparam_value_alist
);
6459 Vface_alternative_font_family_alist
= Qnil
;
6460 staticpro (&Vface_alternative_font_family_alist
);
6461 Vface_alternative_font_registry_alist
= Qnil
;
6462 staticpro (&Vface_alternative_font_registry_alist
);
6464 defsubr (&Sinternal_make_lisp_face
);
6465 defsubr (&Sinternal_lisp_face_p
);
6466 defsubr (&Sinternal_set_lisp_face_attribute
);
6467 #ifdef HAVE_WINDOW_SYSTEM
6468 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6470 defsubr (&Scolor_gray_p
);
6471 defsubr (&Scolor_supported_p
);
6472 #ifndef HAVE_X_WINDOWS
6473 defsubr (&Sx_load_color_file
);
6475 defsubr (&Sface_attribute_relative_p
);
6476 defsubr (&Smerge_face_attribute
);
6477 defsubr (&Sinternal_get_lisp_face_attribute
);
6478 defsubr (&Sinternal_lisp_face_attribute_values
);
6479 defsubr (&Sinternal_lisp_face_equal_p
);
6480 defsubr (&Sinternal_lisp_face_empty_p
);
6481 defsubr (&Sinternal_copy_lisp_face
);
6482 defsubr (&Sinternal_merge_in_global_face
);
6483 defsubr (&Sface_font
);
6484 defsubr (&Sframe_face_alist
);
6485 defsubr (&Sdisplay_supports_face_attributes_p
);
6486 defsubr (&Scolor_distance
);
6487 defsubr (&Sinternal_set_font_selection_order
);
6488 defsubr (&Sinternal_set_alternative_font_family_alist
);
6489 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6490 defsubr (&Sface_attributes_as_vector
);
6492 defsubr (&Sdump_face
);
6493 defsubr (&Sshow_face_resources
);
6494 #endif /* GLYPH_DEBUG */
6495 defsubr (&Sclear_face_cache
);
6496 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6498 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6499 defsubr (&Sdump_colors
);
6502 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6503 doc
: /* List of global face definitions (for internal use only.) */);
6504 Vface_new_frame_defaults
= Qnil
;
6506 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6507 doc
: /* Default stipple pattern used on monochrome displays.
6508 This stipple pattern is used on monochrome displays
6509 instead of shades of gray for a face background color.
6510 See `set-face-stipple' for possible values for this variable. */);
6511 Vface_default_stipple
= build_pure_c_string ("gray3");
6513 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6514 doc
: /* An alist of defined terminal colors and their RGB values.
6515 See the docstring of `tty-color-alist' for the details. */);
6516 Vtty_defined_color_alist
= Qnil
;
6518 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6519 doc
: /* Allowed scalable fonts.
6520 A value of nil means don't allow any scalable fonts.
6521 A value of t means allow any scalable font.
6522 Otherwise, value must be a list of regular expressions. A font may be
6523 scaled if its name matches a regular expression in the list.
6524 Note that if value is nil, a scalable font might still be used, if no
6525 other font of the appropriate family and registry is available. */);
6526 Vscalable_fonts_allowed
= Qnil
;
6528 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6529 doc
: /* List of ignored fonts.
6530 Each element is a regular expression that matches names of fonts to
6532 Vface_ignored_fonts
= Qnil
;
6534 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6535 doc
: /* Alist of face remappings.
6536 Each element is of the form:
6538 (FACE . REPLACEMENT),
6540 which causes display of the face FACE to use REPLACEMENT instead.
6541 REPLACEMENT is a face specification, i.e. one of the following:
6544 (2) a property list of attribute/value pairs, or
6545 (3) a list in which each element has the form of (1) or (2).
6547 List values for REPLACEMENT are merged to form the final face
6548 specification, with earlier entries taking precedence, in the same as
6549 as in the `face' text property.
6551 Face-name remapping cycles are suppressed; recursive references use
6552 the underlying face instead of the remapped face. So a remapping of
6555 (FACE EXTRA-FACE... FACE)
6559 (FACE (FACE-ATTR VAL ...) FACE)
6561 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6562 existing definition of FACE. Note that this isn't necessary for the
6563 default face, since every face inherits from the default face.
6565 If this variable is made buffer-local, the face remapping takes effect
6566 only in that buffer. For instance, the mode my-mode could define a
6567 face `my-mode-default', and then in the mode setup function, do:
6569 (set (make-local-variable 'face-remapping-alist)
6570 '((default my-mode-default)))).
6572 Because Emacs normally only redraws screen areas when the underlying
6573 buffer contents change, you may need to call `redraw-display' after
6574 changing this variable for it to take effect. */);
6575 Vface_remapping_alist
= Qnil
;
6577 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6578 doc
: /* Alist of fonts vs the rescaling factors.
6579 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6580 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6581 RESCALE-RATIO is a floating point number to specify how much larger
6582 \(or smaller) font we should use. For instance, if a face requests
6583 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6584 Vface_font_rescale_alist
= Qnil
;
6586 #ifdef HAVE_WINDOW_SYSTEM
6587 defsubr (&Sbitmap_spec_p
);
6588 defsubr (&Sx_list_fonts
);
6589 defsubr (&Sinternal_face_x_get_resource
);
6590 defsubr (&Sx_family_fonts
);