1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2012 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 form of a struct face which is stored in the
116 face cache of the frame on which it was realized.
118 Face realization is done in the context of the character to display
119 because different fonts may be used for different characters. In
120 other words, for characters that have different font
121 specifications, different realized faces are needed to display
124 Font specification is done by fontsets. See the comment in
125 fontset.c for the details. In the current implementation, all ASCII
126 characters share the same font in a fontset.
128 Faces are at first realized for ASCII characters, and, at that
129 time, assigned a specific realized fontset. Hereafter, we call
130 such a face as `ASCII face'. When a face for a multibyte character
131 is realized, it inherits (thus shares) a fontset of an ASCII face
132 that has the same attributes other than font-related ones.
134 Thus, all realized faces have a realized fontset.
139 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
140 font as ASCII characters. That is because it is expected that
141 unibyte text users specify a font that is suitable both for ASCII
142 and raw 8-bit characters.
147 Font selection tries to find the best available matching font for a
148 given (character, face) combination.
150 If the face specifies a fontset name, that fontset determines a
151 pattern for fonts of the given character. If the face specifies a
152 font name or the other font-related attributes, a fontset is
153 realized from the default fontset. In that case, that
154 specification determines a pattern for ASCII characters and the
155 default fontset determines a pattern for multibyte characters.
157 Available fonts on the system on which Emacs runs are then matched
158 against the font pattern. The result of font selection is the best
159 match for the given face attributes in this font list.
161 Font selection can be influenced by the user.
163 1. The user can specify the relative importance he gives the face
164 attributes width, height, weight, and slant by setting
165 face-font-selection-order (faces.el) to a list of face attribute
166 names. The default is '(:width :height :weight :slant), and means
167 that font selection first tries to find a good match for the font
168 width specified by a face, then---within fonts with that
169 width---tries to find a best match for the specified font height,
172 2. Setting face-font-family-alternatives allows the user to
173 specify alternative font families to try if a family specified by a
176 3. Setting face-font-registry-alternatives allows the user to
177 specify all alternative font registries to try for a face
178 specifying a registry.
180 4. Setting face-ignored-fonts allows the user to ignore specific
184 Character composition.
186 Usually, the realization process is already finished when Emacs
187 actually reflects the desired glyph matrix on the screen. However,
188 on displaying a composition (sequence of characters to be composed
189 on the screen), a suitable font for the components of the
190 composition is selected and realized while drawing them on the
191 screen, i.e. the realization process is delayed but in principle
195 Initialization of basic faces.
197 The faces `default', `modeline' are considered `basic faces'.
198 When redisplay happens the first time for a newly created frame,
199 basic faces are realized for CHARSET_ASCII. Frame parameters are
200 used to fill in unspecified attributes of the default face. */
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h> /* This needs to be before termchar.h */
210 #include "character.h"
212 #include "keyboard.h"
214 #include "termhooks.h"
216 #ifdef HAVE_X_WINDOWS
220 #include <Xm/XmStrDefs.h>
221 #endif /* USE_MOTIF */
222 #endif /* HAVE_X_WINDOWS */
231 /* Redefine X specifics to W32 equivalents to avoid cluttering the
232 code with #ifdef blocks. */
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
252 #include "dispextern.h"
253 #include "blockinput.h"
255 #include "intervals.h"
256 #include "termchar.h"
259 #ifdef HAVE_WINDOW_SYSTEM
261 #endif /* HAVE_WINDOW_SYSTEM */
263 #ifdef HAVE_X_WINDOWS
265 /* Compensate for a bug in Xos.h on some systems, on which it requires
266 time.h. On some such systems, Xos.h tries to redefine struct
267 timeval and struct timezone if USG is #defined while it is
270 #ifdef XOS_NEEDS_TIME_H
276 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
278 #else /* not XOS_NEEDS_TIME_H */
280 #endif /* not XOS_NEEDS_TIME_H */
282 #endif /* HAVE_X_WINDOWS */
286 /* Number of pt per inch (from the TeXbook). */
288 #define PT_PER_INCH 72.27
290 /* Non-zero if face attribute ATTR is unspecified. */
292 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
294 /* Non-zero if face attribute ATTR is `ignore-defface'. */
296 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
298 /* Value is the number of elements of VECTOR. */
300 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
302 /* Size of hash table of realized faces in face caches (should be a
305 #define FACE_CACHE_BUCKETS_SIZE 1001
307 /* Keyword symbols used for face attribute names. */
309 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
310 static Lisp_Object QCunderline
;
311 static Lisp_Object QCinverse_video
, QCstipple
;
312 Lisp_Object QCforeground
, QCbackground
;
314 static Lisp_Object QCfont
, QCbold
, QCitalic
;
315 static Lisp_Object QCreverse_video
;
316 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
317 static Lisp_Object QCfontset
;
319 /* Symbols used for attribute values. */
323 static Lisp_Object Qline
, Qwave
;
324 static Lisp_Object Qultra_light
, Qextra_light
, Qlight
;
325 static Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
326 static Lisp_Object Qoblique
, Qreverse_oblique
, Qreverse_italic
;
328 static Lisp_Object Qultra_condensed
, Qextra_condensed
;
329 Lisp_Object Qcondensed
;
330 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qextra_expanded
;
331 Lisp_Object Qexpanded
;
332 static Lisp_Object Qultra_expanded
;
333 static Lisp_Object Qreleased_button
, Qpressed_button
;
334 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
335 Lisp_Object Qunspecified
; /* used in dosfns.c */
336 static Lisp_Object QCignore_defface
;
338 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
340 /* The name of the function to call when the background of the frame
341 has changed, frame_set_background_mode. */
343 static Lisp_Object Qframe_set_background_mode
;
345 /* Names of basic faces. */
347 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
348 static Lisp_Object Qregion
;
349 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
350 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
351 Lisp_Object Qmode_line_inactive
;
352 static Lisp_Object Qvertical_border
;
354 /* The symbol `face-alias'. A symbols having that property is an
355 alias for another face. Value of the property is the name of
358 static Lisp_Object Qface_alias
;
360 /* Alist of alternative font families. Each element is of the form
361 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
362 try FAMILY1, then FAMILY2, ... */
364 Lisp_Object Vface_alternative_font_family_alist
;
366 /* Alist of alternative font registries. Each element is of the form
367 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
368 loaded, try REGISTRY1, then REGISTRY2, ... */
370 Lisp_Object Vface_alternative_font_registry_alist
;
372 /* Allowed scalable fonts. A value of nil means don't allow any
373 scalable fonts. A value of t means allow the use of any scalable
374 font. Otherwise, value must be a list of regular expressions. A
375 font may be scaled if its name matches a regular expression in the
378 static Lisp_Object Qscalable_fonts_allowed
;
380 #define DEFAULT_FONT_LIST_LIMIT 100
382 /* The symbols `foreground-color' and `background-color' which can be
383 used as part of a `face' property. This is for compatibility with
386 Lisp_Object Qforeground_color
, Qbackground_color
;
388 /* The symbols `face' and `mouse-face' used as text properties. */
392 /* Property for basic faces which other faces cannot inherit. */
394 static Lisp_Object Qface_no_inherit
;
396 /* Error symbol for wrong_type_argument in load_pixmap. */
398 static Lisp_Object Qbitmap_spec_p
;
400 /* The next ID to assign to Lisp faces. */
402 static int next_lface_id
;
404 /* A vector mapping Lisp face Id's to face names. */
406 static Lisp_Object
*lface_id_to_name
;
407 static ptrdiff_t lface_id_to_name_size
;
409 /* TTY color-related functions (defined in tty-colors.el). */
411 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
413 /* The name of the function used to compute colors on TTYs. */
415 static Lisp_Object Qtty_color_alist
;
417 /* Counter for calls to clear_face_cache. If this counter reaches
418 CLEAR_FONT_TABLE_COUNT, and a frame has more than
419 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
421 static int clear_font_table_count
;
422 #define CLEAR_FONT_TABLE_COUNT 100
423 #define CLEAR_FONT_TABLE_NFONTS 10
425 /* Non-zero means face attributes have been changed since the last
426 redisplay. Used in redisplay_internal. */
428 int face_change_count
;
430 /* Non-zero means don't display bold text if a face's foreground
431 and background colors are the inverse of the default colors of the
432 display. This is a kluge to suppress `bold black' foreground text
433 which is hard to read on an LCD monitor. */
435 static int tty_suppress_bold_inverse_default_colors_p
;
437 /* A list of the form `((x . y))' used to avoid consing in
438 Finternal_set_lisp_face_attribute. */
440 static Lisp_Object Vparam_value_alist
;
442 /* The total number of colors currently allocated. */
445 static int ncolors_allocated
;
446 static int npixmaps_allocated
;
450 /* Non-zero means the definition of the `menu' face for new frames has
453 static int menu_face_changed_default
;
456 /* Function prototypes. */
459 struct named_merge_point
;
461 static void map_tty_color (struct frame
*, struct face
*,
462 enum lface_attribute_index
, int *);
463 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
464 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
465 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
466 int, struct named_merge_point
*);
467 static ptrdiff_t load_pixmap (struct frame
*, Lisp_Object
,
468 unsigned *, unsigned *);
469 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
470 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
471 static void free_face_colors (struct frame
*, struct face
*);
472 static int face_color_gray_p (struct frame
*, const char *);
473 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
475 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
477 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
478 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
479 static int realize_basic_faces (struct frame
*);
480 static int realize_default_face (struct frame
*);
481 static void realize_named_face (struct frame
*, Lisp_Object
, int);
482 static int lface_fully_specified_p (Lisp_Object
*);
483 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
484 static unsigned hash_string_case_insensitive (Lisp_Object
);
485 static unsigned lface_hash (Lisp_Object
*);
486 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
487 static struct face_cache
*make_face_cache (struct frame
*);
488 static void clear_face_gcs (struct face_cache
*);
489 static void free_face_cache (struct face_cache
*);
490 static int face_fontset (Lisp_Object
*);
491 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
492 struct named_merge_point
*);
493 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
494 int, struct named_merge_point
*);
495 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
497 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
498 static struct face
*make_realized_face (Lisp_Object
*);
499 static void cache_face (struct face_cache
*, struct face
*, unsigned);
500 static void uncache_face (struct face_cache
*, struct face
*);
502 #ifdef HAVE_WINDOW_SYSTEM
504 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
505 static void x_free_gc (struct frame
*, GC
);
508 static void x_update_menu_appearance (struct frame
*);
510 extern void free_frame_menubar (struct frame
*);
511 #endif /* USE_X_TOOLKIT */
513 #endif /* HAVE_WINDOW_SYSTEM */
516 /***********************************************************************
518 ***********************************************************************/
520 #ifdef HAVE_X_WINDOWS
522 #ifdef DEBUG_X_COLORS
524 /* The following is a poor mans infrastructure for debugging X color
525 allocation problems on displays with PseudoColor-8. Some X servers
526 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
527 color reference counts completely so that they don't signal an
528 error when a color is freed whose reference count is already 0.
529 Other X servers do. To help me debug this, the following code
530 implements a simple reference counting schema of its own, for a
531 single display/screen. --gerd. */
533 /* Reference counts for pixel colors. */
535 int color_count
[256];
537 /* Register color PIXEL as allocated. */
540 register_color (unsigned long pixel
)
542 eassert (pixel
< 256);
543 ++color_count
[pixel
];
547 /* Register color PIXEL as deallocated. */
550 unregister_color (unsigned long pixel
)
552 eassert (pixel
< 256);
553 if (color_count
[pixel
] > 0)
554 --color_count
[pixel
];
560 /* Register N colors from PIXELS as deallocated. */
563 unregister_colors (unsigned long *pixels
, int n
)
566 for (i
= 0; i
< n
; ++i
)
567 unregister_color (pixels
[i
]);
571 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
572 doc
: /* Dump currently allocated colors to stderr. */)
577 fputc ('\n', stderr
);
579 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
582 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
585 fputc ('\n', stderr
);
587 fputc ('\t', stderr
);
591 fputc ('\n', stderr
);
595 #endif /* DEBUG_X_COLORS */
598 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
599 color values. Interrupt input must be blocked when this function
603 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
605 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
607 /* If display has an immutable color map, freeing colors is not
608 necessary and some servers don't allow it. So don't do it. */
609 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
611 #ifdef DEBUG_X_COLORS
612 unregister_colors (pixels
, npixels
);
614 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
622 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
623 color values. Interrupt input must be blocked when this function
627 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
628 long unsigned int *pixels
, int npixels
)
630 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
631 int class = dpyinfo
->visual
->class;
633 /* If display has an immutable color map, freeing colors is not
634 necessary and some servers don't allow it. So don't do it. */
635 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
637 #ifdef DEBUG_X_COLORS
638 unregister_colors (pixels
, npixels
);
640 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
643 #endif /* USE_X_TOOLKIT */
645 /* Create and return a GC for use on frame F. GC values and mask
646 are given by XGCV and MASK. */
649 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
653 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
660 /* Free GC which was used on frame F. */
663 x_free_gc (struct frame
*f
, GC gc
)
665 eassert (interrupt_input_blocked
);
666 IF_DEBUG (eassert (--ngcs
>= 0));
667 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
670 #endif /* HAVE_X_WINDOWS */
673 /* W32 emulation of GCs */
676 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
680 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
687 /* Free GC which was used on frame F. */
690 x_free_gc (struct frame
*f
, GC gc
)
692 IF_DEBUG (eassert (--ngcs
>= 0));
696 #endif /* WINDOWSNT */
699 /* NS emulation of GCs */
702 x_create_gc (struct frame
*f
,
706 GC gc
= xmalloc (sizeof *gc
);
707 memcpy (gc
, xgcv
, sizeof (XGCValues
));
712 x_free_gc (struct frame
*f
, GC gc
)
718 /* If FRAME is nil, return a pointer to the selected frame.
719 Otherwise, check that FRAME is a live frame, and return a pointer
720 to it. NPARAM is the parameter number of FRAME, for
721 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
722 Lisp function definitions. */
724 static inline struct frame
*
725 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
728 frame
= selected_frame
;
730 CHECK_LIVE_FRAME (frame
);
731 return XFRAME (frame
);
735 /***********************************************************************
737 ***********************************************************************/
739 /* Initialize face cache and basic faces for frame F. */
742 init_frame_faces (struct frame
*f
)
744 /* Make a face cache, if F doesn't have one. */
745 if (FRAME_FACE_CACHE (f
) == NULL
)
746 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
748 #ifdef HAVE_WINDOW_SYSTEM
749 /* Make the image cache. */
750 if (FRAME_WINDOW_P (f
))
752 /* We initialize the image cache when creating the first frame
753 on a terminal, and not during terminal creation. This way,
754 `x-open-connection' on a tty won't create an image cache. */
755 if (FRAME_IMAGE_CACHE (f
) == NULL
)
756 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
757 ++FRAME_IMAGE_CACHE (f
)->refcount
;
759 #endif /* HAVE_WINDOW_SYSTEM */
761 /* Realize basic faces. Must have enough information in frame
762 parameters to realize basic faces at this point. */
763 #ifdef HAVE_X_WINDOWS
764 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
767 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
770 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
772 if (!realize_basic_faces (f
))
777 /* Free face cache of frame F. Called from delete_frame. */
780 free_frame_faces (struct frame
*f
)
782 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
786 free_face_cache (face_cache
);
787 FRAME_FACE_CACHE (f
) = NULL
;
790 #ifdef HAVE_WINDOW_SYSTEM
791 if (FRAME_WINDOW_P (f
))
793 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
796 --image_cache
->refcount
;
797 if (image_cache
->refcount
== 0)
798 free_image_cache (f
);
801 #endif /* HAVE_WINDOW_SYSTEM */
805 /* Clear face caches, and recompute basic faces for frame F. Call
806 this after changing frame parameters on which those faces depend,
807 or when realized faces have been freed due to changing attributes
811 recompute_basic_faces (struct frame
*f
)
813 if (FRAME_FACE_CACHE (f
))
815 clear_face_cache (0);
816 if (!realize_basic_faces (f
))
822 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
823 try to free unused fonts, too. */
826 clear_face_cache (int clear_fonts_p
)
828 #ifdef HAVE_WINDOW_SYSTEM
829 Lisp_Object tail
, frame
;
832 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
835 /* Not yet implemented. */
836 clear_font_cache (frame
);
839 /* From time to time see if we can unload some fonts. This also
840 frees all realized faces on all frames. Fonts needed by
841 faces will be loaded again when faces are realized again. */
842 clear_font_table_count
= 0;
844 FOR_EACH_FRAME (tail
, frame
)
846 struct frame
*f
= XFRAME (frame
);
847 if (FRAME_WINDOW_P (f
)
848 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
849 free_all_realized_faces (frame
);
854 /* Clear GCs of realized faces. */
855 FOR_EACH_FRAME (tail
, frame
)
857 struct frame
*f
= XFRAME (frame
);
858 if (FRAME_WINDOW_P (f
))
859 clear_face_gcs (FRAME_FACE_CACHE (f
));
861 clear_image_caches (Qnil
);
863 #endif /* HAVE_WINDOW_SYSTEM */
867 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
868 doc
: /* Clear face caches on all frames.
869 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
870 (Lisp_Object thoroughly
)
872 clear_face_cache (!NILP (thoroughly
));
874 ++windows_or_buffers_changed
;
879 /***********************************************************************
881 ***********************************************************************/
883 #ifdef HAVE_WINDOW_SYSTEM
885 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
886 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
887 A bitmap specification is either a string, a file name, or a list
888 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
889 HEIGHT is its height, and DATA is a string containing the bits of
890 the pixmap. Bits are stored row by row, each row occupies
891 \(WIDTH + 7)/8 bytes. */)
896 if (STRINGP (object
))
897 /* If OBJECT is a string, it's a file name. */
899 else if (CONSP (object
))
901 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
902 HEIGHT must be ints > 0, and DATA must be string large
903 enough to hold a bitmap of the specified size. */
904 Lisp_Object width
, height
, data
;
906 height
= width
= data
= Qnil
;
910 width
= XCAR (object
);
911 object
= XCDR (object
);
914 height
= XCAR (object
);
915 object
= XCDR (object
);
917 data
= XCAR (object
);
922 && RANGED_INTEGERP (1, width
, INT_MAX
)
923 && RANGED_INTEGERP (1, height
, INT_MAX
))
925 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
927 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
932 return pixmap_p
? Qt
: Qnil
;
936 /* Load a bitmap according to NAME (which is either a file name or a
937 pixmap spec) for use on frame F. Value is the bitmap_id (see
938 xfns.c). If NAME is nil, return with a bitmap id of zero. If
939 bitmap cannot be loaded, display a message saying so, and return
940 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
941 if these pointers are not null. */
944 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
,
952 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
957 /* Decode a bitmap spec into a bitmap. */
962 w
= XINT (Fcar (name
));
963 h
= XINT (Fcar (Fcdr (name
)));
964 bits
= Fcar (Fcdr (Fcdr (name
)));
966 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
971 /* It must be a string -- a file name. */
972 bitmap_id
= x_create_bitmap_from_file (f
, name
);
978 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
989 ++npixmaps_allocated
;
992 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
995 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1001 #endif /* HAVE_WINDOW_SYSTEM */
1005 /***********************************************************************
1007 ***********************************************************************/
1009 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1010 RGB_LIST should contain (at least) 3 lisp integers.
1011 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1014 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1016 #define PARSE_RGB_LIST_FIELD(field) \
1017 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1019 color->field = XINT (XCAR (rgb_list)); \
1020 rgb_list = XCDR (rgb_list); \
1025 PARSE_RGB_LIST_FIELD (red
);
1026 PARSE_RGB_LIST_FIELD (green
);
1027 PARSE_RGB_LIST_FIELD (blue
);
1033 /* Lookup on frame F the color described by the lisp string COLOR.
1034 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1035 non-zero, then the `standard' definition of the same color is
1039 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
1042 Lisp_Object frame
, color_desc
;
1044 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1047 XSETFRAME (frame
, f
);
1049 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1050 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1054 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1057 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1059 rgb
= XCDR (XCDR (color_desc
));
1060 if (! parse_rgb_list (rgb
, tty_color
))
1063 /* Should we fill in STD_COLOR too? */
1066 /* Default STD_COLOR to the same as TTY_COLOR. */
1067 *std_color
= *tty_color
;
1069 /* Do a quick check to see if the returned descriptor is
1070 actually _exactly_ equal to COLOR, otherwise we have to
1071 lookup STD_COLOR separately. If it's impossible to lookup
1072 a standard color, we just give up and use TTY_COLOR. */
1073 if ((!STRINGP (XCAR (color_desc
))
1074 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1075 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1077 /* Look up STD_COLOR separately. */
1078 rgb
= call1 (Qtty_color_standard_values
, color
);
1079 if (! parse_rgb_list (rgb
, std_color
))
1086 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1087 /* We were called early during startup, and the colors are not
1088 yet set up in tty-defined-color-alist. Don't return a failure
1089 indication, since this produces the annoying "Unable to
1090 load color" messages in the *Messages* buffer. */
1093 /* tty-color-desc seems to have returned a bad value. */
1097 /* A version of defined_color for non-X frames. */
1100 tty_defined_color (struct frame
*f
, const char *color_name
,
1101 XColor
*color_def
, int alloc
)
1106 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1108 color_def
->blue
= 0;
1109 color_def
->green
= 0;
1112 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1114 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1116 if (strcmp (color_name
, "unspecified-fg") == 0)
1117 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1118 else if (strcmp (color_name
, "unspecified-bg") == 0)
1119 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1122 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1129 /* Decide if color named COLOR_NAME is valid for the display
1130 associated with the frame F; if so, return the rgb values in
1131 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1133 This does the right thing for any type of frame. */
1136 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1139 if (!FRAME_WINDOW_P (f
))
1140 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1141 #ifdef HAVE_X_WINDOWS
1142 else if (FRAME_X_P (f
))
1143 return x_defined_color (f
, color_name
, color_def
, alloc
);
1146 else if (FRAME_W32_P (f
))
1147 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1150 else if (FRAME_NS_P (f
))
1151 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1158 /* Given the index IDX of a tty color on frame F, return its name, a
1162 tty_color_name (struct frame
*f
, int idx
)
1164 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1167 Lisp_Object coldesc
;
1169 XSETFRAME (frame
, f
);
1170 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1172 if (!NILP (coldesc
))
1173 return XCAR (coldesc
);
1176 /* We can have an MSDOG frame under -nw for a short window of
1177 opportunity before internal_terminal_init is called. DTRT. */
1178 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1179 return msdos_stdcolor_name (idx
);
1182 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1183 return build_string (unspecified_fg
);
1184 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1185 return build_string (unspecified_bg
);
1187 return Qunspecified
;
1191 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1194 The criterion implemented here is not a terribly sophisticated one. */
1197 face_color_gray_p (struct frame
*f
, const char *color_name
)
1202 if (defined_color (f
, color_name
, &color
, 0))
1203 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1204 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1206 ((eabs (color
.red
- color
.green
)
1207 < max (color
.red
, color
.green
) / 20)
1208 && (eabs (color
.green
- color
.blue
)
1209 < max (color
.green
, color
.blue
) / 20)
1210 && (eabs (color
.blue
- color
.red
)
1211 < max (color
.blue
, color
.red
) / 20)));
1219 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1220 BACKGROUND_P non-zero means the color will be used as background
1224 face_color_supported_p (struct frame
*f
, const char *color_name
,
1230 XSETFRAME (frame
, f
);
1232 #ifdef HAVE_WINDOW_SYSTEM
1234 ? (!NILP (Fxw_display_color_p (frame
))
1235 || xstrcasecmp (color_name
, "black") == 0
1236 || xstrcasecmp (color_name
, "white") == 0
1238 && face_color_gray_p (f
, color_name
))
1239 || (!NILP (Fx_display_grayscale_p (frame
))
1240 && face_color_gray_p (f
, color_name
)))
1243 tty_defined_color (f
, color_name
, ¬_used
, 0);
1247 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1248 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1249 FRAME specifies the frame and thus the display for interpreting COLOR.
1250 If FRAME is nil or omitted, use the selected frame. */)
1251 (Lisp_Object color
, Lisp_Object frame
)
1255 CHECK_STRING (color
);
1257 frame
= selected_frame
;
1259 CHECK_FRAME (frame
);
1261 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1265 DEFUN ("color-supported-p", Fcolor_supported_p
,
1266 Scolor_supported_p
, 1, 3, 0,
1267 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1268 BACKGROUND-P non-nil means COLOR is used as a background.
1269 Otherwise, this function tells whether it can be used as a foreground.
1270 If FRAME is nil or omitted, use the selected frame.
1271 COLOR must be a valid color name. */)
1272 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1276 CHECK_STRING (color
);
1278 frame
= selected_frame
;
1280 CHECK_FRAME (frame
);
1282 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1288 /* Load color with name NAME for use by face FACE on frame F.
1289 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1290 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1291 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1292 pixel color. If color cannot be loaded, display a message, and
1293 return the foreground, background or underline color of F, but
1294 record that fact in flags of the face so that we don't try to free
1298 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1299 enum lface_attribute_index target_index
)
1303 eassert (STRINGP (name
));
1304 eassert (target_index
== LFACE_FOREGROUND_INDEX
1305 || target_index
== LFACE_BACKGROUND_INDEX
1306 || target_index
== LFACE_UNDERLINE_INDEX
1307 || target_index
== LFACE_OVERLINE_INDEX
1308 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1309 || target_index
== LFACE_BOX_INDEX
);
1311 /* if the color map is full, defined_color will return a best match
1312 to the values in an existing cell. */
1313 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1315 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1317 switch (target_index
)
1319 case LFACE_FOREGROUND_INDEX
:
1320 face
->foreground_defaulted_p
= 1;
1321 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1324 case LFACE_BACKGROUND_INDEX
:
1325 face
->background_defaulted_p
= 1;
1326 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1329 case LFACE_UNDERLINE_INDEX
:
1330 face
->underline_defaulted_p
= 1;
1331 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1334 case LFACE_OVERLINE_INDEX
:
1335 face
->overline_color_defaulted_p
= 1;
1336 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1339 case LFACE_STRIKE_THROUGH_INDEX
:
1340 face
->strike_through_color_defaulted_p
= 1;
1341 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1344 case LFACE_BOX_INDEX
:
1345 face
->box_color_defaulted_p
= 1;
1346 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1355 ++ncolors_allocated
;
1362 #ifdef HAVE_WINDOW_SYSTEM
1364 /* Load colors for face FACE which is used on frame F. Colors are
1365 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1366 of ATTRS. If the background color specified is not supported on F,
1367 try to emulate gray colors with a stipple from Vface_default_stipple. */
1370 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1374 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1375 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1377 /* Swap colors if face is inverse-video. */
1378 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1386 /* Check for support for foreground, not for background because
1387 face_color_supported_p is smart enough to know that grays are
1388 "supported" as background because we are supposed to use stipple
1390 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1391 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1393 x_destroy_bitmap (f
, face
->stipple
);
1394 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1395 &face
->pixmap_w
, &face
->pixmap_h
);
1398 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1399 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1403 /* Free color PIXEL on frame F. */
1406 unload_color (struct frame
*f
, long unsigned int pixel
)
1408 #ifdef HAVE_X_WINDOWS
1412 x_free_colors (f
, &pixel
, 1);
1419 /* Free colors allocated for FACE. */
1422 free_face_colors (struct frame
*f
, struct face
*face
)
1424 /* PENDING(NS): need to do something here? */
1425 #ifdef HAVE_X_WINDOWS
1426 if (face
->colors_copied_bitwise_p
)
1431 if (!face
->foreground_defaulted_p
)
1433 x_free_colors (f
, &face
->foreground
, 1);
1434 IF_DEBUG (--ncolors_allocated
);
1437 if (!face
->background_defaulted_p
)
1439 x_free_colors (f
, &face
->background
, 1);
1440 IF_DEBUG (--ncolors_allocated
);
1443 if (face
->underline_p
1444 && !face
->underline_defaulted_p
)
1446 x_free_colors (f
, &face
->underline_color
, 1);
1447 IF_DEBUG (--ncolors_allocated
);
1450 if (face
->overline_p
1451 && !face
->overline_color_defaulted_p
)
1453 x_free_colors (f
, &face
->overline_color
, 1);
1454 IF_DEBUG (--ncolors_allocated
);
1457 if (face
->strike_through_p
1458 && !face
->strike_through_color_defaulted_p
)
1460 x_free_colors (f
, &face
->strike_through_color
, 1);
1461 IF_DEBUG (--ncolors_allocated
);
1464 if (face
->box
!= FACE_NO_BOX
1465 && !face
->box_color_defaulted_p
)
1467 x_free_colors (f
, &face
->box_color
, 1);
1468 IF_DEBUG (--ncolors_allocated
);
1472 #endif /* HAVE_X_WINDOWS */
1475 #endif /* HAVE_WINDOW_SYSTEM */
1479 /***********************************************************************
1481 ***********************************************************************/
1483 /* An enumerator for each field of an XLFD font name. */
1504 /* An enumerator for each possible slant value of a font. Taken from
1505 the XLFD specification. */
1513 XLFD_SLANT_REVERSE_ITALIC
,
1514 XLFD_SLANT_REVERSE_OBLIQUE
,
1518 /* Relative font weight according to XLFD documentation. */
1522 XLFD_WEIGHT_UNKNOWN
,
1523 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1524 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1525 XLFD_WEIGHT_LIGHT
, /* 30 */
1526 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1527 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1528 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1529 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1530 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1531 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1534 /* Relative proportionate width. */
1538 XLFD_SWIDTH_UNKNOWN
,
1539 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1540 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1541 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1542 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1543 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1544 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1545 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1546 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1547 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1550 /* Order by which font selection chooses fonts. The default values
1551 mean `first, find a best match for the font width, then for the
1552 font height, then for weight, then for slant.' This variable can be
1553 set via set-face-font-sort-order. */
1555 static int font_sort_order
[4];
1557 #ifdef HAVE_WINDOW_SYSTEM
1559 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1562 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1564 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1565 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1568 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1570 enum font_property_index idx
= font_props_for_sorting
[i
];
1571 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1574 if (idx
<= FONT_REGISTRY_INDEX
)
1577 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1579 result
= STRINGP (val2
) ? 1 : 0;
1583 if (INTEGERP (val1
))
1584 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1585 ? XINT (val1
) > XINT (val2
)
1588 result
= INTEGERP (val2
) ? 1 : 0;
1596 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1597 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1598 If FAMILY is omitted or nil, list all families.
1599 Otherwise, FAMILY must be a string, possibly containing wildcards
1601 If FRAME is omitted or nil, use the selected frame.
1602 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1603 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1604 FAMILY is the font family name. POINT-SIZE is the size of the
1605 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1606 width, weight and slant of the font. These symbols are the same as for
1607 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1608 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1609 giving the registry and encoding of the font.
1610 The result list is sorted according to the current setting of
1611 the face font sort order. */)
1612 (Lisp_Object family
, Lisp_Object frame
)
1614 Lisp_Object font_spec
, list
, *drivers
, vec
;
1615 ptrdiff_t i
, nfonts
;
1621 frame
= selected_frame
;
1622 CHECK_LIVE_FRAME (frame
);
1624 font_spec
= Ffont_spec (0, NULL
);
1627 CHECK_STRING (family
);
1628 font_parse_family_registry (family
, Qnil
, font_spec
);
1631 list
= font_list_entities (frame
, font_spec
);
1635 /* Sort the font entities. */
1636 for (i
= 0; i
< 4; i
++)
1637 switch (font_sort_order
[i
])
1640 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1641 case XLFD_POINT_SIZE
:
1642 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1644 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1646 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1648 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1649 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1650 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1651 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1653 ndrivers
= XINT (Flength (list
));
1654 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1655 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1656 drivers
[i
] = XCAR (list
);
1657 vec
= Fvconcat (ndrivers
, drivers
);
1658 nfonts
= ASIZE (vec
);
1660 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1661 compare_fonts_by_sort_order
);
1664 for (i
= nfonts
- 1; i
>= 0; --i
)
1666 Lisp_Object font
= AREF (vec
, i
);
1667 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1669 Lisp_Object spacing
;
1671 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1672 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1673 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1674 XFRAME (frame
)->resy
);
1675 ASET (v
, 2, make_number (point
));
1676 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1677 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1678 spacing
= Ffont_get (font
, QCspacing
);
1679 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1680 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1681 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1683 result
= Fcons (v
, result
);
1690 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1691 doc
: /* Return a list of the names of available fonts matching PATTERN.
1692 If optional arguments FACE and FRAME are specified, return only fonts
1693 the same size as FACE on FRAME.
1695 PATTERN should be a string containing a font name in the XLFD,
1696 Fontconfig, or GTK format. A font name given in the XLFD format may
1697 contain wildcard characters:
1698 the * character matches any substring, and
1699 the ? character matches any single character.
1700 PATTERN is case-insensitive.
1702 The return value is a list of strings, suitable as arguments to
1705 Fonts Emacs can't use may or may not be excluded
1706 even if they match PATTERN and FACE.
1707 The optional fourth argument MAXIMUM sets a limit on how many
1708 fonts to match. The first MAXIMUM fonts are reported.
1709 The optional fifth argument WIDTH, if specified, is a number of columns
1710 occupied by a character of a font. In that case, return only fonts
1711 the WIDTH times as wide as FACE on FRAME. */)
1712 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1713 Lisp_Object maximum
, Lisp_Object width
)
1716 int size
, avgwidth
IF_LINT (= 0);
1719 CHECK_STRING (pattern
);
1721 if (! NILP (maximum
))
1722 CHECK_NATNUM (maximum
);
1725 CHECK_NUMBER (width
);
1727 /* We can't simply call check_x_frame because this function may be
1728 called before any frame is created. */
1730 frame
= selected_frame
;
1731 f
= frame_or_selected_frame (frame
, 2);
1732 if (! FRAME_WINDOW_P (f
))
1734 /* Perhaps we have not yet created any frame. */
1740 /* Determine the width standard for comparison with the fonts we find. */
1746 /* This is of limited utility since it works with character
1747 widths. Keep it for compatibility. --gerd. */
1748 int face_id
= lookup_named_face (f
, face
, 0);
1749 struct face
*width_face
= (face_id
< 0
1751 : FACE_FROM_ID (f
, face_id
));
1753 if (width_face
&& width_face
->font
)
1755 size
= width_face
->font
->pixel_size
;
1756 avgwidth
= width_face
->font
->average_width
;
1760 size
= FRAME_FONT (f
)->pixel_size
;
1761 avgwidth
= FRAME_FONT (f
)->average_width
;
1764 avgwidth
*= XINT (width
);
1768 Lisp_Object font_spec
;
1769 Lisp_Object args
[2], tail
;
1771 font_spec
= font_spec_from_name (pattern
);
1772 if (!FONTP (font_spec
))
1773 signal_error ("Invalid font name", pattern
);
1777 Ffont_put (font_spec
, QCsize
, make_number (size
));
1778 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1780 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1781 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1783 Lisp_Object font_entity
;
1785 font_entity
= XCAR (tail
);
1786 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1787 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1788 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1790 /* This is a scalable font. For backward compatibility,
1791 we set the specified size. */
1792 font_entity
= copy_font_spec (font_entity
);
1793 ASET (font_entity
, FONT_SIZE_INDEX
,
1794 AREF (font_spec
, FONT_SIZE_INDEX
));
1796 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1799 /* We don't have to check fontsets. */
1801 args
[1] = list_fontsets (f
, pattern
, size
);
1802 return Fnconc (2, args
);
1806 #endif /* HAVE_WINDOW_SYSTEM */
1809 /***********************************************************************
1811 ***********************************************************************/
1813 /* Access face attributes of face LFACE, a Lisp vector. */
1815 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1816 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1817 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1818 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1819 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1820 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1821 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1822 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1823 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1824 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1825 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1826 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1827 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1828 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1829 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1830 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1831 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1833 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1834 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1836 #define LFACEP(LFACE) \
1838 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1839 && EQ (AREF (LFACE, 0), Qface))
1844 /* Check consistency of Lisp face attribute vector ATTRS. */
1847 check_lface_attrs (Lisp_Object
*attrs
)
1849 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1850 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1851 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1852 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1853 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1854 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1855 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1856 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1857 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1858 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1859 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1860 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1861 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1862 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1863 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1864 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1865 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1866 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1867 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1868 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1869 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1870 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1871 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1872 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1873 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1874 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1875 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1876 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1877 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1878 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1879 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1880 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1881 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1882 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1883 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1884 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1885 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1886 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1887 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1888 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1889 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1890 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1891 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1892 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1893 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1894 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1895 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1896 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1897 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1898 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1899 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1900 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1901 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1902 #ifdef HAVE_WINDOW_SYSTEM
1903 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1904 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1905 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1906 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1907 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1908 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1909 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1910 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1911 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1912 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1917 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1920 check_lface (Lisp_Object lface
)
1924 eassert (LFACEP (lface
));
1925 check_lface_attrs (XVECTOR (lface
)->contents
);
1929 #else /* not GLYPH_DEBUG */
1931 #define check_lface_attrs(attrs) (void) 0
1932 #define check_lface(lface) (void) 0
1934 #endif /* GLYPH_DEBUG */
1938 /* Face-merge cycle checking. */
1940 enum named_merge_point_kind
1942 NAMED_MERGE_POINT_NORMAL
,
1943 NAMED_MERGE_POINT_REMAP
1946 /* A `named merge point' is simply a point during face-merging where we
1947 look up a face by name. We keep a stack of which named lookups we're
1948 currently processing so that we can easily detect cycles, using a
1949 linked- list of struct named_merge_point structures, typically
1950 allocated on the stack frame of the named lookup functions which are
1951 active (so no consing is required). */
1952 struct named_merge_point
1954 Lisp_Object face_name
;
1955 enum named_merge_point_kind named_merge_point_kind
;
1956 struct named_merge_point
*prev
;
1960 /* If a face merging cycle is detected for FACE_NAME, return 0,
1961 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1962 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1963 pointed to by NAMED_MERGE_POINTS, and return 1. */
1966 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1967 Lisp_Object face_name
,
1968 enum named_merge_point_kind named_merge_point_kind
,
1969 struct named_merge_point
**named_merge_points
)
1971 struct named_merge_point
*prev
;
1973 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1974 if (EQ (face_name
, prev
->face_name
))
1976 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1977 /* A cycle, so fail. */
1979 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1980 /* A remap `hides ' any previous normal merge points
1981 (because the remap means that it's actually different face),
1982 so as we know the current merge point must be normal, we
1983 can just assume it's OK. */
1987 new_named_merge_point
->face_name
= face_name
;
1988 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1989 new_named_merge_point
->prev
= *named_merge_points
;
1991 *named_merge_points
= new_named_merge_point
;
1997 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1998 to make it a symbol. If FACE_NAME is an alias for another face,
1999 return that face's name.
2001 Return default face in case of errors. */
2004 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2006 Lisp_Object orig_face
;
2007 Lisp_Object tortoise
, hare
;
2009 if (STRINGP (face_name
))
2010 face_name
= intern (SSDATA (face_name
));
2012 if (NILP (face_name
) || !SYMBOLP (face_name
))
2015 orig_face
= face_name
;
2016 tortoise
= hare
= face_name
;
2021 hare
= Fget (hare
, Qface_alias
);
2022 if (NILP (hare
) || !SYMBOLP (hare
))
2026 hare
= Fget (hare
, Qface_alias
);
2027 if (NILP (hare
) || !SYMBOLP (hare
))
2030 tortoise
= Fget (tortoise
, Qface_alias
);
2031 if (EQ (hare
, tortoise
))
2034 xsignal1 (Qcircular_list
, orig_face
);
2043 /* Return the face definition of FACE_NAME on frame F. F null means
2044 return the definition for new frames. FACE_NAME may be a string or
2045 a symbol (apparently Emacs 20.2 allowed strings as face names in
2046 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2047 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2048 is zero, value is nil if FACE_NAME is not a valid face name. */
2049 static inline Lisp_Object
2050 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
2056 lface
= assq_no_quit (face_name
, f
->face_alist
);
2058 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2061 lface
= XCDR (lface
);
2063 signal_error ("Invalid face", face_name
);
2065 check_lface (lface
);
2070 /* Return the face definition of FACE_NAME on frame F. F null means
2071 return the definition for new frames. FACE_NAME may be a string or
2072 a symbol (apparently Emacs 20.2 allowed strings as face names in
2073 face text properties; Ediff uses that). If FACE_NAME is an alias
2074 for another face, return that face's definition. If SIGNAL_P is
2075 non-zero, signal an error if FACE_NAME is not a valid face name.
2076 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2078 static inline Lisp_Object
2079 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2081 face_name
= resolve_face_name (face_name
, signal_p
);
2082 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2086 /* Get face attributes of face FACE_NAME from frame-local faces on
2087 frame F. Store the resulting attributes in ATTRS which must point
2088 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2089 is non-zero, signal an error if FACE_NAME does not name a face.
2090 Otherwise, value is zero if FACE_NAME is not a face. */
2093 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
2094 Lisp_Object
*attrs
, int signal_p
)
2098 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2101 memcpy (attrs
, XVECTOR (lface
)->contents
,
2102 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2104 return !NILP (lface
);
2107 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2108 F. Store the resulting attributes in ATTRS which must point to a
2109 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2110 alias for another face, use that face's definition. If SIGNAL_P is
2111 non-zero, signal an error if FACE_NAME does not name a face.
2112 Otherwise, value is zero if FACE_NAME is not a face. */
2115 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2116 Lisp_Object
*attrs
, int signal_p
,
2117 struct named_merge_point
*named_merge_points
)
2119 Lisp_Object face_remapping
;
2121 face_name
= resolve_face_name (face_name
, signal_p
);
2123 /* See if SYMBOL has been remapped to some other face (usually this
2124 is done buffer-locally). */
2125 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2126 if (CONSP (face_remapping
))
2128 struct named_merge_point named_merge_point
;
2130 if (push_named_merge_point (&named_merge_point
,
2131 face_name
, NAMED_MERGE_POINT_REMAP
,
2132 &named_merge_points
))
2136 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2137 attrs
[i
] = Qunspecified
;
2139 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2140 signal_p
, named_merge_points
);
2144 /* Default case, no remapping. */
2145 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2149 /* Non-zero if all attributes in face attribute vector ATTRS are
2150 specified, i.e. are non-nil. */
2153 lface_fully_specified_p (Lisp_Object
*attrs
)
2157 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2158 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2159 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2162 return i
== LFACE_VECTOR_SIZE
;
2165 #ifdef HAVE_WINDOW_SYSTEM
2167 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2168 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2169 exception is `font' attribute. It is set to FONT_OBJECT regardless
2173 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2174 Lisp_Object font_object
, int force_p
)
2177 struct font
*font
= XFONT_OBJECT (font_object
);
2179 /* Set attributes only if unspecified, otherwise face defaults for
2180 new frames would never take effect. If the font doesn't have a
2181 specific property, set a normal value for that. */
2183 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2185 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2187 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2190 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2192 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2194 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2197 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2199 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2202 LFACE_HEIGHT (lface
) = make_number (pt
);
2205 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2207 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2208 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2210 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2212 val
= FONT_SLANT_FOR_FACE (font_object
);
2213 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2215 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2217 val
= FONT_WIDTH_FOR_FACE (font_object
);
2218 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2221 LFACE_FONT (lface
) = font_object
;
2225 #endif /* HAVE_WINDOW_SYSTEM */
2228 /* Merges the face height FROM with the face height TO, and returns the
2229 merged height. If FROM is an invalid height, then INVALID is
2230 returned instead. FROM and TO may be either absolute face heights or
2231 `relative' heights; the returned value is always an absolute height
2232 unless both FROM and TO are relative. */
2235 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2237 Lisp_Object result
= invalid
;
2239 if (INTEGERP (from
))
2240 /* FROM is absolute, just use it as is. */
2242 else if (FLOATP (from
))
2243 /* FROM is a scale, use it to adjust TO. */
2246 /* relative X absolute => absolute */
2247 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2248 else if (FLOATP (to
))
2249 /* relative X relative => relative */
2250 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2251 else if (UNSPECIFIEDP (to
))
2254 else if (FUNCTIONP (from
))
2255 /* FROM is a function, which use to adjust TO. */
2257 /* Call function with current height as argument.
2258 From is the new height. */
2259 Lisp_Object args
[2];
2263 result
= safe_call (2, args
);
2265 /* Ensure that if TO was absolute, so is the result. */
2266 if (INTEGERP (to
) && !INTEGERP (result
))
2274 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2275 store the resulting attributes in TO, which must be already be
2276 completely specified and contain only absolute attributes. Every
2277 specified attribute of FROM overrides the corresponding attribute of
2278 TO; relative attributes in FROM are merged with the absolute value in
2279 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2280 loops in face inheritance/remapping; it should be 0 when called from
2284 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2285 struct named_merge_point
*named_merge_points
)
2289 /* If FROM inherits from some other faces, merge their attributes into
2290 TO before merging FROM's direct attributes. Note that an :inherit
2291 attribute of `unspecified' is the same as one of nil; we never
2292 merge :inherit attributes, so nil is more correct, but lots of
2293 other code uses `unspecified' as a generic value for face attributes. */
2294 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2295 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2296 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2298 i
= LFACE_FONT_INDEX
;
2299 if (!UNSPECIFIEDP (from
[i
]))
2301 if (!UNSPECIFIEDP (to
[i
]))
2302 to
[i
] = merge_font_spec (from
[i
], to
[i
]);
2304 to
[i
] = copy_font_spec (from
[i
]);
2305 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2306 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2307 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2308 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2309 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2310 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2311 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2312 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2313 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2314 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2315 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2318 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2319 if (!UNSPECIFIEDP (from
[i
]))
2321 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2323 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2324 font_clear_prop (to
, FONT_SIZE_INDEX
);
2326 else if (i
!= LFACE_FONT_INDEX
2327 && ! EQ (to
[i
], from
[i
]))
2330 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2331 font_clear_prop (to
,
2332 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2333 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2334 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2335 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2336 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2337 : FONT_SLANT_INDEX
));
2341 /* TO is always an absolute face, which should inherit from nothing.
2342 We blindly copy the :inherit attribute above and fix it up here. */
2343 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2346 /* Merge the named face FACE_NAME on frame F, into the vector of face
2347 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2348 inheritance. Returns true if FACE_NAME is a valid face name and
2349 merging succeeded. */
2352 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2353 struct named_merge_point
*named_merge_points
)
2355 struct named_merge_point named_merge_point
;
2357 if (push_named_merge_point (&named_merge_point
,
2358 face_name
, NAMED_MERGE_POINT_NORMAL
,
2359 &named_merge_points
))
2361 struct gcpro gcpro1
;
2362 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2363 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2367 GCPRO1 (named_merge_point
.face_name
);
2368 merge_face_vectors (f
, from
, to
, named_merge_points
);
2379 /* Merge face attributes from the lisp `face reference' FACE_REF on
2380 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2381 problems with FACE_REF cause an error message to be shown. Return
2382 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2383 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2384 list structure; it may be 0 for most callers.
2386 FACE_REF may be a single face specification or a list of such
2387 specifications. Each face specification can be:
2389 1. A symbol or string naming a Lisp face.
2391 2. A property list of the form (KEYWORD VALUE ...) where each
2392 KEYWORD is a face attribute name, and value is an appropriate value
2395 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2396 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2397 for compatibility with 20.2.
2399 Face specifications earlier in lists take precedence over later
2403 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2404 int err_msgs
, struct named_merge_point
*named_merge_points
)
2406 int ok
= 1; /* Succeed without an error? */
2408 if (CONSP (face_ref
))
2410 Lisp_Object first
= XCAR (face_ref
);
2412 if (EQ (first
, Qforeground_color
)
2413 || EQ (first
, Qbackground_color
))
2415 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2416 . COLOR). COLOR must be a string. */
2417 Lisp_Object color_name
= XCDR (face_ref
);
2418 Lisp_Object color
= first
;
2420 if (STRINGP (color_name
))
2422 if (EQ (color
, Qforeground_color
))
2423 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2425 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2430 add_to_log ("Invalid face color", color_name
, Qnil
);
2434 else if (SYMBOLP (first
)
2435 && *SDATA (SYMBOL_NAME (first
)) == ':')
2437 /* Assume this is the property list form. */
2438 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2440 Lisp_Object keyword
= XCAR (face_ref
);
2441 Lisp_Object value
= XCAR (XCDR (face_ref
));
2444 /* Specifying `unspecified' is a no-op. */
2445 if (EQ (value
, Qunspecified
))
2447 else if (EQ (keyword
, QCfamily
))
2449 if (STRINGP (value
))
2451 to
[LFACE_FAMILY_INDEX
] = value
;
2452 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2457 else if (EQ (keyword
, QCfoundry
))
2459 if (STRINGP (value
))
2461 to
[LFACE_FOUNDRY_INDEX
] = value
;
2462 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2467 else if (EQ (keyword
, QCheight
))
2469 Lisp_Object new_height
=
2470 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2472 if (! NILP (new_height
))
2474 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2475 font_clear_prop (to
, FONT_SIZE_INDEX
);
2480 else if (EQ (keyword
, QCweight
))
2482 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2484 to
[LFACE_WEIGHT_INDEX
] = value
;
2485 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2490 else if (EQ (keyword
, QCslant
))
2492 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2494 to
[LFACE_SLANT_INDEX
] = value
;
2495 font_clear_prop (to
, FONT_SLANT_INDEX
);
2500 else if (EQ (keyword
, QCunderline
))
2506 to
[LFACE_UNDERLINE_INDEX
] = value
;
2510 else if (EQ (keyword
, QCoverline
))
2515 to
[LFACE_OVERLINE_INDEX
] = value
;
2519 else if (EQ (keyword
, QCstrike_through
))
2524 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2528 else if (EQ (keyword
, QCbox
))
2531 value
= make_number (1);
2532 if (INTEGERP (value
)
2536 to
[LFACE_BOX_INDEX
] = value
;
2540 else if (EQ (keyword
, QCinverse_video
)
2541 || EQ (keyword
, QCreverse_video
))
2543 if (EQ (value
, Qt
) || NILP (value
))
2544 to
[LFACE_INVERSE_INDEX
] = value
;
2548 else if (EQ (keyword
, QCforeground
))
2550 if (STRINGP (value
))
2551 to
[LFACE_FOREGROUND_INDEX
] = value
;
2555 else if (EQ (keyword
, QCbackground
))
2557 if (STRINGP (value
))
2558 to
[LFACE_BACKGROUND_INDEX
] = value
;
2562 else if (EQ (keyword
, QCstipple
))
2564 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
2565 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2566 if (!NILP (pixmap_p
))
2567 to
[LFACE_STIPPLE_INDEX
] = value
;
2572 else if (EQ (keyword
, QCwidth
))
2574 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2576 to
[LFACE_SWIDTH_INDEX
] = value
;
2577 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2582 else if (EQ (keyword
, QCinherit
))
2584 /* This is not really very useful; it's just like a
2585 normal face reference. */
2586 if (! merge_face_ref (f
, value
, to
,
2587 err_msgs
, named_merge_points
))
2595 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2599 face_ref
= XCDR (XCDR (face_ref
));
2604 /* This is a list of face refs. Those at the beginning of the
2605 list take precedence over what follows, so we have to merge
2606 from the end backwards. */
2607 Lisp_Object next
= XCDR (face_ref
);
2610 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2612 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2618 /* FACE_REF ought to be a face name. */
2619 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2620 if (!ok
&& err_msgs
)
2621 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2628 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2629 Sinternal_make_lisp_face
, 1, 2, 0,
2630 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2631 If FACE was not known as a face before, create a new one.
2632 If optional argument FRAME is specified, make a frame-local face
2633 for that frame. Otherwise operate on the global face definition.
2634 Value is a vector of face attributes. */)
2635 (Lisp_Object face
, Lisp_Object frame
)
2637 Lisp_Object global_lface
, lface
;
2641 CHECK_SYMBOL (face
);
2642 global_lface
= lface_from_face_name (NULL
, face
, 0);
2646 CHECK_LIVE_FRAME (frame
);
2648 lface
= lface_from_face_name (f
, face
, 0);
2651 f
= NULL
, lface
= Qnil
;
2653 /* Add a global definition if there is none. */
2654 if (NILP (global_lface
))
2656 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2658 ASET (global_lface
, 0, Qface
);
2659 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2660 Vface_new_frame_defaults
);
2662 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2663 face id to Lisp face is given by the vector lface_id_to_name.
2664 The mapping from Lisp face to Lisp face id is given by the
2665 property `face' of the Lisp face name. */
2666 if (next_lface_id
== lface_id_to_name_size
)
2668 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2669 sizeof *lface_id_to_name
);
2671 lface_id_to_name
[next_lface_id
] = face
;
2672 Fput (face
, Qface
, make_number (next_lface_id
));
2676 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2677 ASET (global_lface
, i
, Qunspecified
);
2679 /* Add a frame-local definition. */
2684 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2686 ASET (lface
, 0, Qface
);
2687 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2690 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2691 ASET (lface
, i
, Qunspecified
);
2694 lface
= global_lface
;
2696 /* Changing a named face means that all realized faces depending on
2697 that face are invalid. Since we cannot tell which realized faces
2698 depend on the face, make sure they are all removed. This is done
2699 by incrementing face_change_count. The next call to
2700 init_iterator will then free realized faces. */
2701 if (NILP (Fget (face
, Qface_no_inherit
)))
2703 ++face_change_count
;
2704 ++windows_or_buffers_changed
;
2707 eassert (LFACEP (lface
));
2708 check_lface (lface
);
2713 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2714 Sinternal_lisp_face_p
, 1, 2, 0,
2715 doc
: /* Return non-nil if FACE names a face.
2716 FACE should be a symbol or string.
2717 If optional second argument FRAME is non-nil, check for the
2718 existence of a frame-local face with name FACE on that frame.
2719 Otherwise check for the existence of a global face. */)
2720 (Lisp_Object face
, Lisp_Object frame
)
2724 face
= resolve_face_name (face
, 1);
2728 CHECK_LIVE_FRAME (frame
);
2729 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2732 lface
= lface_from_face_name (NULL
, face
, 0);
2738 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2739 Sinternal_copy_lisp_face
, 4, 4, 0,
2740 doc
: /* Copy face FROM to TO.
2741 If FRAME is t, copy the global face definition of FROM.
2742 Otherwise, copy the frame-local definition of FROM on FRAME.
2743 If NEW-FRAME is a frame, copy that data into the frame-local
2744 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2745 FRAME controls where the data is copied to.
2747 The value is TO. */)
2748 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2750 Lisp_Object lface
, copy
;
2752 CHECK_SYMBOL (from
);
2757 /* Copy global definition of FROM. We don't make copies of
2758 strings etc. because 20.2 didn't do it either. */
2759 lface
= lface_from_face_name (NULL
, from
, 1);
2760 copy
= Finternal_make_lisp_face (to
, Qnil
);
2764 /* Copy frame-local definition of FROM. */
2765 if (NILP (new_frame
))
2767 CHECK_LIVE_FRAME (frame
);
2768 CHECK_LIVE_FRAME (new_frame
);
2769 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2770 copy
= Finternal_make_lisp_face (to
, new_frame
);
2773 memcpy (XVECTOR (copy
)->contents
, XVECTOR (lface
)->contents
,
2774 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2776 /* Changing a named face means that all realized faces depending on
2777 that face are invalid. Since we cannot tell which realized faces
2778 depend on the face, make sure they are all removed. This is done
2779 by incrementing face_change_count. The next call to
2780 init_iterator will then free realized faces. */
2781 if (NILP (Fget (to
, Qface_no_inherit
)))
2783 ++face_change_count
;
2784 ++windows_or_buffers_changed
;
2791 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2792 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2793 doc
: /* Set attribute ATTR of FACE to VALUE.
2794 FRAME being a frame means change the face on that frame.
2795 FRAME nil means change the face of the selected frame.
2796 FRAME t means change the default for new frames.
2797 FRAME 0 means change the face on all frames, and change the default
2799 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2802 Lisp_Object old_value
= Qnil
;
2803 /* Set one of enum font_property_index (> 0) if ATTR is one of
2804 font-related attributes other than QCfont and QCfontset. */
2805 enum font_property_index prop_index
= 0;
2807 CHECK_SYMBOL (face
);
2808 CHECK_SYMBOL (attr
);
2810 face
= resolve_face_name (face
, 1);
2812 /* If FRAME is 0, change face on all frames, and change the
2813 default for new frames. */
2814 if (INTEGERP (frame
) && XINT (frame
) == 0)
2817 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2818 FOR_EACH_FRAME (tail
, frame
)
2819 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2823 /* Set lface to the Lisp attribute vector of FACE. */
2826 lface
= lface_from_face_name (NULL
, face
, 1);
2828 /* When updating face-new-frame-defaults, we put :ignore-defface
2829 where the caller wants `unspecified'. This forces the frame
2830 defaults to ignore the defface value. Otherwise, the defface
2831 will take effect, which is generally not what is intended.
2832 The value of that attribute will be inherited from some other
2833 face during face merging. See internal_merge_in_global_face. */
2834 if (UNSPECIFIEDP (value
))
2835 value
= QCignore_defface
;
2840 frame
= selected_frame
;
2842 CHECK_LIVE_FRAME (frame
);
2843 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2845 /* If a frame-local face doesn't exist yet, create one. */
2847 lface
= Finternal_make_lisp_face (face
, frame
);
2850 if (EQ (attr
, QCfamily
))
2852 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2854 CHECK_STRING (value
);
2855 if (SCHARS (value
) == 0)
2856 signal_error ("Invalid face family", value
);
2858 old_value
= LFACE_FAMILY (lface
);
2859 LFACE_FAMILY (lface
) = value
;
2860 prop_index
= FONT_FAMILY_INDEX
;
2862 else if (EQ (attr
, QCfoundry
))
2864 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2866 CHECK_STRING (value
);
2867 if (SCHARS (value
) == 0)
2868 signal_error ("Invalid face foundry", value
);
2870 old_value
= LFACE_FOUNDRY (lface
);
2871 LFACE_FOUNDRY (lface
) = value
;
2872 prop_index
= FONT_FOUNDRY_INDEX
;
2874 else if (EQ (attr
, QCheight
))
2876 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2878 if (EQ (face
, Qdefault
))
2880 /* The default face must have an absolute size. */
2881 if (!INTEGERP (value
) || XINT (value
) <= 0)
2882 signal_error ("Default face height not absolute and positive",
2887 /* For non-default faces, do a test merge with a random
2888 height to see if VALUE's ok. */
2889 Lisp_Object test
= merge_face_heights (value
,
2892 if (!INTEGERP (test
) || XINT (test
) <= 0)
2893 signal_error ("Face height does not produce a positive integer",
2898 old_value
= LFACE_HEIGHT (lface
);
2899 LFACE_HEIGHT (lface
) = value
;
2900 prop_index
= FONT_SIZE_INDEX
;
2902 else if (EQ (attr
, QCweight
))
2904 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2906 CHECK_SYMBOL (value
);
2907 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2908 signal_error ("Invalid face weight", value
);
2910 old_value
= LFACE_WEIGHT (lface
);
2911 LFACE_WEIGHT (lface
) = value
;
2912 prop_index
= FONT_WEIGHT_INDEX
;
2914 else if (EQ (attr
, QCslant
))
2916 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2918 CHECK_SYMBOL (value
);
2919 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2920 signal_error ("Invalid face slant", value
);
2922 old_value
= LFACE_SLANT (lface
);
2923 LFACE_SLANT (lface
) = value
;
2924 prop_index
= FONT_SLANT_INDEX
;
2926 else if (EQ (attr
, QCunderline
))
2930 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2932 else if (NILP (value
) || EQ (value
, Qt
))
2934 else if (STRINGP (value
) && SCHARS (value
) > 0)
2936 else if (CONSP (value
))
2938 Lisp_Object key
, val
, list
;
2943 while (!NILP (CAR_SAFE(list
)))
2945 key
= CAR_SAFE (list
);
2946 list
= CDR_SAFE (list
);
2947 val
= CAR_SAFE (list
);
2948 list
= CDR_SAFE (list
);
2950 if (NILP (key
) || NILP (val
))
2956 else if (EQ (key
, QCcolor
)
2957 && !(EQ (val
, Qforeground_color
)
2958 || (STRINGP (val
) && SCHARS (val
) > 0)))
2964 else if (EQ (key
, QCstyle
)
2965 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2974 signal_error ("Invalid face underline", value
);
2976 old_value
= LFACE_UNDERLINE (lface
);
2977 LFACE_UNDERLINE (lface
) = value
;
2979 else if (EQ (attr
, QCoverline
))
2981 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2982 if ((SYMBOLP (value
)
2984 && !EQ (value
, Qnil
))
2985 /* Overline color. */
2987 && SCHARS (value
) == 0))
2988 signal_error ("Invalid face overline", value
);
2990 old_value
= LFACE_OVERLINE (lface
);
2991 LFACE_OVERLINE (lface
) = value
;
2993 else if (EQ (attr
, QCstrike_through
))
2995 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2996 if ((SYMBOLP (value
)
2998 && !EQ (value
, Qnil
))
2999 /* Strike-through color. */
3001 && SCHARS (value
) == 0))
3002 signal_error ("Invalid face strike-through", value
);
3004 old_value
= LFACE_STRIKE_THROUGH (lface
);
3005 LFACE_STRIKE_THROUGH (lface
) = value
;
3007 else if (EQ (attr
, QCbox
))
3011 /* Allow t meaning a simple box of width 1 in foreground color
3014 value
= make_number (1);
3016 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3018 else if (NILP (value
))
3020 else if (INTEGERP (value
))
3021 valid_p
= XINT (value
) != 0;
3022 else if (STRINGP (value
))
3023 valid_p
= SCHARS (value
) > 0;
3024 else if (CONSP (value
))
3040 if (EQ (k
, QCline_width
))
3042 if (!INTEGERP (v
) || XINT (v
) == 0)
3045 else if (EQ (k
, QCcolor
))
3047 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3050 else if (EQ (k
, QCstyle
))
3052 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3059 valid_p
= NILP (tem
);
3065 signal_error ("Invalid face box", value
);
3067 old_value
= LFACE_BOX (lface
);
3068 LFACE_BOX (lface
) = value
;
3070 else if (EQ (attr
, QCinverse_video
)
3071 || EQ (attr
, QCreverse_video
))
3073 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3075 CHECK_SYMBOL (value
);
3076 if (!EQ (value
, Qt
) && !NILP (value
))
3077 signal_error ("Invalid inverse-video face attribute value", value
);
3079 old_value
= LFACE_INVERSE (lface
);
3080 LFACE_INVERSE (lface
) = value
;
3082 else if (EQ (attr
, QCforeground
))
3084 /* Compatibility with 20.x. */
3086 value
= Qunspecified
;
3087 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3089 /* Don't check for valid color names here because it depends
3090 on the frame (display) whether the color will be valid
3091 when the face is realized. */
3092 CHECK_STRING (value
);
3093 if (SCHARS (value
) == 0)
3094 signal_error ("Empty foreground color value", value
);
3096 old_value
= LFACE_FOREGROUND (lface
);
3097 LFACE_FOREGROUND (lface
) = value
;
3099 else if (EQ (attr
, QCbackground
))
3101 /* Compatibility with 20.x. */
3103 value
= Qunspecified
;
3104 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3106 /* Don't check for valid color names here because it depends
3107 on the frame (display) whether the color will be valid
3108 when the face is realized. */
3109 CHECK_STRING (value
);
3110 if (SCHARS (value
) == 0)
3111 signal_error ("Empty background color value", value
);
3113 old_value
= LFACE_BACKGROUND (lface
);
3114 LFACE_BACKGROUND (lface
) = value
;
3116 else if (EQ (attr
, QCstipple
))
3118 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
3119 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3121 && NILP (Fbitmap_spec_p (value
)))
3122 signal_error ("Invalid stipple attribute", value
);
3123 old_value
= LFACE_STIPPLE (lface
);
3124 LFACE_STIPPLE (lface
) = value
;
3125 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3127 else if (EQ (attr
, QCwidth
))
3129 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3131 CHECK_SYMBOL (value
);
3132 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3133 signal_error ("Invalid face width", value
);
3135 old_value
= LFACE_SWIDTH (lface
);
3136 LFACE_SWIDTH (lface
) = value
;
3137 prop_index
= FONT_WIDTH_INDEX
;
3139 else if (EQ (attr
, QCfont
))
3141 #ifdef HAVE_WINDOW_SYSTEM
3142 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3144 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3148 old_value
= LFACE_FONT (lface
);
3149 if (! FONTP (value
))
3151 if (STRINGP (value
))
3153 Lisp_Object name
= value
;
3154 int fontset
= fs_query_fontset (name
, 0);
3157 name
= fontset_ascii (fontset
);
3158 value
= font_spec_from_name (name
);
3160 signal_error ("Invalid font name", name
);
3163 signal_error ("Invalid font or font-spec", value
);
3166 f
= XFRAME (selected_frame
);
3169 if (! FONT_OBJECT_P (value
))
3171 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3172 Lisp_Object font_object
;
3174 font_object
= font_load_for_lface (f
, attrs
, value
);
3175 if (NILP (font_object
))
3176 signal_error ("Font not available", value
);
3177 value
= font_object
;
3179 set_lface_from_font (f
, lface
, value
, 1);
3182 LFACE_FONT (lface
) = value
;
3184 #endif /* HAVE_WINDOW_SYSTEM */
3186 else if (EQ (attr
, QCfontset
))
3188 #ifdef HAVE_WINDOW_SYSTEM
3189 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3193 old_value
= LFACE_FONTSET (lface
);
3194 tmp
= Fquery_fontset (value
, Qnil
);
3196 signal_error ("Invalid fontset name", value
);
3197 LFACE_FONTSET (lface
) = value
= tmp
;
3199 #endif /* HAVE_WINDOW_SYSTEM */
3201 else if (EQ (attr
, QCinherit
))
3204 if (SYMBOLP (value
))
3207 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3208 if (!SYMBOLP (XCAR (tail
)))
3211 LFACE_INHERIT (lface
) = value
;
3213 signal_error ("Invalid face inheritance", value
);
3215 else if (EQ (attr
, QCbold
))
3217 old_value
= LFACE_WEIGHT (lface
);
3218 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3219 prop_index
= FONT_WEIGHT_INDEX
;
3221 else if (EQ (attr
, QCitalic
))
3224 old_value
= LFACE_SLANT (lface
);
3225 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3226 prop_index
= FONT_SLANT_INDEX
;
3229 signal_error ("Invalid face attribute name", attr
);
3233 /* If a font-related attribute other than QCfont and QCfontset
3234 is specified, and if the original QCfont attribute has a font
3235 (font-spec or font-object), set the corresponding property in
3236 the font to nil so that the font selector doesn't think that
3237 the attribute is mandatory. Also, clear the average
3239 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3242 /* Changing a named face means that all realized faces depending on
3243 that face are invalid. Since we cannot tell which realized faces
3244 depend on the face, make sure they are all removed. This is done
3245 by incrementing face_change_count. The next call to
3246 init_iterator will then free realized faces. */
3248 && NILP (Fget (face
, Qface_no_inherit
))
3249 && NILP (Fequal (old_value
, value
)))
3251 ++face_change_count
;
3252 ++windows_or_buffers_changed
;
3255 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3256 && NILP (Fequal (old_value
, value
)))
3262 if (EQ (face
, Qdefault
))
3264 #ifdef HAVE_WINDOW_SYSTEM
3265 /* Changed font-related attributes of the `default' face are
3266 reflected in changed `font' frame parameters. */
3268 && (prop_index
|| EQ (attr
, QCfont
))
3269 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3270 set_font_frame_param (frame
, lface
);
3272 #endif /* HAVE_WINDOW_SYSTEM */
3274 if (EQ (attr
, QCforeground
))
3275 param
= Qforeground_color
;
3276 else if (EQ (attr
, QCbackground
))
3277 param
= Qbackground_color
;
3279 #ifdef HAVE_WINDOW_SYSTEM
3281 else if (EQ (face
, Qscroll_bar
))
3283 /* Changing the colors of `scroll-bar' sets frame parameters
3284 `scroll-bar-foreground' and `scroll-bar-background'. */
3285 if (EQ (attr
, QCforeground
))
3286 param
= Qscroll_bar_foreground
;
3287 else if (EQ (attr
, QCbackground
))
3288 param
= Qscroll_bar_background
;
3290 #endif /* not WINDOWSNT */
3291 else if (EQ (face
, Qborder
))
3293 /* Changing background color of `border' sets frame parameter
3295 if (EQ (attr
, QCbackground
))
3296 param
= Qborder_color
;
3298 else if (EQ (face
, Qcursor
))
3300 /* Changing background color of `cursor' sets frame parameter
3302 if (EQ (attr
, QCbackground
))
3303 param
= Qcursor_color
;
3305 else if (EQ (face
, Qmouse
))
3307 /* Changing background color of `mouse' sets frame parameter
3309 if (EQ (attr
, QCbackground
))
3310 param
= Qmouse_color
;
3312 #endif /* HAVE_WINDOW_SYSTEM */
3313 else if (EQ (face
, Qmenu
))
3315 /* Indicate that we have to update the menu bar when
3316 realizing faces on FRAME. FRAME t change the
3317 default for new frames. We do this by setting
3318 setting the flag in new face caches */
3321 struct frame
*f
= XFRAME (frame
);
3322 if (FRAME_FACE_CACHE (f
) == NULL
)
3323 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3324 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3327 menu_face_changed_default
= 1;
3333 /* Update `default-frame-alist', which is used for new frames. */
3335 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3338 /* Update the current frame's parameters. */
3341 cons
= XCAR (Vparam_value_alist
);
3342 XSETCAR (cons
, param
);
3343 XSETCDR (cons
, value
);
3344 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3353 /* Update the corresponding face when frame parameter PARAM on frame F
3354 has been assigned the value NEW_VALUE. */
3357 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3358 Lisp_Object new_value
)
3360 Lisp_Object face
= Qnil
;
3363 /* If there are no faces yet, give up. This is the case when called
3364 from Fx_create_frame, and we do the necessary things later in
3365 face-set-after-frame-defaults. */
3366 if (NILP (f
->face_alist
))
3369 if (EQ (param
, Qforeground_color
))
3372 lface
= lface_from_face_name (f
, face
, 1);
3373 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3374 ? new_value
: Qunspecified
);
3375 realize_basic_faces (f
);
3377 else if (EQ (param
, Qbackground_color
))
3381 /* Changing the background color might change the background
3382 mode, so that we have to load new defface specs.
3383 Call frame-set-background-mode to do that. */
3384 XSETFRAME (frame
, f
);
3385 call1 (Qframe_set_background_mode
, frame
);
3388 lface
= lface_from_face_name (f
, face
, 1);
3389 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3390 ? new_value
: Qunspecified
);
3391 realize_basic_faces (f
);
3393 #ifdef HAVE_WINDOW_SYSTEM
3394 else if (EQ (param
, Qborder_color
))
3397 lface
= lface_from_face_name (f
, face
, 1);
3398 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3399 ? new_value
: Qunspecified
);
3401 else if (EQ (param
, Qcursor_color
))
3404 lface
= lface_from_face_name (f
, face
, 1);
3405 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3406 ? new_value
: Qunspecified
);
3408 else if (EQ (param
, Qmouse_color
))
3411 lface
= lface_from_face_name (f
, face
, 1);
3412 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3413 ? new_value
: Qunspecified
);
3417 /* Changing a named face means that all realized faces depending on
3418 that face are invalid. Since we cannot tell which realized faces
3419 depend on the face, make sure they are all removed. This is done
3420 by incrementing face_change_count. The next call to
3421 init_iterator will then free realized faces. */
3423 && NILP (Fget (face
, Qface_no_inherit
)))
3425 ++face_change_count
;
3426 ++windows_or_buffers_changed
;
3431 #ifdef HAVE_WINDOW_SYSTEM
3433 /* Set the `font' frame parameter of FRAME determined from the
3434 font-object set in `default' face attributes LFACE. */
3437 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3439 struct frame
*f
= XFRAME (frame
);
3442 if (FRAME_WINDOW_P (f
)
3443 /* Don't do anything if the font is `unspecified'. This can
3444 happen during frame creation. */
3445 && (font
= LFACE_FONT (lface
),
3446 ! UNSPECIFIEDP (font
)))
3448 if (FONT_SPEC_P (font
))
3450 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3453 LFACE_FONT (lface
) = font
;
3455 f
->default_face_done_p
= 0;
3456 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3461 /* Get the value of X resource RESOURCE, class CLASS for the display
3462 of frame FRAME. This is here because ordinary `x-get-resource'
3463 doesn't take a frame argument. */
3465 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3466 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3467 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3469 Lisp_Object value
= Qnil
;
3470 CHECK_STRING (resource
);
3471 CHECK_STRING (class);
3472 CHECK_LIVE_FRAME (frame
);
3474 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3475 resource
, class, Qnil
, Qnil
);
3481 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3482 If VALUE is "on" or "true", return t. If VALUE is "off" or
3483 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3484 error; if SIGNAL_P is zero, return 0. */
3487 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3489 Lisp_Object result
= make_number (0);
3491 eassert (STRINGP (value
));
3493 if (xstrcasecmp (SSDATA (value
), "on") == 0
3494 || xstrcasecmp (SSDATA (value
), "true") == 0)
3496 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3497 || xstrcasecmp (SSDATA (value
), "false") == 0)
3499 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3500 result
= Qunspecified
;
3502 signal_error ("Invalid face attribute value from X resource", value
);
3508 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3509 Finternal_set_lisp_face_attribute_from_resource
,
3510 Sinternal_set_lisp_face_attribute_from_resource
,
3511 3, 4, 0, doc
: /* */)
3512 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3514 CHECK_SYMBOL (face
);
3515 CHECK_SYMBOL (attr
);
3516 CHECK_STRING (value
);
3518 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3519 value
= Qunspecified
;
3520 else if (EQ (attr
, QCheight
))
3522 value
= Fstring_to_number (value
, make_number (10));
3523 if (XINT (value
) <= 0)
3524 signal_error ("Invalid face height from X resource", value
);
3526 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3527 value
= face_boolean_x_resource_value (value
, 1);
3528 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3529 value
= intern (SSDATA (value
));
3530 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3531 value
= face_boolean_x_resource_value (value
, 1);
3532 else if (EQ (attr
, QCunderline
)
3533 || EQ (attr
, QCoverline
)
3534 || EQ (attr
, QCstrike_through
))
3536 Lisp_Object boolean_value
;
3538 /* If the result of face_boolean_x_resource_value is t or nil,
3539 VALUE does NOT specify a color. */
3540 boolean_value
= face_boolean_x_resource_value (value
, 0);
3541 if (SYMBOLP (boolean_value
))
3542 value
= boolean_value
;
3544 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3545 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3547 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3550 #endif /* HAVE_WINDOW_SYSTEM */
3553 /***********************************************************************
3555 ***********************************************************************/
3557 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3559 /* Make menus on frame F appear as specified by the `menu' face. */
3562 x_update_menu_appearance (struct frame
*f
)
3564 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3568 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3573 ptrdiff_t bufsize
= sizeof line
;
3574 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3575 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3576 const char *myname
= SSDATA (Vx_resource_name
);
3579 const char *popup_path
= "popup_menu";
3581 const char *popup_path
= "menu.popup";
3584 if (STRINGP (LFACE_FOREGROUND (lface
)))
3586 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3588 SDATA (LFACE_FOREGROUND (lface
)));
3589 XrmPutLineResource (&rdb
, line
);
3590 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3591 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3592 XrmPutLineResource (&rdb
, line
);
3596 if (STRINGP (LFACE_BACKGROUND (lface
)))
3598 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3600 SDATA (LFACE_BACKGROUND (lface
)));
3601 XrmPutLineResource (&rdb
, line
);
3603 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3604 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3605 XrmPutLineResource (&rdb
, line
);
3610 /* On Solaris 5.8, it's been reported that the `menu' face
3611 can be unspecified here, during startup. Why this
3612 happens remains unknown. -- cyd */
3613 && FONTP (LFACE_FONT (lface
))
3614 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3615 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3616 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3617 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3618 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3619 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3621 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3623 const char *suffix
= "List";
3626 #if defined HAVE_X_I18N
3628 const char *suffix
= "Set";
3630 const char *suffix
= "";
3637 #if defined HAVE_X_I18N
3638 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3640 char *fontsetname
= SSDATA (xlfd
);
3642 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3643 myname
, suffix
, fontsetname
);
3644 XrmPutLineResource (&rdb
, line
);
3646 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3647 myname
, popup_path
, suffix
, fontsetname
);
3648 XrmPutLineResource (&rdb
, line
);
3650 if (fontsetname
!= SSDATA (xlfd
))
3651 xfree (fontsetname
);
3655 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3656 free_frame_menubar (f
);
3663 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3666 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3667 Sface_attribute_relative_p
,
3669 doc
: /* Check whether a face attribute value is relative.
3670 Specifically, this function returns t if the attribute ATTRIBUTE
3671 with the value VALUE is relative.
3673 A relative value is one that doesn't entirely override whatever is
3674 inherited from another face. For most possible attributes,
3675 the only relative value that users see is `unspecified'.
3676 However, for :height, floating point values are also relative. */)
3677 (Lisp_Object attribute
, Lisp_Object value
)
3679 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3681 else if (EQ (attribute
, QCheight
))
3682 return INTEGERP (value
) ? Qnil
: Qt
;
3687 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3689 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3690 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3691 the result will be absolute, otherwise it will be relative. */)
3692 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3694 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3696 else if (EQ (attribute
, QCheight
))
3697 return merge_face_heights (value1
, value2
, value1
);
3703 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3704 Sinternal_get_lisp_face_attribute
,
3706 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3707 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3708 face attribute name, signal an error.
3709 If the optional argument FRAME is given, report on face SYMBOL in that
3710 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3711 frames). If FRAME is omitted or nil, use the selected frame. */)
3712 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3714 Lisp_Object lface
, value
= Qnil
;
3716 CHECK_SYMBOL (symbol
);
3717 CHECK_SYMBOL (keyword
);
3720 lface
= lface_from_face_name (NULL
, symbol
, 1);
3724 frame
= selected_frame
;
3725 CHECK_LIVE_FRAME (frame
);
3726 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3729 if (EQ (keyword
, QCfamily
))
3730 value
= LFACE_FAMILY (lface
);
3731 else if (EQ (keyword
, QCfoundry
))
3732 value
= LFACE_FOUNDRY (lface
);
3733 else if (EQ (keyword
, QCheight
))
3734 value
= LFACE_HEIGHT (lface
);
3735 else if (EQ (keyword
, QCweight
))
3736 value
= LFACE_WEIGHT (lface
);
3737 else if (EQ (keyword
, QCslant
))
3738 value
= LFACE_SLANT (lface
);
3739 else if (EQ (keyword
, QCunderline
))
3740 value
= LFACE_UNDERLINE (lface
);
3741 else if (EQ (keyword
, QCoverline
))
3742 value
= LFACE_OVERLINE (lface
);
3743 else if (EQ (keyword
, QCstrike_through
))
3744 value
= LFACE_STRIKE_THROUGH (lface
);
3745 else if (EQ (keyword
, QCbox
))
3746 value
= LFACE_BOX (lface
);
3747 else if (EQ (keyword
, QCinverse_video
)
3748 || EQ (keyword
, QCreverse_video
))
3749 value
= LFACE_INVERSE (lface
);
3750 else if (EQ (keyword
, QCforeground
))
3751 value
= LFACE_FOREGROUND (lface
);
3752 else if (EQ (keyword
, QCbackground
))
3753 value
= LFACE_BACKGROUND (lface
);
3754 else if (EQ (keyword
, QCstipple
))
3755 value
= LFACE_STIPPLE (lface
);
3756 else if (EQ (keyword
, QCwidth
))
3757 value
= LFACE_SWIDTH (lface
);
3758 else if (EQ (keyword
, QCinherit
))
3759 value
= LFACE_INHERIT (lface
);
3760 else if (EQ (keyword
, QCfont
))
3761 value
= LFACE_FONT (lface
);
3762 else if (EQ (keyword
, QCfontset
))
3763 value
= LFACE_FONTSET (lface
);
3765 signal_error ("Invalid face attribute name", keyword
);
3767 if (IGNORE_DEFFACE_P (value
))
3768 return Qunspecified
;
3774 DEFUN ("internal-lisp-face-attribute-values",
3775 Finternal_lisp_face_attribute_values
,
3776 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3777 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3778 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3781 Lisp_Object result
= Qnil
;
3783 CHECK_SYMBOL (attr
);
3785 if (EQ (attr
, QCunderline
))
3786 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3787 else if (EQ (attr
, QCoverline
))
3788 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3789 else if (EQ (attr
, QCstrike_through
))
3790 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3791 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3792 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3798 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3799 Sinternal_merge_in_global_face
, 2, 2, 0,
3800 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3801 Default face attributes override any local face attributes. */)
3802 (Lisp_Object face
, Lisp_Object frame
)
3805 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3806 struct frame
*f
= XFRAME (frame
);
3808 CHECK_LIVE_FRAME (frame
);
3809 global_lface
= lface_from_face_name (NULL
, face
, 1);
3810 local_lface
= lface_from_face_name (f
, face
, 0);
3811 if (NILP (local_lface
))
3812 local_lface
= Finternal_make_lisp_face (face
, frame
);
3814 /* Make every specified global attribute override the local one.
3815 BEWARE!! This is only used from `face-set-after-frame-default' where
3816 the local frame is defined from default specs in `face-defface-spec'
3817 and those should be overridden by global settings. Hence the strange
3818 "global before local" priority. */
3819 lvec
= XVECTOR (local_lface
)->contents
;
3820 gvec
= XVECTOR (global_lface
)->contents
;
3821 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3822 if (IGNORE_DEFFACE_P (gvec
[i
]))
3823 lvec
[i
] = Qunspecified
;
3824 else if (! UNSPECIFIEDP (gvec
[i
]))
3827 /* If the default face was changed, update the face cache and the
3828 `font' frame parameter. */
3829 if (EQ (face
, Qdefault
))
3831 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3832 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3833 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3835 /* This can be NULL (e.g., in batch mode). */
3838 /* Ensure that the face vector is fully specified by merging
3839 the previously-cached vector. */
3840 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3841 merge_face_vectors (f
, lvec
, attrs
, 0);
3842 memcpy (lvec
, attrs
, sizeof attrs
);
3843 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3845 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3846 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3847 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3848 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3849 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3850 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3851 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3854 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3855 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3859 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3860 Fmodify_frame_parameters (frame
,
3861 Fcons (Fcons (Qforeground_color
,
3862 gvec
[LFACE_FOREGROUND_INDEX
]),
3865 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3866 Fmodify_frame_parameters (frame
,
3867 Fcons (Fcons (Qbackground_color
,
3868 gvec
[LFACE_BACKGROUND_INDEX
]),
3877 /* The following function is implemented for compatibility with 20.2.
3878 The function is used in x-resolve-fonts when it is asked to
3879 return fonts with the same size as the font of a face. This is
3880 done in fontset.el. */
3882 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3883 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3884 The font name is, by default, for ASCII characters.
3885 If the optional argument FRAME is given, report on face FACE in that frame.
3886 If FRAME is t, report on the defaults for face FACE (for new frames).
3887 The font default for a face is either nil, or a list
3888 of the form (bold), (italic) or (bold italic).
3889 If FRAME is omitted or nil, use the selected frame. And, in this case,
3890 if the optional third argument CHARACTER is given,
3891 return the font name used for CHARACTER. */)
3892 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3896 Lisp_Object result
= Qnil
;
3897 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3899 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3900 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3901 result
= Fcons (Qbold
, result
);
3903 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3904 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3905 result
= Fcons (Qitalic
, result
);
3911 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3912 int face_id
= lookup_named_face (f
, face
, 1);
3913 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3917 #ifdef HAVE_WINDOW_SYSTEM
3918 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3920 CHECK_CHARACTER (character
);
3921 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3922 fface
= FACE_FROM_ID (f
, face_id
);
3925 ? fface
->font
->props
[FONT_NAME_INDEX
]
3927 #else /* !HAVE_WINDOW_SYSTEM */
3928 return build_string (FRAME_MSDOS_P (f
)
3930 : FRAME_W32_P (f
) ? "w32term"
3937 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3938 all attributes are `equal'. Tries to be fast because this function
3939 is called quite often. */
3942 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3944 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3945 and the other is specified. */
3946 if (XTYPE (v1
) != XTYPE (v2
))
3955 if (SBYTES (v1
) != SBYTES (v2
))
3958 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3965 return !NILP (Fequal (v1
, v2
));
3970 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3971 all attributes are `equal'. Tries to be fast because this function
3972 is called quite often. */
3975 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3979 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3980 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3986 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3987 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3988 doc
: /* True if FACE1 and FACE2 are equal.
3989 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3990 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3991 If FRAME is omitted or nil, use the selected frame. */)
3992 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3996 Lisp_Object lface1
, lface2
;
4001 /* Don't use check_x_frame here because this function is called
4002 before X frames exist. At that time, if FRAME is nil,
4003 selected_frame will be used which is the frame dumped with
4004 Emacs. That frame is not an X frame. */
4005 f
= frame_or_selected_frame (frame
, 2);
4007 lface1
= lface_from_face_name (f
, face1
, 1);
4008 lface2
= lface_from_face_name (f
, face2
, 1);
4009 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4010 XVECTOR (lface2
)->contents
);
4011 return equal_p
? Qt
: Qnil
;
4015 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4016 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4017 doc
: /* True if FACE has no attribute specified.
4018 If the optional argument FRAME is given, report on face FACE in that frame.
4019 If FRAME is t, report on the defaults for face FACE (for new frames).
4020 If FRAME is omitted or nil, use the selected frame. */)
4021 (Lisp_Object face
, Lisp_Object frame
)
4028 frame
= selected_frame
;
4029 CHECK_LIVE_FRAME (frame
);
4033 lface
= lface_from_face_name (NULL
, face
, 1);
4035 lface
= lface_from_face_name (f
, face
, 1);
4037 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4038 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4041 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4045 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4047 doc
: /* Return an alist of frame-local faces defined on FRAME.
4048 For internal use only. */)
4051 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4052 return f
->face_alist
;
4056 /* Return a hash code for Lisp string STRING with case ignored. Used
4057 below in computing a hash value for a Lisp face. */
4059 static inline unsigned
4060 hash_string_case_insensitive (Lisp_Object string
)
4062 const unsigned char *s
;
4064 eassert (STRINGP (string
));
4065 for (s
= SDATA (string
); *s
; ++s
)
4066 hash
= (hash
<< 1) ^ tolower (*s
);
4071 /* Return a hash code for face attribute vector V. */
4073 static inline unsigned
4074 lface_hash (Lisp_Object
*v
)
4076 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4077 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4078 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4079 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4080 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4081 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4082 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4083 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4087 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4088 considering charsets/registries). They do if they specify the same
4089 family, point size, weight, width, slant, and font. Both
4090 LFACE1 and LFACE2 must be fully-specified. */
4093 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4095 eassert (lface_fully_specified_p (lface1
)
4096 && lface_fully_specified_p (lface2
));
4097 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4098 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4099 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4100 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4101 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4102 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4103 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4104 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4105 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4106 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4107 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4108 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4109 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4110 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4116 /***********************************************************************
4118 ***********************************************************************/
4120 /* Allocate and return a new realized face for Lisp face attribute
4123 static struct face
*
4124 make_realized_face (Lisp_Object
*attr
)
4126 struct face
*face
= xzalloc (sizeof *face
);
4127 face
->ascii_face
= face
;
4128 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4133 /* Free realized face FACE, including its X resources. FACE may
4137 free_realized_face (struct frame
*f
, struct face
*face
)
4141 #ifdef HAVE_WINDOW_SYSTEM
4142 if (FRAME_WINDOW_P (f
))
4144 /* Free fontset of FACE if it is ASCII face. */
4145 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4146 free_face_fontset (f
, face
);
4151 font_done_for_face (f
, face
);
4152 x_free_gc (f
, face
->gc
);
4157 free_face_colors (f
, face
);
4158 x_destroy_bitmap (f
, face
->stipple
);
4160 #endif /* HAVE_WINDOW_SYSTEM */
4167 /* Prepare face FACE for subsequent display on frame F. This
4168 allocated GCs if they haven't been allocated yet or have been freed
4169 by clearing the face cache. */
4172 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4174 #ifdef HAVE_WINDOW_SYSTEM
4175 eassert (FRAME_WINDOW_P (f
));
4180 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4182 xgcv
.foreground
= face
->foreground
;
4183 xgcv
.background
= face
->background
;
4184 #ifdef HAVE_X_WINDOWS
4185 xgcv
.graphics_exposures
= False
;
4189 #ifdef HAVE_X_WINDOWS
4192 xgcv
.fill_style
= FillOpaqueStippled
;
4193 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4194 mask
|= GCFillStyle
| GCStipple
;
4197 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4199 font_prepare_for_face (f
, face
);
4202 #endif /* HAVE_WINDOW_SYSTEM */
4206 /* Returns the `distance' between the colors X and Y. */
4209 color_distance (XColor
*x
, XColor
*y
)
4211 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4212 Quoting from that paper:
4214 This formula has results that are very close to L*u*v* (with the
4215 modified lightness curve) and, more importantly, it is a more even
4216 algorithm: it does not have a range of colors where it suddenly
4217 gives far from optimal results.
4219 See <http://www.compuphase.com/cmetric.htm> for more info. */
4221 long r
= (x
->red
- y
->red
) >> 8;
4222 long g
= (x
->green
- y
->green
) >> 8;
4223 long b
= (x
->blue
- y
->blue
) >> 8;
4224 long r_mean
= (x
->red
+ y
->red
) >> 9;
4227 (((512 + r_mean
) * r
* r
) >> 8)
4229 + (((767 - r_mean
) * b
* b
) >> 8);
4233 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4234 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4235 COLOR1 and COLOR2 may be either strings containing the color name,
4236 or lists of the form (RED GREEN BLUE).
4237 If FRAME is unspecified or nil, the current frame is used. */)
4238 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4241 XColor cdef1
, cdef2
;
4244 frame
= selected_frame
;
4245 CHECK_LIVE_FRAME (frame
);
4248 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4249 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4250 signal_error ("Invalid color", color1
);
4251 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4252 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4253 signal_error ("Invalid color", color2
);
4255 return make_number (color_distance (&cdef1
, &cdef2
));
4259 /***********************************************************************
4261 ***********************************************************************/
4263 /* Return a new face cache for frame F. */
4265 static struct face_cache
*
4266 make_face_cache (struct frame
*f
)
4268 struct face_cache
*c
;
4271 c
= xzalloc (sizeof *c
);
4272 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4273 c
->buckets
= xzalloc (size
);
4275 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4277 c
->menu_face_changed_p
= menu_face_changed_default
;
4282 /* Clear out all graphics contexts for all realized faces, except for
4283 the basic faces. This should be done from time to time just to avoid
4284 keeping too many graphics contexts that are no longer needed. */
4287 clear_face_gcs (struct face_cache
*c
)
4289 if (c
&& FRAME_WINDOW_P (c
->f
))
4291 #ifdef HAVE_WINDOW_SYSTEM
4293 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4295 struct face
*face
= c
->faces_by_id
[i
];
4296 if (face
&& face
->gc
)
4300 font_done_for_face (c
->f
, face
);
4301 x_free_gc (c
->f
, face
->gc
);
4306 #endif /* HAVE_WINDOW_SYSTEM */
4311 /* Free all realized faces in face cache C, including basic faces.
4312 C may be null. If faces are freed, make sure the frame's current
4313 matrix is marked invalid, so that a display caused by an expose
4314 event doesn't try to use faces we destroyed. */
4317 free_realized_faces (struct face_cache
*c
)
4322 struct frame
*f
= c
->f
;
4324 /* We must block input here because we can't process X events
4325 safely while only some faces are freed, or when the frame's
4326 current matrix still references freed faces. */
4329 for (i
= 0; i
< c
->used
; ++i
)
4331 free_realized_face (f
, c
->faces_by_id
[i
]);
4332 c
->faces_by_id
[i
] = NULL
;
4336 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4337 memset (c
->buckets
, 0, size
);
4339 /* Must do a thorough redisplay the next time. Mark current
4340 matrices as invalid because they will reference faces freed
4341 above. This function is also called when a frame is
4342 destroyed. In this case, the root window of F is nil. */
4343 if (WINDOWP (f
->root_window
))
4345 clear_current_matrices (f
);
4346 ++windows_or_buffers_changed
;
4354 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4355 This is done after attributes of a named face have been changed,
4356 because we can't tell which realized faces depend on that face. */
4359 free_all_realized_faces (Lisp_Object frame
)
4364 FOR_EACH_FRAME (rest
, frame
)
4365 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4368 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4372 /* Free face cache C and faces in it, including their X resources. */
4375 free_face_cache (struct face_cache
*c
)
4379 free_realized_faces (c
);
4381 xfree (c
->faces_by_id
);
4387 /* Cache realized face FACE in face cache C. HASH is the hash value
4388 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4389 FACE), insert the new face to the beginning of the collision list
4390 of the face hash table of C. Otherwise, add the new face to the
4391 end of the collision list. This way, lookup_face can quickly find
4392 that a requested face is not cached. */
4395 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4397 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4401 if (face
->ascii_face
!= face
)
4403 struct face
*last
= c
->buckets
[i
];
4414 c
->buckets
[i
] = face
;
4415 face
->prev
= face
->next
= NULL
;
4421 face
->next
= c
->buckets
[i
];
4423 face
->next
->prev
= face
;
4424 c
->buckets
[i
] = face
;
4427 /* Find a free slot in C->faces_by_id and use the index of the free
4428 slot as FACE->id. */
4429 for (i
= 0; i
< c
->used
; ++i
)
4430 if (c
->faces_by_id
[i
] == NULL
)
4435 /* Check that FACE got a unique id. */
4440 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4441 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4447 #endif /* GLYPH_DEBUG */
4449 /* Maybe enlarge C->faces_by_id. */
4452 if (c
->used
== c
->size
)
4453 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4454 sizeof *c
->faces_by_id
);
4458 c
->faces_by_id
[i
] = face
;
4462 /* Remove face FACE from cache C. */
4465 uncache_face (struct face_cache
*c
, struct face
*face
)
4467 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4470 face
->prev
->next
= face
->next
;
4472 c
->buckets
[i
] = face
->next
;
4475 face
->next
->prev
= face
->prev
;
4477 c
->faces_by_id
[face
->id
] = NULL
;
4478 if (face
->id
== c
->used
)
4483 /* Look up a realized face with face attributes ATTR in the face cache
4484 of frame F. The face will be used to display ASCII characters.
4485 Value is the ID of the face found. If no suitable face is found,
4486 realize a new one. */
4489 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4491 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4496 eassert (cache
!= NULL
);
4497 check_lface_attrs (attr
);
4499 /* Look up ATTR in the face cache. */
4500 hash
= lface_hash (attr
);
4501 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4503 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4505 if (face
->ascii_face
!= face
)
4507 /* There's no more ASCII face. */
4511 if (face
->hash
== hash
4512 && lface_equal_p (face
->lface
, attr
))
4516 /* If not found, realize a new face. */
4518 face
= realize_face (cache
, attr
, -1);
4521 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4522 #endif /* GLYPH_DEBUG */
4527 #ifdef HAVE_WINDOW_SYSTEM
4528 /* Look up a realized face that has the same attributes as BASE_FACE
4529 except for the font in the face cache of frame F. If FONT-OBJECT
4530 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4531 the face has no font. Value is the ID of the face found. If no
4532 suitable face is found, realize a new one. */
4535 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4537 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4542 eassert (cache
!= NULL
);
4543 base_face
= base_face
->ascii_face
;
4544 hash
= lface_hash (base_face
->lface
);
4545 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4547 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4549 if (face
->ascii_face
== face
)
4551 if (face
->ascii_face
== base_face
4552 && face
->font
== (NILP (font_object
) ? NULL
4553 : XFONT_OBJECT (font_object
))
4554 && lface_equal_p (face
->lface
, base_face
->lface
))
4558 /* If not found, realize a new face. */
4559 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4562 #endif /* HAVE_WINDOW_SYSTEM */
4564 /* Return the face id of the realized face for named face SYMBOL on
4565 frame F suitable for displaying ASCII characters. Value is -1 if
4566 the face couldn't be determined, which might happen if the default
4567 face isn't realized and cannot be realized. */
4570 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4572 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4573 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4574 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4576 if (default_face
== NULL
)
4578 if (!realize_basic_faces (f
))
4580 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4581 if (default_face
== NULL
)
4582 abort (); /* realize_basic_faces must have set it up */
4585 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4588 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4589 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4591 return lookup_face (f
, attrs
);
4595 /* Return the display face-id of the basic face whose canonical face-id
4596 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4597 basic face has bee remapped via Vface_remapping_alist. This function is
4598 conservative: if something goes wrong, it will simply return FACE_ID
4599 rather than signal an error. */
4602 lookup_basic_face (struct frame
*f
, int face_id
)
4604 Lisp_Object name
, mapping
;
4605 int remapped_face_id
;
4607 if (NILP (Vface_remapping_alist
))
4608 return face_id
; /* Nothing to do. */
4612 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4613 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4614 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4615 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4616 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4617 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4618 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4619 case BORDER_FACE_ID
: name
= Qborder
; break;
4620 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4621 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4622 case MENU_FACE_ID
: name
= Qmenu
; break;
4625 abort (); /* the caller is supposed to pass us a basic face id */
4628 /* Do a quick scan through Vface_remapping_alist, and return immediately
4629 if there is no remapping for face NAME. This is just an optimization
4630 for the very common no-remapping case. */
4631 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4633 return face_id
; /* Give up. */
4635 /* If there is a remapping entry, lookup the face using NAME, which will
4636 handle the remapping too. */
4637 remapped_face_id
= lookup_named_face (f
, name
, 0);
4638 if (remapped_face_id
< 0)
4639 return face_id
; /* Give up. */
4641 return remapped_face_id
;
4645 /* Return a face for charset ASCII that is like the face with id
4646 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4647 STEPS < 0 means larger. Value is the id of the face. */
4650 smaller_face (struct frame
*f
, int face_id
, int steps
)
4652 #ifdef HAVE_WINDOW_SYSTEM
4654 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4655 int pt
, last_pt
, last_height
;
4658 struct face
*new_face
;
4660 /* If not called for an X frame, just return the original face. */
4661 if (FRAME_TERMCAP_P (f
))
4664 /* Try in increments of 1/2 pt. */
4665 delta
= steps
< 0 ? 5 : -5;
4666 steps
= eabs (steps
);
4668 face
= FACE_FROM_ID (f
, face_id
);
4669 memcpy (attrs
, face
->lface
, sizeof attrs
);
4670 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4671 new_face_id
= face_id
;
4672 last_height
= FONT_HEIGHT (face
->font
);
4676 /* Give up if we cannot find a font within 10pt. */
4677 && eabs (last_pt
- pt
) < 100)
4679 /* Look up a face for a slightly smaller/larger font. */
4681 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4682 new_face_id
= lookup_face (f
, attrs
);
4683 new_face
= FACE_FROM_ID (f
, new_face_id
);
4685 /* If height changes, count that as one step. */
4686 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4687 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4690 last_height
= FONT_HEIGHT (new_face
->font
);
4697 #else /* not HAVE_WINDOW_SYSTEM */
4701 #endif /* not HAVE_WINDOW_SYSTEM */
4705 /* Return a face for charset ASCII that is like the face with id
4706 FACE_ID on frame F, but has height HEIGHT. */
4709 face_with_height (struct frame
*f
, int face_id
, int height
)
4711 #ifdef HAVE_WINDOW_SYSTEM
4713 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4715 if (FRAME_TERMCAP_P (f
)
4719 face
= FACE_FROM_ID (f
, face_id
);
4720 memcpy (attrs
, face
->lface
, sizeof attrs
);
4721 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4722 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4723 face_id
= lookup_face (f
, attrs
);
4724 #endif /* HAVE_WINDOW_SYSTEM */
4730 /* Return the face id of the realized face for named face SYMBOL on
4731 frame F suitable for displaying ASCII characters, and use
4732 attributes of the face FACE_ID for attributes that aren't
4733 completely specified by SYMBOL. This is like lookup_named_face,
4734 except that the default attributes come from FACE_ID, not from the
4735 default face. FACE_ID is assumed to be already realized. */
4738 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4741 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4742 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4743 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4748 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4751 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4752 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4753 return lookup_face (f
, attrs
);
4756 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4757 Sface_attributes_as_vector
, 1, 1, 0,
4758 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4762 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4764 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4771 /***********************************************************************
4772 Face capability testing
4773 ***********************************************************************/
4776 /* If the distance (as returned by color_distance) between two colors is
4777 less than this, then they are considered the same, for determining
4778 whether a color is supported or not. The range of values is 0-65535. */
4780 #define TTY_SAME_COLOR_THRESHOLD 10000
4782 #ifdef HAVE_WINDOW_SYSTEM
4784 /* Return non-zero if all the face attributes in ATTRS are supported
4785 on the window-system frame F.
4787 The definition of `supported' is somewhat heuristic, but basically means
4788 that a face containing all the attributes in ATTRS, when merged with the
4789 default face for display, can be represented in a way that's
4791 \(1) different in appearance than the default face, and
4792 \(2) `close in spirit' to what the attributes specify, if not exact. */
4795 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4796 struct face
*def_face
)
4798 Lisp_Object
*def_attrs
= def_face
->lface
;
4800 /* Check that other specified attributes are different that the default
4802 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4803 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4804 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4805 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4806 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4807 def_attrs
[LFACE_INVERSE_INDEX
]))
4808 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4809 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4810 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4811 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4812 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4813 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4814 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4815 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4816 def_attrs
[LFACE_STIPPLE_INDEX
]))
4817 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4818 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4819 def_attrs
[LFACE_OVERLINE_INDEX
]))
4820 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4821 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4822 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4823 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4824 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4825 def_attrs
[LFACE_BOX_INDEX
])))
4828 /* Check font-related attributes, as those are the most commonly
4829 "unsupported" on a window-system (because of missing fonts). */
4830 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4831 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4832 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4833 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4834 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4835 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4839 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4842 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4844 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4846 face_id
= lookup_face (f
, merged_attrs
);
4847 face
= FACE_FROM_ID (f
, face_id
);
4850 error ("Cannot make face");
4852 /* If the font is the same, or no font is found, then not
4854 if (face
->font
== def_face
->font
4857 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4858 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4862 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4863 || face
->font
->driver
->case_sensitive
)
4865 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4866 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4867 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4868 s2
, make_number (0), Qnil
, Qt
), Qt
))
4874 /* Everything checks out, this face is supported. */
4878 #endif /* HAVE_WINDOW_SYSTEM */
4880 /* Return non-zero if all the face attributes in ATTRS are supported
4883 The definition of `supported' is somewhat heuristic, but basically means
4884 that a face containing all the attributes in ATTRS, when merged
4885 with the default face for display, can be represented in a way that's
4887 \(1) different in appearance than the default face, and
4888 \(2) `close in spirit' to what the attributes specify, if not exact.
4890 Point (2) implies that a `:weight black' attribute will be satisfied
4891 by any terminal that can display bold, and a `:foreground "yellow"' as
4892 long as the terminal can display a yellowish color, but `:slant italic'
4893 will _not_ be satisfied by the tty display code's automatic
4894 substitution of a `dim' face for italic. */
4897 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4898 struct face
*def_face
)
4901 Lisp_Object val
, fg
, bg
;
4902 XColor fg_tty_color
, fg_std_color
;
4903 XColor bg_tty_color
, bg_std_color
;
4904 unsigned test_caps
= 0;
4905 Lisp_Object
*def_attrs
= def_face
->lface
;
4907 /* First check some easy-to-check stuff; ttys support none of the
4908 following attributes, so we can just return false if any are requested
4909 (even if `nominal' values are specified, we should still return false,
4910 as that will be the same value that the default face uses). We
4911 consider :slant unsupportable on ttys, even though the face code
4912 actually `fakes' them using a dim attribute if possible. This is
4913 because the faked result is too different from what the face
4915 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4916 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4917 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4918 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4919 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4920 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4921 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4922 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4925 /* Test for terminal `capabilities' (non-color character attributes). */
4927 /* font weight (bold/dim) */
4928 val
= attrs
[LFACE_WEIGHT_INDEX
];
4929 if (!UNSPECIFIEDP (val
)
4930 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4932 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4936 if (def_weight
> 100)
4937 return 0; /* same as default */
4938 test_caps
= TTY_CAP_BOLD
;
4940 else if (weight
< 100)
4942 if (def_weight
< 100)
4943 return 0; /* same as default */
4944 test_caps
= TTY_CAP_DIM
;
4946 else if (def_weight
== 100)
4947 return 0; /* same as default */
4951 val
= attrs
[LFACE_SLANT_INDEX
];
4952 if (!UNSPECIFIEDP (val
)
4953 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4955 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4956 if (slant
== 100 || slant
== def_slant
)
4957 return 0; /* same as default */
4959 test_caps
|= TTY_CAP_ITALIC
;
4963 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4964 if (!UNSPECIFIEDP (val
))
4967 return 0; /* ttys can't use colored underlines */
4968 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4969 return 0; /* same as default */
4971 test_caps
|= TTY_CAP_UNDERLINE
;
4975 val
= attrs
[LFACE_INVERSE_INDEX
];
4976 if (!UNSPECIFIEDP (val
))
4978 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4979 return 0; /* same as default */
4981 test_caps
|= TTY_CAP_INVERSE
;
4985 /* Color testing. */
4987 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4988 we use them when calling `tty_capable_p' below, even if the face
4989 specifies no colors. */
4990 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4991 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4993 /* Check if foreground color is close enough. */
4994 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4997 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4999 if (face_attr_equal_p (fg
, def_fg
))
5000 return 0; /* same as default */
5001 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5002 return 0; /* not a valid color */
5003 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5004 > TTY_SAME_COLOR_THRESHOLD
)
5005 return 0; /* displayed color is too different */
5007 /* Make sure the color is really different than the default. */
5009 XColor def_fg_color
;
5010 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5011 && (color_distance (&fg_tty_color
, &def_fg_color
)
5012 <= TTY_SAME_COLOR_THRESHOLD
))
5017 /* Check if background color is close enough. */
5018 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5021 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5023 if (face_attr_equal_p (bg
, def_bg
))
5024 return 0; /* same as default */
5025 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5026 return 0; /* not a valid color */
5027 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5028 > TTY_SAME_COLOR_THRESHOLD
)
5029 return 0; /* displayed color is too different */
5031 /* Make sure the color is really different than the default. */
5033 XColor def_bg_color
;
5034 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5035 && (color_distance (&bg_tty_color
, &def_bg_color
)
5036 <= TTY_SAME_COLOR_THRESHOLD
))
5041 /* If both foreground and background are requested, see if the
5042 distance between them is OK. We just check to see if the distance
5043 between the tty's foreground and background is close enough to the
5044 distance between the standard foreground and background. */
5045 if (STRINGP (fg
) && STRINGP (bg
))
5048 = (color_distance (&fg_std_color
, &bg_std_color
)
5049 - color_distance (&fg_tty_color
, &bg_tty_color
));
5050 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5051 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5056 /* See if the capabilities we selected above are supported, with the
5058 if (test_caps
!= 0 &&
5059 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
5060 bg_tty_color
.pixel
))
5064 /* Hmmm, everything checks out, this terminal must support this face. */
5069 DEFUN ("display-supports-face-attributes-p",
5070 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5072 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5073 The optional argument DISPLAY can be a display name, a frame, or
5074 nil (meaning the selected frame's display).
5076 The definition of `supported' is somewhat heuristic, but basically means
5077 that a face containing all the attributes in ATTRIBUTES, when merged
5078 with the default face for display, can be represented in a way that's
5080 \(1) different in appearance than the default face, and
5081 \(2) `close in spirit' to what the attributes specify, if not exact.
5083 Point (2) implies that a `:weight black' attribute will be satisfied by
5084 any display that can display bold, and a `:foreground \"yellow\"' as long
5085 as it can display a yellowish color, but `:slant italic' will _not_ be
5086 satisfied by the tty display code's automatic substitution of a `dim'
5087 face for italic. */)
5088 (Lisp_Object attributes
, Lisp_Object display
)
5090 int supports
= 0, i
;
5093 struct face
*def_face
;
5094 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5096 if (noninteractive
|| !initialized
)
5097 /* We may not be able to access low-level face information in batch
5098 mode, or before being dumped, and this function is not going to
5099 be very useful in those cases anyway, so just give up. */
5103 frame
= selected_frame
;
5104 else if (FRAMEP (display
))
5108 /* Find any frame on DISPLAY. */
5109 Lisp_Object fl_tail
;
5112 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5114 frame
= XCAR (fl_tail
);
5115 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5116 XFRAME (frame
)->param_alist
)),
5122 CHECK_LIVE_FRAME (frame
);
5125 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5126 attrs
[i
] = Qunspecified
;
5127 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5129 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5130 if (def_face
== NULL
)
5132 if (! realize_basic_faces (f
))
5133 error ("Cannot realize default face");
5134 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5135 if (def_face
== NULL
)
5136 abort (); /* realize_basic_faces must have set it up */
5139 /* Dispatch to the appropriate handler. */
5140 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5141 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5142 #ifdef HAVE_WINDOW_SYSTEM
5144 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5147 return supports
? Qt
: Qnil
;
5151 /***********************************************************************
5153 ***********************************************************************/
5155 DEFUN ("internal-set-font-selection-order",
5156 Finternal_set_font_selection_order
,
5157 Sinternal_set_font_selection_order
, 1, 1, 0,
5158 doc
: /* Set font selection order for face font selection to ORDER.
5159 ORDER must be a list of length 4 containing the symbols `:width',
5160 `:height', `:weight', and `:slant'. Face attributes appearing
5161 first in ORDER are matched first, e.g. if `:height' appears before
5162 `:weight' in ORDER, font selection first tries to find a font with
5163 a suitable height, and then tries to match the font weight.
5169 int indices
[DIM (font_sort_order
)];
5172 memset (indices
, 0, sizeof indices
);
5176 CONSP (list
) && i
< DIM (indices
);
5177 list
= XCDR (list
), ++i
)
5179 Lisp_Object attr
= XCAR (list
);
5182 if (EQ (attr
, QCwidth
))
5184 else if (EQ (attr
, QCheight
))
5185 xlfd
= XLFD_POINT_SIZE
;
5186 else if (EQ (attr
, QCweight
))
5188 else if (EQ (attr
, QCslant
))
5193 if (indices
[i
] != 0)
5198 if (!NILP (list
) || i
!= DIM (indices
))
5199 signal_error ("Invalid font sort order", order
);
5200 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5201 if (indices
[i
] == 0)
5202 signal_error ("Invalid font sort order", order
);
5204 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5206 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5207 free_all_realized_faces (Qnil
);
5210 font_update_sort_order (font_sort_order
);
5216 DEFUN ("internal-set-alternative-font-family-alist",
5217 Finternal_set_alternative_font_family_alist
,
5218 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5219 doc
: /* Define alternative font families to try in face font selection.
5220 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5221 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5222 be found. Value is ALIST. */)
5225 Lisp_Object entry
, tail
, tail2
;
5228 alist
= Fcopy_sequence (alist
);
5229 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5231 entry
= XCAR (tail
);
5233 entry
= Fcopy_sequence (entry
);
5234 XSETCAR (tail
, entry
);
5235 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5236 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5239 Vface_alternative_font_family_alist
= alist
;
5240 free_all_realized_faces (Qnil
);
5245 DEFUN ("internal-set-alternative-font-registry-alist",
5246 Finternal_set_alternative_font_registry_alist
,
5247 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5248 doc
: /* Define alternative font registries to try in face font selection.
5249 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5250 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5251 be found. Value is ALIST. */)
5254 Lisp_Object entry
, tail
, tail2
;
5257 alist
= Fcopy_sequence (alist
);
5258 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5260 entry
= XCAR (tail
);
5262 entry
= Fcopy_sequence (entry
);
5263 XSETCAR (tail
, entry
);
5264 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5265 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5267 Vface_alternative_font_registry_alist
= alist
;
5268 free_all_realized_faces (Qnil
);
5273 #ifdef HAVE_WINDOW_SYSTEM
5275 /* Return the fontset id of the base fontset name or alias name given
5276 by the fontset attribute of ATTRS. Value is -1 if the fontset
5277 attribute of ATTRS doesn't name a fontset. */
5280 face_fontset (Lisp_Object
*attrs
)
5284 name
= attrs
[LFACE_FONTSET_INDEX
];
5285 if (!STRINGP (name
))
5287 return fs_query_fontset (name
, 0);
5290 #endif /* HAVE_WINDOW_SYSTEM */
5294 /***********************************************************************
5296 ***********************************************************************/
5298 /* Realize basic faces on frame F. Value is zero if frame parameters
5299 of F don't contain enough information needed to realize the default
5303 realize_basic_faces (struct frame
*f
)
5306 ptrdiff_t count
= SPECPDL_INDEX ();
5308 /* Block input here so that we won't be surprised by an X expose
5309 event, for instance, without having the faces set up. */
5311 specbind (Qscalable_fonts_allowed
, Qt
);
5313 if (realize_default_face (f
))
5315 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5316 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5317 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5318 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5319 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5320 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5321 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5322 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5323 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5324 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5325 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5327 /* Reflect changes in the `menu' face in menu bars. */
5328 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5330 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5331 #ifdef USE_X_TOOLKIT
5332 if (FRAME_WINDOW_P (f
))
5333 x_update_menu_appearance (f
);
5340 unbind_to (count
, Qnil
);
5346 /* Realize the default face on frame F. If the face is not fully
5347 specified, make it fully-specified. Attributes of the default face
5348 that are not explicitly specified are taken from frame parameters. */
5351 realize_default_face (struct frame
*f
)
5353 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5355 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5358 /* If the `default' face is not yet known, create it. */
5359 lface
= lface_from_face_name (f
, Qdefault
, 0);
5363 XSETFRAME (frame
, f
);
5364 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5367 #ifdef HAVE_WINDOW_SYSTEM
5368 if (FRAME_WINDOW_P (f
))
5370 Lisp_Object font_object
;
5372 XSETFONT (font_object
, FRAME_FONT (f
));
5373 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5374 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5375 f
->default_face_done_p
= 1;
5377 #endif /* HAVE_WINDOW_SYSTEM */
5379 if (!FRAME_WINDOW_P (f
))
5381 LFACE_FAMILY (lface
) = build_string ("default");
5382 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5383 LFACE_SWIDTH (lface
) = Qnormal
;
5384 LFACE_HEIGHT (lface
) = make_number (1);
5385 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5386 LFACE_WEIGHT (lface
) = Qnormal
;
5387 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5388 LFACE_SLANT (lface
) = Qnormal
;
5389 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5390 LFACE_FONTSET (lface
) = Qnil
;
5393 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5394 LFACE_UNDERLINE (lface
) = Qnil
;
5396 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5397 LFACE_OVERLINE (lface
) = Qnil
;
5399 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5400 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5402 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5403 LFACE_BOX (lface
) = Qnil
;
5405 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5406 LFACE_INVERSE (lface
) = Qnil
;
5408 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5410 /* This function is called so early that colors are not yet
5411 set in the frame parameter list. */
5412 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5414 if (CONSP (color
) && STRINGP (XCDR (color
)))
5415 LFACE_FOREGROUND (lface
) = XCDR (color
);
5416 else if (FRAME_WINDOW_P (f
))
5418 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5419 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5424 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5426 /* This function is called so early that colors are not yet
5427 set in the frame parameter list. */
5428 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5429 if (CONSP (color
) && STRINGP (XCDR (color
)))
5430 LFACE_BACKGROUND (lface
) = XCDR (color
);
5431 else if (FRAME_WINDOW_P (f
))
5433 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5434 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5439 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5440 LFACE_STIPPLE (lface
) = Qnil
;
5442 /* Realize the face; it must be fully-specified now. */
5443 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5444 check_lface (lface
);
5445 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5446 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5448 #ifdef HAVE_WINDOW_SYSTEM
5449 #ifdef HAVE_X_WINDOWS
5450 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5452 /* This can happen when making a frame on a display that does
5453 not support the default font. */
5457 /* Otherwise, the font specified for the frame was not
5458 acceptable as a font for the default face (perhaps because
5459 auto-scaled fonts are rejected), so we must adjust the frame
5461 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5463 #endif /* HAVE_X_WINDOWS */
5464 #endif /* HAVE_WINDOW_SYSTEM */
5469 /* Realize basic faces other than the default face in face cache C.
5470 SYMBOL is the face name, ID is the face id the realized face must
5471 have. The default face must have been realized already. */
5474 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5476 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5477 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5478 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5479 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5481 /* The default face must exist and be fully specified. */
5482 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5483 check_lface_attrs (attrs
);
5484 eassert (lface_fully_specified_p (attrs
));
5486 /* If SYMBOL isn't know as a face, create it. */
5490 XSETFRAME (frame
, f
);
5491 lface
= Finternal_make_lisp_face (symbol
, frame
);
5494 /* Merge SYMBOL's face with the default face. */
5495 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5496 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5498 /* Realize the face. */
5499 realize_face (c
, attrs
, id
);
5503 /* Realize the fully-specified face with attributes ATTRS in face
5504 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5505 non-negative, it is an ID of face to remove before caching the new
5506 face. Value is a pointer to the newly created realized face. */
5508 static struct face
*
5509 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5513 /* LFACE must be fully specified. */
5514 eassert (cache
!= NULL
);
5515 check_lface_attrs (attrs
);
5517 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5519 /* Remove the former face. */
5520 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5521 uncache_face (cache
, former_face
);
5522 free_realized_face (cache
->f
, former_face
);
5523 SET_FRAME_GARBAGED (cache
->f
);
5526 if (FRAME_WINDOW_P (cache
->f
))
5527 face
= realize_x_face (cache
, attrs
);
5528 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5529 face
= realize_tty_face (cache
, attrs
);
5530 else if (FRAME_INITIAL_P (cache
->f
))
5532 /* Create a dummy face. */
5533 face
= make_realized_face (attrs
);
5538 /* Insert the new face. */
5539 cache_face (cache
, face
, lface_hash (attrs
));
5544 #ifdef HAVE_WINDOW_SYSTEM
5545 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5546 same attributes as BASE_FACE except for the font on frame F.
5547 FONT-OBJECT may be nil, in which case, realized a face of
5550 static struct face
*
5551 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5552 struct face
*base_face
)
5554 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5557 face
= xmalloc (sizeof *face
);
5562 = (! NILP (font_object
)
5563 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5564 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5566 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5567 face
->colors_copied_bitwise_p
= 1;
5568 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5571 cache_face (cache
, face
, face
->hash
);
5575 #endif /* HAVE_WINDOW_SYSTEM */
5578 /* Realize the fully-specified face with attributes ATTRS in face
5579 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5580 the new face doesn't share font with the default face, a fontname
5581 is allocated from the heap and set in `font_name' of the new face,
5582 but it is not yet loaded here. Value is a pointer to the newly
5583 created realized face. */
5585 static struct face
*
5586 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5588 struct face
*face
= NULL
;
5589 #ifdef HAVE_WINDOW_SYSTEM
5590 struct face
*default_face
;
5592 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5594 eassert (FRAME_WINDOW_P (cache
->f
));
5596 /* Allocate a new realized face. */
5597 face
= make_realized_face (attrs
);
5598 face
->ascii_face
= face
;
5602 /* Determine the font to use. Most of the time, the font will be
5603 the same as the font of the default face, so try that first. */
5604 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5606 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5608 face
->font
= default_face
->font
;
5610 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5614 /* If the face attribute ATTRS specifies a fontset, use it as
5615 the base of a new realized fontset. Otherwise, use the same
5616 base fontset as of the default face. The base determines
5617 registry and encoding of a font. It may also determine
5618 foundry and family. The other fields of font name pattern
5619 are constructed from ATTRS. */
5620 int fontset
= face_fontset (attrs
);
5622 /* If we are realizing the default face, ATTRS should specify a
5623 fontset. In other words, if FONTSET is -1, we are not
5624 realizing the default face, thus the default face should have
5625 already been realized. */
5629 fontset
= default_face
->fontset
;
5633 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5634 attrs
[LFACE_FONT_INDEX
]
5635 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5636 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5638 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5639 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5649 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5650 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5651 face
->overstrike
= 1;
5653 /* Load colors, and set remaining attributes. */
5655 load_face_colors (f
, face
, attrs
);
5658 box
= attrs
[LFACE_BOX_INDEX
];
5661 /* A simple box of line width 1 drawn in color given by
5663 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5665 face
->box
= FACE_SIMPLE_BOX
;
5666 face
->box_line_width
= 1;
5668 else if (INTEGERP (box
))
5670 /* Simple box of specified line width in foreground color of the
5672 eassert (XINT (box
) != 0);
5673 face
->box
= FACE_SIMPLE_BOX
;
5674 face
->box_line_width
= XINT (box
);
5675 face
->box_color
= face
->foreground
;
5676 face
->box_color_defaulted_p
= 1;
5678 else if (CONSP (box
))
5680 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5681 being one of `raised' or `sunken'. */
5682 face
->box
= FACE_SIMPLE_BOX
;
5683 face
->box_color
= face
->foreground
;
5684 face
->box_color_defaulted_p
= 1;
5685 face
->box_line_width
= 1;
5689 Lisp_Object keyword
, value
;
5691 keyword
= XCAR (box
);
5699 if (EQ (keyword
, QCline_width
))
5701 if (INTEGERP (value
) && XINT (value
) != 0)
5702 face
->box_line_width
= XINT (value
);
5704 else if (EQ (keyword
, QCcolor
))
5706 if (STRINGP (value
))
5708 face
->box_color
= load_color (f
, face
, value
,
5710 face
->use_box_color_for_shadows_p
= 1;
5713 else if (EQ (keyword
, QCstyle
))
5715 if (EQ (value
, Qreleased_button
))
5716 face
->box
= FACE_RAISED_BOX
;
5717 else if (EQ (value
, Qpressed_button
))
5718 face
->box
= FACE_SUNKEN_BOX
;
5723 /* Text underline, overline, strike-through. */
5725 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5726 if (EQ (underline
, Qt
))
5728 /* Use default color (same as foreground color). */
5729 face
->underline_p
= 1;
5730 face
->underline_type
= FACE_UNDER_LINE
;
5731 face
->underline_defaulted_p
= 1;
5732 face
->underline_color
= 0;
5734 else if (STRINGP (underline
))
5736 /* Use specified color. */
5737 face
->underline_p
= 1;
5738 face
->underline_type
= FACE_UNDER_LINE
;
5739 face
->underline_defaulted_p
= 0;
5740 face
->underline_color
5741 = load_color (f
, face
, underline
,
5742 LFACE_UNDERLINE_INDEX
);
5744 else if (NILP (underline
))
5746 face
->underline_p
= 0;
5747 face
->underline_defaulted_p
= 0;
5748 face
->underline_color
= 0;
5750 else if (CONSP (underline
))
5752 /* `(:color COLOR :style STYLE)'.
5753 STYLE being one of `line' or `wave'. */
5754 face
->underline_p
= 1;
5755 face
->underline_color
= 0;
5756 face
->underline_defaulted_p
= 1;
5757 face
->underline_type
= FACE_UNDER_LINE
;
5759 while (CONSP (underline
))
5761 Lisp_Object keyword
, value
;
5763 keyword
= XCAR (underline
);
5764 underline
= XCDR (underline
);
5766 if (!CONSP (underline
))
5768 value
= XCAR (underline
);
5769 underline
= XCDR (underline
);
5771 if (EQ (keyword
, QCcolor
))
5773 if (EQ (value
, Qforeground_color
))
5775 face
->underline_defaulted_p
= 1;
5776 face
->underline_color
= 0;
5778 else if (STRINGP (value
))
5780 face
->underline_defaulted_p
= 0;
5781 face
->underline_color
= load_color (f
, face
, value
,
5782 LFACE_UNDERLINE_INDEX
);
5785 else if (EQ (keyword
, QCstyle
))
5787 if (EQ (value
, Qline
))
5788 face
->underline_type
= FACE_UNDER_LINE
;
5789 else if (EQ (value
, Qwave
))
5790 face
->underline_type
= FACE_UNDER_WAVE
;
5795 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5796 if (STRINGP (overline
))
5798 face
->overline_color
5799 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5800 LFACE_OVERLINE_INDEX
);
5801 face
->overline_p
= 1;
5803 else if (EQ (overline
, Qt
))
5805 face
->overline_color
= face
->foreground
;
5806 face
->overline_color_defaulted_p
= 1;
5807 face
->overline_p
= 1;
5810 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5811 if (STRINGP (strike_through
))
5813 face
->strike_through_color
5814 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5815 LFACE_STRIKE_THROUGH_INDEX
);
5816 face
->strike_through_p
= 1;
5818 else if (EQ (strike_through
, Qt
))
5820 face
->strike_through_color
= face
->foreground
;
5821 face
->strike_through_color_defaulted_p
= 1;
5822 face
->strike_through_p
= 1;
5825 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5826 if (!NILP (stipple
))
5827 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5828 #endif /* HAVE_WINDOW_SYSTEM */
5834 /* Map a specified color of face FACE on frame F to a tty color index.
5835 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5836 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5837 default foreground/background colors. */
5840 map_tty_color (struct frame
*f
, struct face
*face
,
5841 enum lface_attribute_index idx
, int *defaulted
)
5843 Lisp_Object frame
, color
, def
;
5844 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5845 unsigned long default_pixel
=
5846 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5847 unsigned long pixel
= default_pixel
;
5849 unsigned long default_other_pixel
=
5850 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5853 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5855 XSETFRAME (frame
, f
);
5856 color
= face
->lface
[idx
];
5860 && CONSP (Vtty_defined_color_alist
)
5861 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5864 /* Associations in tty-defined-color-alist are of the form
5865 (NAME INDEX R G B). We need the INDEX part. */
5866 pixel
= XINT (XCAR (XCDR (def
)));
5869 if (pixel
== default_pixel
&& STRINGP (color
))
5871 pixel
= load_color (f
, face
, color
, idx
);
5874 /* If the foreground of the default face is the default color,
5875 use the foreground color defined by the frame. */
5876 if (FRAME_MSDOS_P (f
))
5878 if (pixel
== default_pixel
5879 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5882 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5884 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5885 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5888 else if (pixel
== default_other_pixel
)
5891 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5893 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5894 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5902 face
->foreground
= pixel
;
5904 face
->background
= pixel
;
5908 /* Realize the fully-specified face with attributes ATTRS in face
5909 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5910 Value is a pointer to the newly created realized face. */
5912 static struct face
*
5913 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5917 int face_colors_defaulted
= 0;
5918 struct frame
*f
= cache
->f
;
5920 /* Frame must be a termcap frame. */
5921 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5923 /* Allocate a new realized face. */
5924 face
= make_realized_face (attrs
);
5926 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5929 /* Map face attributes to TTY appearances. */
5930 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5931 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5933 face
->tty_bold_p
= 1;
5935 face
->tty_italic_p
= 1;
5936 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5937 face
->tty_underline_p
= 1;
5938 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5939 face
->tty_reverse_p
= 1;
5941 /* Map color names to color indices. */
5942 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5943 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5945 /* Swap colors if face is inverse-video. If the colors are taken
5946 from the frame colors, they are already inverted, since the
5947 frame-creation function calls x-handle-reverse-video. */
5948 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5950 unsigned long tem
= face
->foreground
;
5951 face
->foreground
= face
->background
;
5952 face
->background
= tem
;
5955 if (tty_suppress_bold_inverse_default_colors_p
5957 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5958 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5959 face
->tty_bold_p
= 0;
5965 DEFUN ("tty-suppress-bold-inverse-default-colors",
5966 Ftty_suppress_bold_inverse_default_colors
,
5967 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5968 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5969 SUPPRESS non-nil means suppress it.
5970 This affects bold faces on TTYs whose foreground is the default background
5971 color of the display and whose background is the default foreground color.
5972 For such faces, the bold face attribute is ignored if this variable
5974 (Lisp_Object suppress
)
5976 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5977 ++face_change_count
;
5983 /***********************************************************************
5985 ***********************************************************************/
5987 /* Return the ID of the face to use to display character CH with face
5988 property PROP on frame F in current_buffer. */
5991 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5995 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
6000 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6001 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6005 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6006 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6007 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6008 merge_face_ref (f
, prop
, attrs
, 1, 0);
6009 face_id
= lookup_face (f
, attrs
);
6015 /* Return the face ID associated with buffer position POS for
6016 displaying ASCII characters. Return in *ENDPTR the position at
6017 which a different face is needed, as far as text properties and
6018 overlays are concerned. W is a window displaying current_buffer.
6020 REGION_BEG, REGION_END delimit the region, so it can be
6023 LIMIT is a position not to scan beyond. That is to limit the time
6024 this function can take.
6026 If MOUSE is non-zero, use the character's mouse-face, not its face.
6028 BASE_FACE_ID, if non-negative, specifies a base face id to use
6029 instead of DEFAULT_FACE_ID.
6031 The face returned is suitable for displaying ASCII characters. */
6034 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
6035 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6036 ptrdiff_t *endptr
, ptrdiff_t limit
,
6037 int mouse
, int base_face_id
)
6039 struct frame
*f
= XFRAME (w
->frame
);
6040 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6041 Lisp_Object prop
, position
;
6042 ptrdiff_t i
, noverlays
;
6043 Lisp_Object
*overlay_vec
;
6046 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6047 Lisp_Object limit1
, end
;
6048 struct face
*default_face
;
6050 /* W must display the current buffer. We could write this function
6051 to use the frame and buffer of W, but right now it doesn't. */
6052 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6054 XSETFRAME (frame
, f
);
6055 XSETFASTINT (position
, pos
);
6058 if (pos
< region_beg
&& region_beg
< endpos
)
6059 endpos
= region_beg
;
6061 /* Get the `face' or `mouse_face' text property at POS, and
6062 determine the next position at which the property changes. */
6063 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6064 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6065 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6067 endpos
= XINT (end
);
6069 /* Look at properties from overlays. */
6071 ptrdiff_t next_overlay
;
6073 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6074 if (next_overlay
< endpos
)
6075 endpos
= next_overlay
;
6083 if (base_face_id
>= 0)
6084 face_id
= base_face_id
;
6085 else if (NILP (Vface_remapping_alist
))
6086 face_id
= DEFAULT_FACE_ID
;
6088 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6090 default_face
= FACE_FROM_ID (f
, face_id
);
6093 /* Optimize common cases where we can use the default face. */
6096 && !(pos
>= region_beg
&& pos
< region_end
))
6097 return default_face
->id
;
6099 /* Begin with attributes from the default face. */
6100 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6102 /* Merge in attributes specified via text properties. */
6104 merge_face_ref (f
, prop
, attrs
, 1, 0);
6106 /* Now merge the overlay data. */
6107 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6108 for (i
= 0; i
< noverlays
; i
++)
6113 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6115 merge_face_ref (f
, prop
, attrs
, 1, 0);
6117 oend
= OVERLAY_END (overlay_vec
[i
]);
6118 oendpos
= OVERLAY_POSITION (oend
);
6119 if (oendpos
< endpos
)
6123 /* If in the region, merge in the region face. */
6124 if (pos
>= region_beg
&& pos
< region_end
)
6126 merge_named_face (f
, Qregion
, attrs
, 0);
6128 if (region_end
< endpos
)
6129 endpos
= region_end
;
6134 /* Look up a realized face with the given face attributes,
6135 or realize a new one for ASCII characters. */
6136 return lookup_face (f
, attrs
);
6139 /* Return the face ID at buffer position POS for displaying ASCII
6140 characters associated with overlay strings for overlay OVERLAY.
6142 Like face_at_buffer_position except for OVERLAY. Currently it
6143 simply disregards the `face' properties of all overlays. */
6146 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6147 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6148 ptrdiff_t *endptr
, ptrdiff_t limit
,
6149 int mouse
, Lisp_Object overlay
)
6151 struct frame
*f
= XFRAME (w
->frame
);
6152 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6153 Lisp_Object prop
, position
;
6156 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6157 Lisp_Object limit1
, end
;
6158 struct face
*default_face
;
6160 /* W must display the current buffer. We could write this function
6161 to use the frame and buffer of W, but right now it doesn't. */
6162 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6164 XSETFRAME (frame
, f
);
6165 XSETFASTINT (position
, pos
);
6168 if (pos
< region_beg
&& region_beg
< endpos
)
6169 endpos
= region_beg
;
6171 /* Get the `face' or `mouse_face' text property at POS, and
6172 determine the next position at which the property changes. */
6173 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6174 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6175 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6177 endpos
= XINT (end
);
6181 /* Optimize common case where we can use the default face. */
6183 && !(pos
>= region_beg
&& pos
< region_end
)
6184 && NILP (Vface_remapping_alist
))
6185 return DEFAULT_FACE_ID
;
6187 /* Begin with attributes from the default face. */
6188 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6189 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6191 /* Merge in attributes specified via text properties. */
6193 merge_face_ref (f
, prop
, attrs
, 1, 0);
6195 /* If in the region, merge in the region face. */
6196 if (pos
>= region_beg
&& pos
< region_end
)
6198 merge_named_face (f
, Qregion
, attrs
, 0);
6200 if (region_end
< endpos
)
6201 endpos
= region_end
;
6206 /* Look up a realized face with the given face attributes,
6207 or realize a new one for ASCII characters. */
6208 return lookup_face (f
, attrs
);
6212 /* Compute the face at character position POS in Lisp string STRING on
6213 window W, for ASCII characters.
6215 If STRING is an overlay string, it comes from position BUFPOS in
6216 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6217 not an overlay string. W must display the current buffer.
6218 REGION_BEG and REGION_END give the start and end positions of the
6219 region; both are -1 if no region is visible.
6221 BASE_FACE_ID is the id of a face to merge with. For strings coming
6222 from overlays or the `display' property it is the face at BUFPOS.
6224 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6226 Set *ENDPTR to the next position where to check for faces in
6227 STRING; -1 if the face is constant from POS to the end of the
6230 Value is the id of the face to use. The face returned is suitable
6231 for displaying ASCII characters. */
6234 face_at_string_position (struct window
*w
, Lisp_Object string
,
6235 ptrdiff_t pos
, ptrdiff_t bufpos
,
6236 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6237 ptrdiff_t *endptr
, enum face_id base_face_id
,
6240 Lisp_Object prop
, position
, end
, limit
;
6241 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6242 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6243 struct face
*base_face
;
6244 int multibyte_p
= STRING_MULTIBYTE (string
);
6245 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6247 /* Get the value of the face property at the current position within
6248 STRING. Value is nil if there is no face property. */
6249 XSETFASTINT (position
, pos
);
6250 prop
= Fget_text_property (position
, prop_name
, string
);
6252 /* Get the next position at which to check for faces. Value of end
6253 is nil if face is constant all the way to the end of the string.
6254 Otherwise it is a string position where to check faces next.
6255 Limit is the maximum position up to which to check for property
6256 changes in Fnext_single_property_change. Strings are usually
6257 short, so set the limit to the end of the string. */
6258 XSETFASTINT (limit
, SCHARS (string
));
6259 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6261 *endptr
= XFASTINT (end
);
6265 base_face
= FACE_FROM_ID (f
, base_face_id
);
6266 eassert (base_face
);
6268 /* Optimize the default case that there is no face property and we
6269 are not in the region. */
6271 && (base_face_id
!= DEFAULT_FACE_ID
6272 /* BUFPOS <= 0 means STRING is not an overlay string, so
6273 that the region doesn't have to be taken into account. */
6275 || bufpos
< region_beg
6276 || bufpos
>= region_end
)
6278 /* We can't realize faces for different charsets differently
6279 if we don't have fonts, so we can stop here if not working
6280 on a window-system frame. */
6281 || !FRAME_WINDOW_P (f
)
6282 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6283 return base_face
->id
;
6285 /* Begin with attributes from the base face. */
6286 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6288 /* Merge in attributes specified via text properties. */
6290 merge_face_ref (f
, prop
, attrs
, 1, 0);
6292 /* If in the region, merge in the region face. */
6294 && bufpos
>= region_beg
6295 && bufpos
< region_end
)
6296 merge_named_face (f
, Qregion
, attrs
, 0);
6298 /* Look up a realized face with the given face attributes,
6299 or realize a new one for ASCII characters. */
6300 return lookup_face (f
, attrs
);
6304 /* Merge a face into a realized face.
6306 F is frame where faces are (to be) realized.
6308 FACE_NAME is named face to merge.
6310 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6312 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6314 BASE_FACE_ID is realized face to merge into.
6320 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6323 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6324 struct face
*base_face
;
6326 base_face
= FACE_FROM_ID (f
, base_face_id
);
6328 return base_face_id
;
6330 if (EQ (face_name
, Qt
))
6332 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6333 return base_face_id
;
6334 face_name
= lface_id_to_name
[face_id
];
6335 /* When called during make-frame, lookup_derived_face may fail
6336 if the faces are uninitialized. Don't signal an error. */
6337 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6338 return (face_id
>= 0 ? face_id
: base_face_id
);
6341 /* Begin with attributes from the base face. */
6342 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6344 if (!NILP (face_name
))
6346 if (!merge_named_face (f
, face_name
, attrs
, 0))
6347 return base_face_id
;
6353 return base_face_id
;
6354 face
= FACE_FROM_ID (f
, face_id
);
6356 return base_face_id
;
6357 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6360 /* Look up a realized face with the given face attributes,
6361 or realize a new one for ASCII characters. */
6362 return lookup_face (f
, attrs
);
6367 #ifndef HAVE_X_WINDOWS
6368 DEFUN ("x-load-color-file", Fx_load_color_file
,
6369 Sx_load_color_file
, 1, 1, 0,
6370 doc
: /* Create an alist of color entries from an external file.
6372 The file should define one named RGB color per line like so:
6374 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6375 (Lisp_Object filename
)
6378 Lisp_Object cmap
= Qnil
;
6379 Lisp_Object abspath
;
6381 CHECK_STRING (filename
);
6382 abspath
= Fexpand_file_name (filename
, Qnil
);
6384 fp
= fopen (SDATA (abspath
), "rt");
6388 int red
, green
, blue
;
6393 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6394 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6396 char *name
= buf
+ num
;
6397 num
= strlen (name
) - 1;
6398 if (num
>= 0 && name
[num
] == '\n')
6400 cmap
= Fcons (Fcons (build_string (name
),
6402 make_number (RGB (red
, green
, blue
))),
6404 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6419 /***********************************************************************
6421 ***********************************************************************/
6425 /* Print the contents of the realized face FACE to stderr. */
6428 dump_realized_face (struct face
*face
)
6430 fprintf (stderr
, "ID: %d\n", face
->id
);
6431 #ifdef HAVE_X_WINDOWS
6432 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6434 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6436 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6437 fprintf (stderr
, "background: 0x%lx (%s)\n",
6439 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6441 fprintf (stderr
, "font_name: %s (%s)\n",
6442 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6443 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6444 #ifdef HAVE_X_WINDOWS
6445 fprintf (stderr
, "font = %p\n", face
->font
);
6447 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6448 fprintf (stderr
, "underline: %d (%s)\n",
6450 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6451 fprintf (stderr
, "hash: %d\n", face
->hash
);
6455 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6462 fprintf (stderr
, "font selection order: ");
6463 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6464 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6465 fprintf (stderr
, "\n");
6467 fprintf (stderr
, "alternative fonts: ");
6468 debug_print (Vface_alternative_font_family_alist
);
6469 fprintf (stderr
, "\n");
6471 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6472 Fdump_face (make_number (i
));
6478 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6480 error ("Not a valid face");
6481 dump_realized_face (face
);
6488 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6489 0, 0, 0, doc
: /* */)
6492 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6493 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6494 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6498 #endif /* GLYPH_DEBUG */
6502 /***********************************************************************
6504 ***********************************************************************/
6507 syms_of_xfaces (void)
6509 DEFSYM (Qface
, "face");
6510 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6511 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6512 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6514 /* Lisp face attribute keywords. */
6515 DEFSYM (QCfamily
, ":family");
6516 DEFSYM (QCheight
, ":height");
6517 DEFSYM (QCweight
, ":weight");
6518 DEFSYM (QCslant
, ":slant");
6519 DEFSYM (QCunderline
, ":underline");
6520 DEFSYM (QCinverse_video
, ":inverse-video");
6521 DEFSYM (QCreverse_video
, ":reverse-video");
6522 DEFSYM (QCforeground
, ":foreground");
6523 DEFSYM (QCbackground
, ":background");
6524 DEFSYM (QCstipple
, ":stipple");
6525 DEFSYM (QCwidth
, ":width");
6526 DEFSYM (QCfont
, ":font");
6527 DEFSYM (QCfontset
, ":fontset");
6528 DEFSYM (QCbold
, ":bold");
6529 DEFSYM (QCitalic
, ":italic");
6530 DEFSYM (QCoverline
, ":overline");
6531 DEFSYM (QCstrike_through
, ":strike-through");
6532 DEFSYM (QCbox
, ":box");
6533 DEFSYM (QCinherit
, ":inherit");
6535 /* Symbols used for Lisp face attribute values. */
6536 DEFSYM (QCcolor
, ":color");
6537 DEFSYM (QCline_width
, ":line-width");
6538 DEFSYM (QCstyle
, ":style");
6539 DEFSYM (Qline
, "line");
6540 DEFSYM (Qwave
, "wave");
6541 DEFSYM (Qreleased_button
, "released-button");
6542 DEFSYM (Qpressed_button
, "pressed-button");
6543 DEFSYM (Qnormal
, "normal");
6544 DEFSYM (Qultra_light
, "ultra-light");
6545 DEFSYM (Qextra_light
, "extra-light");
6546 DEFSYM (Qlight
, "light");
6547 DEFSYM (Qsemi_light
, "semi-light");
6548 DEFSYM (Qsemi_bold
, "semi-bold");
6549 DEFSYM (Qbold
, "bold");
6550 DEFSYM (Qextra_bold
, "extra-bold");
6551 DEFSYM (Qultra_bold
, "ultra-bold");
6552 DEFSYM (Qoblique
, "oblique");
6553 DEFSYM (Qitalic
, "italic");
6554 DEFSYM (Qreverse_oblique
, "reverse-oblique");
6555 DEFSYM (Qreverse_italic
, "reverse-italic");
6556 DEFSYM (Qultra_condensed
, "ultra-condensed");
6557 DEFSYM (Qextra_condensed
, "extra-condensed");
6558 DEFSYM (Qcondensed
, "condensed");
6559 DEFSYM (Qsemi_condensed
, "semi-condensed");
6560 DEFSYM (Qsemi_expanded
, "semi-expanded");
6561 DEFSYM (Qexpanded
, "expanded");
6562 DEFSYM (Qextra_expanded
, "extra-expanded");
6563 DEFSYM (Qultra_expanded
, "ultra-expanded");
6564 DEFSYM (Qbackground_color
, "background-color");
6565 DEFSYM (Qforeground_color
, "foreground-color");
6566 DEFSYM (Qunspecified
, "unspecified");
6567 DEFSYM (QCignore_defface
, ":ignore-defface");
6569 DEFSYM (Qface_alias
, "face-alias");
6570 DEFSYM (Qdefault
, "default");
6571 DEFSYM (Qtool_bar
, "tool-bar");
6572 DEFSYM (Qregion
, "region");
6573 DEFSYM (Qfringe
, "fringe");
6574 DEFSYM (Qheader_line
, "header-line");
6575 DEFSYM (Qscroll_bar
, "scroll-bar");
6576 DEFSYM (Qmenu
, "menu");
6577 DEFSYM (Qcursor
, "cursor");
6578 DEFSYM (Qborder
, "border");
6579 DEFSYM (Qmouse
, "mouse");
6580 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6581 DEFSYM (Qvertical_border
, "vertical-border");
6582 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6583 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6584 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6585 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6586 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6588 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6589 staticpro (&Vparam_value_alist
);
6590 Vface_alternative_font_family_alist
= Qnil
;
6591 staticpro (&Vface_alternative_font_family_alist
);
6592 Vface_alternative_font_registry_alist
= Qnil
;
6593 staticpro (&Vface_alternative_font_registry_alist
);
6595 defsubr (&Sinternal_make_lisp_face
);
6596 defsubr (&Sinternal_lisp_face_p
);
6597 defsubr (&Sinternal_set_lisp_face_attribute
);
6598 #ifdef HAVE_WINDOW_SYSTEM
6599 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6601 defsubr (&Scolor_gray_p
);
6602 defsubr (&Scolor_supported_p
);
6603 #ifndef HAVE_X_WINDOWS
6604 defsubr (&Sx_load_color_file
);
6606 defsubr (&Sface_attribute_relative_p
);
6607 defsubr (&Smerge_face_attribute
);
6608 defsubr (&Sinternal_get_lisp_face_attribute
);
6609 defsubr (&Sinternal_lisp_face_attribute_values
);
6610 defsubr (&Sinternal_lisp_face_equal_p
);
6611 defsubr (&Sinternal_lisp_face_empty_p
);
6612 defsubr (&Sinternal_copy_lisp_face
);
6613 defsubr (&Sinternal_merge_in_global_face
);
6614 defsubr (&Sface_font
);
6615 defsubr (&Sframe_face_alist
);
6616 defsubr (&Sdisplay_supports_face_attributes_p
);
6617 defsubr (&Scolor_distance
);
6618 defsubr (&Sinternal_set_font_selection_order
);
6619 defsubr (&Sinternal_set_alternative_font_family_alist
);
6620 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6621 defsubr (&Sface_attributes_as_vector
);
6623 defsubr (&Sdump_face
);
6624 defsubr (&Sshow_face_resources
);
6625 #endif /* GLYPH_DEBUG */
6626 defsubr (&Sclear_face_cache
);
6627 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6629 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6630 defsubr (&Sdump_colors
);
6633 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6634 doc
: /* Limit for font matching.
6635 If an integer > 0, font matching functions won't load more than
6636 that number of fonts when searching for a matching font. */);
6637 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6639 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6640 doc
: /* List of global face definitions (for internal use only.) */);
6641 Vface_new_frame_defaults
= Qnil
;
6643 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6644 doc
: /* Default stipple pattern used on monochrome displays.
6645 This stipple pattern is used on monochrome displays
6646 instead of shades of gray for a face background color.
6647 See `set-face-stipple' for possible values for this variable. */);
6648 Vface_default_stipple
= make_pure_c_string ("gray3");
6650 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6651 doc
: /* An alist of defined terminal colors and their RGB values.
6652 See the docstring of `tty-color-alist' for the details. */);
6653 Vtty_defined_color_alist
= Qnil
;
6655 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6656 doc
: /* Allowed scalable fonts.
6657 A value of nil means don't allow any scalable fonts.
6658 A value of t means allow any scalable font.
6659 Otherwise, value must be a list of regular expressions. A font may be
6660 scaled if its name matches a regular expression in the list.
6661 Note that if value is nil, a scalable font might still be used, if no
6662 other font of the appropriate family and registry is available. */);
6663 Vscalable_fonts_allowed
= Qnil
;
6665 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6666 doc
: /* List of ignored fonts.
6667 Each element is a regular expression that matches names of fonts to
6669 Vface_ignored_fonts
= Qnil
;
6671 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6672 doc
: /* Alist of face remappings.
6673 Each element is of the form:
6675 (FACE . REPLACEMENT),
6677 which causes display of the face FACE to use REPLACEMENT instead.
6678 REPLACEMENT is a face specification, i.e. one of the following:
6681 (2) a property list of attribute/value pairs, or
6682 (3) a list in which each element has the form of (1) or (2).
6684 List values for REPLACEMENT are merged to form the final face
6685 specification, with earlier entries taking precedence, in the same as
6686 as in the `face' text property.
6688 Face-name remapping cycles are suppressed; recursive references use
6689 the underlying face instead of the remapped face. So a remapping of
6692 (FACE EXTRA-FACE... FACE)
6696 (FACE (FACE-ATTR VAL ...) FACE)
6698 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6699 existing definition of FACE. Note that this isn't necessary for the
6700 default face, since every face inherits from the default face.
6702 If this variable is made buffer-local, the face remapping takes effect
6703 only in that buffer. For instance, the mode my-mode could define a
6704 face `my-mode-default', and then in the mode setup function, do:
6706 (set (make-local-variable 'face-remapping-alist)
6707 '((default my-mode-default)))).
6709 Because Emacs normally only redraws screen areas when the underlying
6710 buffer contents change, you may need to call `redraw-display' after
6711 changing this variable for it to take effect. */);
6712 Vface_remapping_alist
= Qnil
;
6714 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6715 doc
: /* Alist of fonts vs the rescaling factors.
6716 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6717 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6718 RESCALE-RATIO is a floating point number to specify how much larger
6719 \(or smaller) font we should use. For instance, if a face requests
6720 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6721 Vface_font_rescale_alist
= Qnil
;
6723 #ifdef HAVE_WINDOW_SYSTEM
6724 defsubr (&Sbitmap_spec_p
);
6725 defsubr (&Sx_list_fonts
);
6726 defsubr (&Sinternal_face_x_get_resource
);
6727 defsubr (&Sx_family_fonts
);