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 */
228 #ifdef HAVE_WINDOW_SYSTEM
232 #undef FRAME_X_DISPLAY_INFO
233 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
234 #define x_display_info w32_display_info
235 #define check_x check_w32
236 #define GCGraphicsExposures 0
237 #endif /* HAVE_NTGUI */
240 #undef FRAME_X_DISPLAY_INFO
241 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
242 #define x_display_info ns_display_info
243 #define check_x check_ns
244 #define GCGraphicsExposures 0
246 #endif /* HAVE_WINDOW_SYSTEM */
249 #include "dispextern.h"
250 #include "blockinput.h"
252 #include "intervals.h"
253 #include "termchar.h"
257 #ifdef HAVE_X_WINDOWS
259 /* Compensate for a bug in Xos.h on some systems, on which it requires
260 time.h. On some such systems, Xos.h tries to redefine struct
261 timeval and struct timezone if USG is #defined while it is
264 #ifdef XOS_NEEDS_TIME_H
270 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
272 #else /* not XOS_NEEDS_TIME_H */
274 #endif /* not XOS_NEEDS_TIME_H */
276 #endif /* HAVE_X_WINDOWS */
280 /* Number of pt per inch (from the TeXbook). */
282 #define PT_PER_INCH 72.27
284 /* Non-zero if face attribute ATTR is unspecified. */
286 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
288 /* Non-zero if face attribute ATTR is `ignore-defface'. */
290 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
292 /* Value is the number of elements of VECTOR. */
294 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
296 /* Size of hash table of realized faces in face caches (should be a
299 #define FACE_CACHE_BUCKETS_SIZE 1001
301 /* Keyword symbols used for face attribute names. */
303 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
304 static Lisp_Object QCunderline
;
305 static Lisp_Object QCinverse_video
, QCstipple
;
306 Lisp_Object QCforeground
, QCbackground
;
308 static Lisp_Object QCfont
, QCbold
, QCitalic
;
309 static Lisp_Object QCreverse_video
;
310 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
311 static Lisp_Object QCfontset
;
313 /* Symbols used for attribute values. */
317 static Lisp_Object Qline
, Qwave
;
318 Lisp_Object Qultra_light
, Qextra_light
, Qlight
;
319 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
320 Lisp_Object Qoblique
, Qreverse_oblique
, Qreverse_italic
;
322 static Lisp_Object Qultra_condensed
, Qextra_condensed
;
323 Lisp_Object Qcondensed
;
324 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qextra_expanded
;
325 Lisp_Object Qexpanded
;
326 static Lisp_Object Qultra_expanded
;
327 static Lisp_Object Qreleased_button
, Qpressed_button
;
328 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
329 Lisp_Object Qunspecified
; /* used in dosfns.c */
330 static Lisp_Object QCignore_defface
;
332 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
334 /* The name of the function to call when the background of the frame
335 has changed, frame_set_background_mode. */
337 static Lisp_Object Qframe_set_background_mode
;
339 /* Names of basic faces. */
341 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
342 static Lisp_Object Qregion
;
343 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
344 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
345 Lisp_Object Qmode_line_inactive
;
346 static Lisp_Object Qvertical_border
;
348 /* The symbol `face-alias'. A symbols having that property is an
349 alias for another face. Value of the property is the name of
352 static Lisp_Object Qface_alias
;
354 /* Alist of alternative font families. Each element is of the form
355 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
356 try FAMILY1, then FAMILY2, ... */
358 Lisp_Object Vface_alternative_font_family_alist
;
360 /* Alist of alternative font registries. Each element is of the form
361 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
362 loaded, try REGISTRY1, then REGISTRY2, ... */
364 Lisp_Object Vface_alternative_font_registry_alist
;
366 /* Allowed scalable fonts. A value of nil means don't allow any
367 scalable fonts. A value of t means allow the use of any scalable
368 font. Otherwise, value must be a list of regular expressions. A
369 font may be scaled if its name matches a regular expression in the
372 static Lisp_Object Qscalable_fonts_allowed
;
374 #define DEFAULT_FONT_LIST_LIMIT 100
376 /* The symbols `foreground-color' and `background-color' which can be
377 used as part of a `face' property. This is for compatibility with
380 Lisp_Object Qforeground_color
, Qbackground_color
;
382 /* The symbols `face' and `mouse-face' used as text properties. */
386 /* Property for basic faces which other faces cannot inherit. */
388 static Lisp_Object Qface_no_inherit
;
390 /* Error symbol for wrong_type_argument in load_pixmap. */
392 static Lisp_Object Qbitmap_spec_p
;
394 /* The next ID to assign to Lisp faces. */
396 static int next_lface_id
;
398 /* A vector mapping Lisp face Id's to face names. */
400 static Lisp_Object
*lface_id_to_name
;
401 static ptrdiff_t lface_id_to_name_size
;
403 /* TTY color-related functions (defined in tty-colors.el). */
405 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
407 /* The name of the function used to compute colors on TTYs. */
409 static Lisp_Object Qtty_color_alist
;
411 /* Counter for calls to clear_face_cache. If this counter reaches
412 CLEAR_FONT_TABLE_COUNT, and a frame has more than
413 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
415 static int clear_font_table_count
;
416 #define CLEAR_FONT_TABLE_COUNT 100
417 #define CLEAR_FONT_TABLE_NFONTS 10
419 /* Non-zero means face attributes have been changed since the last
420 redisplay. Used in redisplay_internal. */
422 int face_change_count
;
424 /* Non-zero means don't display bold text if a face's foreground
425 and background colors are the inverse of the default colors of the
426 display. This is a kluge to suppress `bold black' foreground text
427 which is hard to read on an LCD monitor. */
429 static int tty_suppress_bold_inverse_default_colors_p
;
431 /* A list of the form `((x . y))' used to avoid consing in
432 Finternal_set_lisp_face_attribute. */
434 static Lisp_Object Vparam_value_alist
;
436 /* The total number of colors currently allocated. */
439 static int ncolors_allocated
;
440 static int npixmaps_allocated
;
444 /* Non-zero means the definition of the `menu' face for new frames has
447 static int menu_face_changed_default
;
450 /* Function prototypes. */
453 struct named_merge_point
;
455 static void map_tty_color (struct frame
*, struct face
*,
456 enum lface_attribute_index
, int *);
457 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
458 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
459 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
460 int, struct named_merge_point
*);
461 static ptrdiff_t load_pixmap (struct frame
*, Lisp_Object
,
462 unsigned *, unsigned *);
463 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
464 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
465 static void free_face_colors (struct frame
*, struct face
*);
466 static int face_color_gray_p (struct frame
*, const char *);
467 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
469 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
471 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
472 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
473 static int realize_basic_faces (struct frame
*);
474 static int realize_default_face (struct frame
*);
475 static void realize_named_face (struct frame
*, Lisp_Object
, int);
476 static int lface_fully_specified_p (Lisp_Object
*);
477 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
478 static unsigned hash_string_case_insensitive (Lisp_Object
);
479 static unsigned lface_hash (Lisp_Object
*);
480 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
481 static struct face_cache
*make_face_cache (struct frame
*);
482 static void clear_face_gcs (struct face_cache
*);
483 static void free_face_cache (struct face_cache
*);
484 static int face_fontset (Lisp_Object
*);
485 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
486 struct named_merge_point
*);
487 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
488 int, struct named_merge_point
*);
489 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
491 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
492 static struct face
*make_realized_face (Lisp_Object
*);
493 static void cache_face (struct face_cache
*, struct face
*, unsigned);
494 static void uncache_face (struct face_cache
*, struct face
*);
496 #ifdef HAVE_WINDOW_SYSTEM
498 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
499 static void x_free_gc (struct frame
*, GC
);
502 static void x_update_menu_appearance (struct frame
*);
504 extern void free_frame_menubar (struct frame
*);
505 #endif /* USE_X_TOOLKIT */
507 #endif /* HAVE_WINDOW_SYSTEM */
510 /***********************************************************************
512 ***********************************************************************/
514 #ifdef HAVE_X_WINDOWS
516 #ifdef DEBUG_X_COLORS
518 /* The following is a poor mans infrastructure for debugging X color
519 allocation problems on displays with PseudoColor-8. Some X servers
520 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
521 color reference counts completely so that they don't signal an
522 error when a color is freed whose reference count is already 0.
523 Other X servers do. To help me debug this, the following code
524 implements a simple reference counting schema of its own, for a
525 single display/screen. --gerd. */
527 /* Reference counts for pixel colors. */
529 int color_count
[256];
531 /* Register color PIXEL as allocated. */
534 register_color (unsigned long pixel
)
536 eassert (pixel
< 256);
537 ++color_count
[pixel
];
541 /* Register color PIXEL as deallocated. */
544 unregister_color (unsigned long pixel
)
546 eassert (pixel
< 256);
547 if (color_count
[pixel
] > 0)
548 --color_count
[pixel
];
554 /* Register N colors from PIXELS as deallocated. */
557 unregister_colors (unsigned long *pixels
, int n
)
560 for (i
= 0; i
< n
; ++i
)
561 unregister_color (pixels
[i
]);
565 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
566 doc
: /* Dump currently allocated colors to stderr. */)
571 fputc ('\n', stderr
);
573 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
576 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
579 fputc ('\n', stderr
);
581 fputc ('\t', stderr
);
585 fputc ('\n', stderr
);
589 #endif /* DEBUG_X_COLORS */
592 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
593 color values. Interrupt input must be blocked when this function
597 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
599 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
601 /* If display has an immutable color map, freeing colors is not
602 necessary and some servers don't allow it. So don't do it. */
603 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
605 #ifdef DEBUG_X_COLORS
606 unregister_colors (pixels
, npixels
);
608 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
616 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
617 color values. Interrupt input must be blocked when this function
621 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
622 long unsigned int *pixels
, int npixels
)
624 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
625 int class = dpyinfo
->visual
->class;
627 /* If display has an immutable color map, freeing colors is not
628 necessary and some servers don't allow it. So don't do it. */
629 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
631 #ifdef DEBUG_X_COLORS
632 unregister_colors (pixels
, npixels
);
634 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
637 #endif /* USE_X_TOOLKIT */
639 /* Create and return a GC for use on frame F. GC values and mask
640 are given by XGCV and MASK. */
643 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
647 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
654 /* Free GC which was used on frame F. */
657 x_free_gc (struct frame
*f
, GC gc
)
659 eassert (interrupt_input_blocked
);
660 IF_DEBUG (eassert (--ngcs
>= 0));
661 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
664 #endif /* HAVE_X_WINDOWS */
667 /* W32 emulation of GCs */
670 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
674 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
681 /* Free GC which was used on frame F. */
684 x_free_gc (struct frame
*f
, GC gc
)
686 IF_DEBUG (eassert (--ngcs
>= 0));
690 #endif /* HAVE_NTGUI */
693 /* NS emulation of GCs */
696 x_create_gc (struct frame
*f
,
700 GC gc
= xmalloc (sizeof *gc
);
701 memcpy (gc
, xgcv
, sizeof (XGCValues
));
706 x_free_gc (struct frame
*f
, GC gc
)
712 /* If FRAME is nil, return a pointer to the selected frame.
713 Otherwise, check that FRAME is a live frame, and return a pointer
714 to it. NPARAM is the parameter number of FRAME, for
715 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
716 Lisp function definitions. */
718 static inline struct frame
*
719 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
722 frame
= selected_frame
;
724 CHECK_LIVE_FRAME (frame
);
725 return XFRAME (frame
);
729 /***********************************************************************
731 ***********************************************************************/
733 /* Initialize face cache and basic faces for frame F. */
736 init_frame_faces (struct frame
*f
)
738 /* Make a face cache, if F doesn't have one. */
739 if (FRAME_FACE_CACHE (f
) == NULL
)
740 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
742 #ifdef HAVE_WINDOW_SYSTEM
743 /* Make the image cache. */
744 if (FRAME_WINDOW_P (f
))
746 /* We initialize the image cache when creating the first frame
747 on a terminal, and not during terminal creation. This way,
748 `x-open-connection' on a tty won't create an image cache. */
749 if (FRAME_IMAGE_CACHE (f
) == NULL
)
750 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
751 ++FRAME_IMAGE_CACHE (f
)->refcount
;
753 #endif /* HAVE_WINDOW_SYSTEM */
755 /* Realize basic faces. Must have enough information in frame
756 parameters to realize basic faces at this point. */
757 #ifdef HAVE_X_WINDOWS
758 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
761 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
764 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
766 if (!realize_basic_faces (f
))
771 /* Free face cache of frame F. Called from delete_frame. */
774 free_frame_faces (struct frame
*f
)
776 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
780 free_face_cache (face_cache
);
781 FRAME_FACE_CACHE (f
) = NULL
;
784 #ifdef HAVE_WINDOW_SYSTEM
785 if (FRAME_WINDOW_P (f
))
787 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
790 --image_cache
->refcount
;
791 if (image_cache
->refcount
== 0)
792 free_image_cache (f
);
795 #endif /* HAVE_WINDOW_SYSTEM */
799 /* Clear face caches, and recompute basic faces for frame F. Call
800 this after changing frame parameters on which those faces depend,
801 or when realized faces have been freed due to changing attributes
805 recompute_basic_faces (struct frame
*f
)
807 if (FRAME_FACE_CACHE (f
))
809 clear_face_cache (0);
810 if (!realize_basic_faces (f
))
816 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
817 try to free unused fonts, too. */
820 clear_face_cache (int clear_fonts_p
)
822 #ifdef HAVE_WINDOW_SYSTEM
823 Lisp_Object tail
, frame
;
826 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
829 /* Not yet implemented. */
830 clear_font_cache (frame
);
833 /* From time to time see if we can unload some fonts. This also
834 frees all realized faces on all frames. Fonts needed by
835 faces will be loaded again when faces are realized again. */
836 clear_font_table_count
= 0;
838 FOR_EACH_FRAME (tail
, frame
)
840 struct frame
*f
= XFRAME (frame
);
841 if (FRAME_WINDOW_P (f
)
842 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
843 free_all_realized_faces (frame
);
848 /* Clear GCs of realized faces. */
849 FOR_EACH_FRAME (tail
, frame
)
851 struct frame
*f
= XFRAME (frame
);
852 if (FRAME_WINDOW_P (f
))
853 clear_face_gcs (FRAME_FACE_CACHE (f
));
855 clear_image_caches (Qnil
);
857 #endif /* HAVE_WINDOW_SYSTEM */
861 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
862 doc
: /* Clear face caches on all frames.
863 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
864 (Lisp_Object thoroughly
)
866 clear_face_cache (!NILP (thoroughly
));
868 ++windows_or_buffers_changed
;
873 /***********************************************************************
875 ***********************************************************************/
877 #ifdef HAVE_WINDOW_SYSTEM
879 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
880 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
881 A bitmap specification is either a string, a file name, or a list
882 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
883 HEIGHT is its height, and DATA is a string containing the bits of
884 the pixmap. Bits are stored row by row, each row occupies
885 \(WIDTH + 7)/8 bytes. */)
890 if (STRINGP (object
))
891 /* If OBJECT is a string, it's a file name. */
893 else if (CONSP (object
))
895 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
896 HEIGHT must be ints > 0, and DATA must be string large
897 enough to hold a bitmap of the specified size. */
898 Lisp_Object width
, height
, data
;
900 height
= width
= data
= Qnil
;
904 width
= XCAR (object
);
905 object
= XCDR (object
);
908 height
= XCAR (object
);
909 object
= XCDR (object
);
911 data
= XCAR (object
);
916 && RANGED_INTEGERP (1, width
, INT_MAX
)
917 && RANGED_INTEGERP (1, height
, INT_MAX
))
919 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
921 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
926 return pixmap_p
? Qt
: Qnil
;
930 /* Load a bitmap according to NAME (which is either a file name or a
931 pixmap spec) for use on frame F. Value is the bitmap_id (see
932 xfns.c). If NAME is nil, return with a bitmap id of zero. If
933 bitmap cannot be loaded, display a message saying so, and return
934 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
935 if these pointers are not null. */
938 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
,
946 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
951 /* Decode a bitmap spec into a bitmap. */
956 w
= XINT (Fcar (name
));
957 h
= XINT (Fcar (Fcdr (name
)));
958 bits
= Fcar (Fcdr (Fcdr (name
)));
960 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
965 /* It must be a string -- a file name. */
966 bitmap_id
= x_create_bitmap_from_file (f
, name
);
972 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
983 ++npixmaps_allocated
;
986 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
989 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
995 #endif /* HAVE_WINDOW_SYSTEM */
999 /***********************************************************************
1001 ***********************************************************************/
1003 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1004 RGB_LIST should contain (at least) 3 lisp integers.
1005 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1008 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1010 #define PARSE_RGB_LIST_FIELD(field) \
1011 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1013 color->field = XINT (XCAR (rgb_list)); \
1014 rgb_list = XCDR (rgb_list); \
1019 PARSE_RGB_LIST_FIELD (red
);
1020 PARSE_RGB_LIST_FIELD (green
);
1021 PARSE_RGB_LIST_FIELD (blue
);
1027 /* Lookup on frame F the color described by the lisp string COLOR.
1028 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1029 non-zero, then the `standard' definition of the same color is
1033 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
1036 Lisp_Object frame
, color_desc
;
1038 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1041 XSETFRAME (frame
, f
);
1043 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1044 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1048 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1051 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1053 rgb
= XCDR (XCDR (color_desc
));
1054 if (! parse_rgb_list (rgb
, tty_color
))
1057 /* Should we fill in STD_COLOR too? */
1060 /* Default STD_COLOR to the same as TTY_COLOR. */
1061 *std_color
= *tty_color
;
1063 /* Do a quick check to see if the returned descriptor is
1064 actually _exactly_ equal to COLOR, otherwise we have to
1065 lookup STD_COLOR separately. If it's impossible to lookup
1066 a standard color, we just give up and use TTY_COLOR. */
1067 if ((!STRINGP (XCAR (color_desc
))
1068 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1069 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1071 /* Look up STD_COLOR separately. */
1072 rgb
= call1 (Qtty_color_standard_values
, color
);
1073 if (! parse_rgb_list (rgb
, std_color
))
1080 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1081 /* We were called early during startup, and the colors are not
1082 yet set up in tty-defined-color-alist. Don't return a failure
1083 indication, since this produces the annoying "Unable to
1084 load color" messages in the *Messages* buffer. */
1087 /* tty-color-desc seems to have returned a bad value. */
1091 /* A version of defined_color for non-X frames. */
1094 tty_defined_color (struct frame
*f
, const char *color_name
,
1095 XColor
*color_def
, int alloc
)
1100 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1102 color_def
->blue
= 0;
1103 color_def
->green
= 0;
1106 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1108 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1110 if (strcmp (color_name
, "unspecified-fg") == 0)
1111 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1112 else if (strcmp (color_name
, "unspecified-bg") == 0)
1113 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1116 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1123 /* Decide if color named COLOR_NAME is valid for the display
1124 associated with the frame F; if so, return the rgb values in
1125 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1127 This does the right thing for any type of frame. */
1130 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1133 if (!FRAME_WINDOW_P (f
))
1134 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1135 #ifdef HAVE_X_WINDOWS
1136 else if (FRAME_X_P (f
))
1137 return x_defined_color (f
, color_name
, color_def
, alloc
);
1140 else if (FRAME_W32_P (f
))
1141 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1144 else if (FRAME_NS_P (f
))
1145 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1152 /* Given the index IDX of a tty color on frame F, return its name, a
1156 tty_color_name (struct frame
*f
, int idx
)
1158 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1161 Lisp_Object coldesc
;
1163 XSETFRAME (frame
, f
);
1164 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1166 if (!NILP (coldesc
))
1167 return XCAR (coldesc
);
1170 /* We can have an MSDOG frame under -nw for a short window of
1171 opportunity before internal_terminal_init is called. DTRT. */
1172 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1173 return msdos_stdcolor_name (idx
);
1176 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1177 return build_string (unspecified_fg
);
1178 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1179 return build_string (unspecified_bg
);
1181 return Qunspecified
;
1185 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1188 The criterion implemented here is not a terribly sophisticated one. */
1191 face_color_gray_p (struct frame
*f
, const char *color_name
)
1196 if (defined_color (f
, color_name
, &color
, 0))
1197 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1198 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1200 ((eabs (color
.red
- color
.green
)
1201 < max (color
.red
, color
.green
) / 20)
1202 && (eabs (color
.green
- color
.blue
)
1203 < max (color
.green
, color
.blue
) / 20)
1204 && (eabs (color
.blue
- color
.red
)
1205 < max (color
.blue
, color
.red
) / 20)));
1213 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1214 BACKGROUND_P non-zero means the color will be used as background
1218 face_color_supported_p (struct frame
*f
, const char *color_name
,
1224 XSETFRAME (frame
, f
);
1226 #ifdef HAVE_WINDOW_SYSTEM
1228 ? (!NILP (Fxw_display_color_p (frame
))
1229 || xstrcasecmp (color_name
, "black") == 0
1230 || xstrcasecmp (color_name
, "white") == 0
1232 && face_color_gray_p (f
, color_name
))
1233 || (!NILP (Fx_display_grayscale_p (frame
))
1234 && face_color_gray_p (f
, color_name
)))
1237 tty_defined_color (f
, color_name
, ¬_used
, 0);
1241 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1242 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1243 FRAME specifies the frame and thus the display for interpreting COLOR.
1244 If FRAME is nil or omitted, use the selected frame. */)
1245 (Lisp_Object color
, Lisp_Object frame
)
1249 CHECK_STRING (color
);
1251 frame
= selected_frame
;
1253 CHECK_FRAME (frame
);
1255 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1259 DEFUN ("color-supported-p", Fcolor_supported_p
,
1260 Scolor_supported_p
, 1, 3, 0,
1261 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1262 BACKGROUND-P non-nil means COLOR is used as a background.
1263 Otherwise, this function tells whether it can be used as a foreground.
1264 If FRAME is nil or omitted, use the selected frame.
1265 COLOR must be a valid color name. */)
1266 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1270 CHECK_STRING (color
);
1272 frame
= selected_frame
;
1274 CHECK_FRAME (frame
);
1276 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1282 /* Load color with name NAME for use by face FACE on frame F.
1283 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1284 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1285 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1286 pixel color. If color cannot be loaded, display a message, and
1287 return the foreground, background or underline color of F, but
1288 record that fact in flags of the face so that we don't try to free
1292 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1293 enum lface_attribute_index target_index
)
1297 eassert (STRINGP (name
));
1298 eassert (target_index
== LFACE_FOREGROUND_INDEX
1299 || target_index
== LFACE_BACKGROUND_INDEX
1300 || target_index
== LFACE_UNDERLINE_INDEX
1301 || target_index
== LFACE_OVERLINE_INDEX
1302 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1303 || target_index
== LFACE_BOX_INDEX
);
1305 /* if the color map is full, defined_color will return a best match
1306 to the values in an existing cell. */
1307 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1309 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1311 switch (target_index
)
1313 case LFACE_FOREGROUND_INDEX
:
1314 face
->foreground_defaulted_p
= 1;
1315 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1318 case LFACE_BACKGROUND_INDEX
:
1319 face
->background_defaulted_p
= 1;
1320 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1323 case LFACE_UNDERLINE_INDEX
:
1324 face
->underline_defaulted_p
= 1;
1325 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1328 case LFACE_OVERLINE_INDEX
:
1329 face
->overline_color_defaulted_p
= 1;
1330 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1333 case LFACE_STRIKE_THROUGH_INDEX
:
1334 face
->strike_through_color_defaulted_p
= 1;
1335 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1338 case LFACE_BOX_INDEX
:
1339 face
->box_color_defaulted_p
= 1;
1340 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1349 ++ncolors_allocated
;
1356 #ifdef HAVE_WINDOW_SYSTEM
1358 /* Load colors for face FACE which is used on frame F. Colors are
1359 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1360 of ATTRS. If the background color specified is not supported on F,
1361 try to emulate gray colors with a stipple from Vface_default_stipple. */
1364 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1368 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1369 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1371 /* Swap colors if face is inverse-video. */
1372 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1380 /* Check for support for foreground, not for background because
1381 face_color_supported_p is smart enough to know that grays are
1382 "supported" as background because we are supposed to use stipple
1384 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1385 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1387 x_destroy_bitmap (f
, face
->stipple
);
1388 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1389 &face
->pixmap_w
, &face
->pixmap_h
);
1392 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1393 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1397 /* Free color PIXEL on frame F. */
1400 unload_color (struct frame
*f
, long unsigned int pixel
)
1402 #ifdef HAVE_X_WINDOWS
1406 x_free_colors (f
, &pixel
, 1);
1413 /* Free colors allocated for FACE. */
1416 free_face_colors (struct frame
*f
, struct face
*face
)
1418 /* PENDING(NS): need to do something here? */
1419 #ifdef HAVE_X_WINDOWS
1420 if (face
->colors_copied_bitwise_p
)
1425 if (!face
->foreground_defaulted_p
)
1427 x_free_colors (f
, &face
->foreground
, 1);
1428 IF_DEBUG (--ncolors_allocated
);
1431 if (!face
->background_defaulted_p
)
1433 x_free_colors (f
, &face
->background
, 1);
1434 IF_DEBUG (--ncolors_allocated
);
1437 if (face
->underline_p
1438 && !face
->underline_defaulted_p
)
1440 x_free_colors (f
, &face
->underline_color
, 1);
1441 IF_DEBUG (--ncolors_allocated
);
1444 if (face
->overline_p
1445 && !face
->overline_color_defaulted_p
)
1447 x_free_colors (f
, &face
->overline_color
, 1);
1448 IF_DEBUG (--ncolors_allocated
);
1451 if (face
->strike_through_p
1452 && !face
->strike_through_color_defaulted_p
)
1454 x_free_colors (f
, &face
->strike_through_color
, 1);
1455 IF_DEBUG (--ncolors_allocated
);
1458 if (face
->box
!= FACE_NO_BOX
1459 && !face
->box_color_defaulted_p
)
1461 x_free_colors (f
, &face
->box_color
, 1);
1462 IF_DEBUG (--ncolors_allocated
);
1466 #endif /* HAVE_X_WINDOWS */
1469 #endif /* HAVE_WINDOW_SYSTEM */
1473 /***********************************************************************
1475 ***********************************************************************/
1477 /* An enumerator for each field of an XLFD font name. */
1498 /* An enumerator for each possible slant value of a font. Taken from
1499 the XLFD specification. */
1507 XLFD_SLANT_REVERSE_ITALIC
,
1508 XLFD_SLANT_REVERSE_OBLIQUE
,
1512 /* Relative font weight according to XLFD documentation. */
1516 XLFD_WEIGHT_UNKNOWN
,
1517 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1518 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1519 XLFD_WEIGHT_LIGHT
, /* 30 */
1520 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1521 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1522 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1523 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1524 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1525 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1528 /* Relative proportionate width. */
1532 XLFD_SWIDTH_UNKNOWN
,
1533 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1534 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1535 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1536 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1537 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1538 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1539 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1540 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1541 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1544 /* Order by which font selection chooses fonts. The default values
1545 mean `first, find a best match for the font width, then for the
1546 font height, then for weight, then for slant.' This variable can be
1547 set via set-face-font-sort-order. */
1549 static int font_sort_order
[4];
1551 #ifdef HAVE_WINDOW_SYSTEM
1553 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1556 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1558 Lisp_Object
const *p1
= v1
;
1559 Lisp_Object
const *p2
= v2
;
1560 Lisp_Object font1
= *p1
;
1561 Lisp_Object font2
= *p2
;
1564 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1566 enum font_property_index idx
= font_props_for_sorting
[i
];
1567 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1570 if (idx
<= FONT_REGISTRY_INDEX
)
1573 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1575 result
= STRINGP (val2
) ? 1 : 0;
1579 if (INTEGERP (val1
))
1580 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1581 ? XINT (val1
) > XINT (val2
)
1584 result
= INTEGERP (val2
) ? 1 : 0;
1592 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1593 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1594 If FAMILY is omitted or nil, list all families.
1595 Otherwise, FAMILY must be a string, possibly containing wildcards
1597 If FRAME is omitted or nil, use the selected frame.
1598 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1599 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1600 FAMILY is the font family name. POINT-SIZE is the size of the
1601 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1602 width, weight and slant of the font. These symbols are the same as for
1603 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1604 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1605 giving the registry and encoding of the font.
1606 The result list is sorted according to the current setting of
1607 the face font sort order. */)
1608 (Lisp_Object family
, Lisp_Object frame
)
1610 Lisp_Object font_spec
, list
, *drivers
, vec
;
1611 ptrdiff_t i
, nfonts
;
1617 frame
= selected_frame
;
1618 CHECK_LIVE_FRAME (frame
);
1620 font_spec
= Ffont_spec (0, NULL
);
1623 CHECK_STRING (family
);
1624 font_parse_family_registry (family
, Qnil
, font_spec
);
1627 list
= font_list_entities (frame
, font_spec
);
1631 /* Sort the font entities. */
1632 for (i
= 0; i
< 4; i
++)
1633 switch (font_sort_order
[i
])
1636 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1637 case XLFD_POINT_SIZE
:
1638 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1640 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1642 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1644 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1645 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1646 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1647 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1649 ndrivers
= XINT (Flength (list
));
1650 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1651 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1652 drivers
[i
] = XCAR (list
);
1653 vec
= Fvconcat (ndrivers
, drivers
);
1654 nfonts
= ASIZE (vec
);
1656 qsort (XVECTOR (vec
)->contents
, nfonts
, word_size
,
1657 compare_fonts_by_sort_order
);
1660 for (i
= nfonts
- 1; i
>= 0; --i
)
1662 Lisp_Object font
= AREF (vec
, i
);
1663 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1665 Lisp_Object spacing
;
1667 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1668 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1669 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1670 XFRAME (frame
)->resy
);
1671 ASET (v
, 2, make_number (point
));
1672 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1673 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1674 spacing
= Ffont_get (font
, QCspacing
);
1675 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1676 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1677 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1679 result
= Fcons (v
, result
);
1686 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1687 doc
: /* Return a list of the names of available fonts matching PATTERN.
1688 If optional arguments FACE and FRAME are specified, return only fonts
1689 the same size as FACE on FRAME.
1691 PATTERN should be a string containing a font name in the XLFD,
1692 Fontconfig, or GTK format. A font name given in the XLFD format may
1693 contain wildcard characters:
1694 the * character matches any substring, and
1695 the ? character matches any single character.
1696 PATTERN is case-insensitive.
1698 The return value is a list of strings, suitable as arguments to
1701 Fonts Emacs can't use may or may not be excluded
1702 even if they match PATTERN and FACE.
1703 The optional fourth argument MAXIMUM sets a limit on how many
1704 fonts to match. The first MAXIMUM fonts are reported.
1705 The optional fifth argument WIDTH, if specified, is a number of columns
1706 occupied by a character of a font. In that case, return only fonts
1707 the WIDTH times as wide as FACE on FRAME. */)
1708 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1709 Lisp_Object maximum
, Lisp_Object width
)
1712 int size
, avgwidth
IF_LINT (= 0);
1715 CHECK_STRING (pattern
);
1717 if (! NILP (maximum
))
1718 CHECK_NATNUM (maximum
);
1721 CHECK_NUMBER (width
);
1723 /* We can't simply call check_x_frame because this function may be
1724 called before any frame is created. */
1726 frame
= selected_frame
;
1727 f
= frame_or_selected_frame (frame
, 2);
1728 if (! FRAME_WINDOW_P (f
))
1730 /* Perhaps we have not yet created any frame. */
1736 /* Determine the width standard for comparison with the fonts we find. */
1742 /* This is of limited utility since it works with character
1743 widths. Keep it for compatibility. --gerd. */
1744 int face_id
= lookup_named_face (f
, face
, 0);
1745 struct face
*width_face
= (face_id
< 0
1747 : FACE_FROM_ID (f
, face_id
));
1749 if (width_face
&& width_face
->font
)
1751 size
= width_face
->font
->pixel_size
;
1752 avgwidth
= width_face
->font
->average_width
;
1756 size
= FRAME_FONT (f
)->pixel_size
;
1757 avgwidth
= FRAME_FONT (f
)->average_width
;
1760 avgwidth
*= XINT (width
);
1764 Lisp_Object font_spec
;
1765 Lisp_Object args
[2], tail
;
1767 font_spec
= font_spec_from_name (pattern
);
1768 if (!FONTP (font_spec
))
1769 signal_error ("Invalid font name", pattern
);
1773 Ffont_put (font_spec
, QCsize
, make_number (size
));
1774 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1776 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1777 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1779 Lisp_Object font_entity
;
1781 font_entity
= XCAR (tail
);
1782 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1783 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1784 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1786 /* This is a scalable font. For backward compatibility,
1787 we set the specified size. */
1788 font_entity
= copy_font_spec (font_entity
);
1789 ASET (font_entity
, FONT_SIZE_INDEX
,
1790 AREF (font_spec
, FONT_SIZE_INDEX
));
1792 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1795 /* We don't have to check fontsets. */
1797 args
[1] = list_fontsets (f
, pattern
, size
);
1798 return Fnconc (2, args
);
1802 #endif /* HAVE_WINDOW_SYSTEM */
1805 /***********************************************************************
1807 ***********************************************************************/
1809 /* Access face attributes of face LFACE, a Lisp vector. */
1811 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1812 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1813 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1814 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1815 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1816 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1817 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1818 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1819 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1820 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1821 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1822 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1823 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1824 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1825 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1826 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1827 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1829 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1830 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1832 #define LFACEP(LFACE) \
1834 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1835 && EQ (AREF (LFACE, 0), Qface))
1840 /* Check consistency of Lisp face attribute vector ATTRS. */
1843 check_lface_attrs (Lisp_Object
*attrs
)
1845 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1846 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1847 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1848 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1849 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1850 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1851 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1852 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1853 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1854 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1855 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1856 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1857 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1858 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1859 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1860 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1861 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1862 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1863 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1864 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1865 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1866 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1867 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1868 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1869 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1870 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1871 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1872 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1873 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1874 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1875 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1876 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1877 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1878 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1879 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1880 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1881 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1882 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1883 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1884 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1885 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1886 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1887 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1888 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1889 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1890 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1891 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1892 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1893 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1894 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1895 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1896 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1897 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1898 #ifdef HAVE_WINDOW_SYSTEM
1899 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1900 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1901 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1902 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1903 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1904 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1905 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1906 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1907 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1908 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1913 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1916 check_lface (Lisp_Object lface
)
1920 eassert (LFACEP (lface
));
1921 check_lface_attrs (XVECTOR (lface
)->contents
);
1925 #else /* not GLYPH_DEBUG */
1927 #define check_lface_attrs(attrs) (void) 0
1928 #define check_lface(lface) (void) 0
1930 #endif /* GLYPH_DEBUG */
1934 /* Face-merge cycle checking. */
1936 enum named_merge_point_kind
1938 NAMED_MERGE_POINT_NORMAL
,
1939 NAMED_MERGE_POINT_REMAP
1942 /* A `named merge point' is simply a point during face-merging where we
1943 look up a face by name. We keep a stack of which named lookups we're
1944 currently processing so that we can easily detect cycles, using a
1945 linked- list of struct named_merge_point structures, typically
1946 allocated on the stack frame of the named lookup functions which are
1947 active (so no consing is required). */
1948 struct named_merge_point
1950 Lisp_Object face_name
;
1951 enum named_merge_point_kind named_merge_point_kind
;
1952 struct named_merge_point
*prev
;
1956 /* If a face merging cycle is detected for FACE_NAME, return 0,
1957 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1958 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1959 pointed to by NAMED_MERGE_POINTS, and return 1. */
1962 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1963 Lisp_Object face_name
,
1964 enum named_merge_point_kind named_merge_point_kind
,
1965 struct named_merge_point
**named_merge_points
)
1967 struct named_merge_point
*prev
;
1969 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1970 if (EQ (face_name
, prev
->face_name
))
1972 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1973 /* A cycle, so fail. */
1975 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1976 /* A remap `hides ' any previous normal merge points
1977 (because the remap means that it's actually different face),
1978 so as we know the current merge point must be normal, we
1979 can just assume it's OK. */
1983 new_named_merge_point
->face_name
= face_name
;
1984 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1985 new_named_merge_point
->prev
= *named_merge_points
;
1987 *named_merge_points
= new_named_merge_point
;
1993 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1994 to make it a symbol. If FACE_NAME is an alias for another face,
1995 return that face's name.
1997 Return default face in case of errors. */
2000 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2002 Lisp_Object orig_face
;
2003 Lisp_Object tortoise
, hare
;
2005 if (STRINGP (face_name
))
2006 face_name
= intern (SSDATA (face_name
));
2008 if (NILP (face_name
) || !SYMBOLP (face_name
))
2011 orig_face
= face_name
;
2012 tortoise
= hare
= face_name
;
2017 hare
= Fget (hare
, Qface_alias
);
2018 if (NILP (hare
) || !SYMBOLP (hare
))
2022 hare
= Fget (hare
, Qface_alias
);
2023 if (NILP (hare
) || !SYMBOLP (hare
))
2026 tortoise
= Fget (tortoise
, Qface_alias
);
2027 if (EQ (hare
, tortoise
))
2030 xsignal1 (Qcircular_list
, orig_face
);
2039 /* Return the face definition of FACE_NAME on frame F. F null means
2040 return the definition for new frames. FACE_NAME may be a string or
2041 a symbol (apparently Emacs 20.2 allowed strings as face names in
2042 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2043 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2044 is zero, value is nil if FACE_NAME is not a valid face name. */
2045 static inline Lisp_Object
2046 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
2052 lface
= assq_no_quit (face_name
, f
->face_alist
);
2054 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2057 lface
= XCDR (lface
);
2059 signal_error ("Invalid face", face_name
);
2061 check_lface (lface
);
2066 /* Return the face definition of FACE_NAME on frame F. F null means
2067 return the definition for new frames. FACE_NAME may be a string or
2068 a symbol (apparently Emacs 20.2 allowed strings as face names in
2069 face text properties; Ediff uses that). If FACE_NAME is an alias
2070 for another face, return that face's definition. If SIGNAL_P is
2071 non-zero, signal an error if FACE_NAME is not a valid face name.
2072 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2074 static inline Lisp_Object
2075 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2077 face_name
= resolve_face_name (face_name
, signal_p
);
2078 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2082 /* Get face attributes of face FACE_NAME from frame-local faces on
2083 frame F. Store the resulting attributes in ATTRS which must point
2084 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2085 is non-zero, signal an error if FACE_NAME does not name a face.
2086 Otherwise, value is zero if FACE_NAME is not a face. */
2089 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
2090 Lisp_Object
*attrs
, int signal_p
)
2094 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2097 memcpy (attrs
, XVECTOR (lface
)->contents
,
2098 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2100 return !NILP (lface
);
2103 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2104 F. Store the resulting attributes in ATTRS which must point to a
2105 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2106 alias for another face, use that face's definition. If SIGNAL_P is
2107 non-zero, signal an error if FACE_NAME does not name a face.
2108 Otherwise, value is zero if FACE_NAME is not a face. */
2111 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2112 Lisp_Object
*attrs
, int signal_p
,
2113 struct named_merge_point
*named_merge_points
)
2115 Lisp_Object face_remapping
;
2117 face_name
= resolve_face_name (face_name
, signal_p
);
2119 /* See if SYMBOL has been remapped to some other face (usually this
2120 is done buffer-locally). */
2121 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2122 if (CONSP (face_remapping
))
2124 struct named_merge_point named_merge_point
;
2126 if (push_named_merge_point (&named_merge_point
,
2127 face_name
, NAMED_MERGE_POINT_REMAP
,
2128 &named_merge_points
))
2132 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2133 attrs
[i
] = Qunspecified
;
2135 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2136 signal_p
, named_merge_points
);
2140 /* Default case, no remapping. */
2141 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2145 /* Non-zero if all attributes in face attribute vector ATTRS are
2146 specified, i.e. are non-nil. */
2149 lface_fully_specified_p (Lisp_Object
*attrs
)
2153 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2154 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2155 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2158 return i
== LFACE_VECTOR_SIZE
;
2161 #ifdef HAVE_WINDOW_SYSTEM
2163 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2164 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2165 exception is `font' attribute. It is set to FONT_OBJECT regardless
2169 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2170 Lisp_Object font_object
, int force_p
)
2173 struct font
*font
= XFONT_OBJECT (font_object
);
2175 /* Set attributes only if unspecified, otherwise face defaults for
2176 new frames would never take effect. If the font doesn't have a
2177 specific property, set a normal value for that. */
2179 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2181 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2183 ASET (lface
, LFACE_FAMILY_INDEX
, SYMBOL_NAME (family
));
2186 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2188 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2190 ASET (lface
, LFACE_FOUNDRY_INDEX
, SYMBOL_NAME (foundry
));
2193 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2195 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2198 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (pt
));
2201 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2203 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2204 ASET (lface
, LFACE_WEIGHT_INDEX
, ! NILP (val
) ? val
:Qnormal
);
2206 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2208 val
= FONT_SLANT_FOR_FACE (font_object
);
2209 ASET (lface
, LFACE_SLANT_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2211 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2213 val
= FONT_WIDTH_FOR_FACE (font_object
);
2214 ASET (lface
, LFACE_SWIDTH_INDEX
, ! NILP (val
) ? val
: Qnormal
);
2217 ASET (lface
, LFACE_FONT_INDEX
, font_object
);
2221 #endif /* HAVE_WINDOW_SYSTEM */
2224 /* Merges the face height FROM with the face height TO, and returns the
2225 merged height. If FROM is an invalid height, then INVALID is
2226 returned instead. FROM and TO may be either absolute face heights or
2227 `relative' heights; the returned value is always an absolute height
2228 unless both FROM and TO are relative. */
2231 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2233 Lisp_Object result
= invalid
;
2235 if (INTEGERP (from
))
2236 /* FROM is absolute, just use it as is. */
2238 else if (FLOATP (from
))
2239 /* FROM is a scale, use it to adjust TO. */
2242 /* relative X absolute => absolute */
2243 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2244 else if (FLOATP (to
))
2245 /* relative X relative => relative */
2246 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2247 else if (UNSPECIFIEDP (to
))
2250 else if (FUNCTIONP (from
))
2251 /* FROM is a function, which use to adjust TO. */
2253 /* Call function with current height as argument.
2254 From is the new height. */
2255 result
= safe_call1 (from
, to
);
2257 /* Ensure that if TO was absolute, so is the result. */
2258 if (INTEGERP (to
) && !INTEGERP (result
))
2266 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2267 store the resulting attributes in TO, which must be already be
2268 completely specified and contain only absolute attributes. Every
2269 specified attribute of FROM overrides the corresponding attribute of
2270 TO; relative attributes in FROM are merged with the absolute value in
2271 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2272 loops in face inheritance/remapping; it should be 0 when called from
2276 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2277 struct named_merge_point
*named_merge_points
)
2280 Lisp_Object font
= Qnil
;
2282 /* If FROM inherits from some other faces, merge their attributes into
2283 TO before merging FROM's direct attributes. Note that an :inherit
2284 attribute of `unspecified' is the same as one of nil; we never
2285 merge :inherit attributes, so nil is more correct, but lots of
2286 other code uses `unspecified' as a generic value for face attributes. */
2287 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2288 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2289 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2291 if (FONT_SPEC_P (from
[LFACE_FONT_INDEX
]))
2293 if (!UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2294 font
= merge_font_spec (from
[LFACE_FONT_INDEX
], to
[LFACE_FONT_INDEX
]);
2296 font
= copy_font_spec (from
[LFACE_FONT_INDEX
]);
2297 to
[LFACE_FONT_INDEX
] = font
;
2300 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2301 if (!UNSPECIFIEDP (from
[i
]))
2303 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2305 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2306 font_clear_prop (to
, FONT_SIZE_INDEX
);
2308 else if (i
!= LFACE_FONT_INDEX
&& ! EQ (to
[i
], from
[i
]))
2311 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2312 font_clear_prop (to
,
2313 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2314 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2315 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2316 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2317 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2318 : FONT_SLANT_INDEX
));
2322 /* If FROM specifies a font spec, make its contents take precedence
2323 over :family and other attributes. This is needed for face
2324 remapping using :font to work. */
2328 if (! NILP (AREF (font
, FONT_FOUNDRY_INDEX
)))
2329 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FOUNDRY_INDEX
));
2330 if (! NILP (AREF (font
, FONT_FAMILY_INDEX
)))
2331 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (font
, FONT_FAMILY_INDEX
));
2332 if (! NILP (AREF (font
, FONT_WEIGHT_INDEX
)))
2333 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (font
);
2334 if (! NILP (AREF (font
, FONT_SLANT_INDEX
)))
2335 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (font
);
2336 if (! NILP (AREF (font
, FONT_WIDTH_INDEX
)))
2337 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (font
);
2338 ASET (font
, FONT_SIZE_INDEX
, Qnil
);
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_WINDOW_SYSTEM)
2565 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2566 if (!NILP (pixmap_p
))
2567 to
[LFACE_STIPPLE_INDEX
] = value
;
2570 #endif /* HAVE_WINDOW_SYSTEM */
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
, QCfont
))
2585 to
[LFACE_FONT_INDEX
] = value
;
2589 else if (EQ (keyword
, QCinherit
))
2591 /* This is not really very useful; it's just like a
2592 normal face reference. */
2593 if (! merge_face_ref (f
, value
, to
,
2594 err_msgs
, named_merge_points
))
2602 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2606 face_ref
= XCDR (XCDR (face_ref
));
2611 /* This is a list of face refs. Those at the beginning of the
2612 list take precedence over what follows, so we have to merge
2613 from the end backwards. */
2614 Lisp_Object next
= XCDR (face_ref
);
2617 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2619 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2625 /* FACE_REF ought to be a face name. */
2626 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2627 if (!ok
&& err_msgs
)
2628 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2635 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2636 Sinternal_make_lisp_face
, 1, 2, 0,
2637 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2638 If FACE was not known as a face before, create a new one.
2639 If optional argument FRAME is specified, make a frame-local face
2640 for that frame. Otherwise operate on the global face definition.
2641 Value is a vector of face attributes. */)
2642 (Lisp_Object face
, Lisp_Object frame
)
2644 Lisp_Object global_lface
, lface
;
2648 CHECK_SYMBOL (face
);
2649 global_lface
= lface_from_face_name (NULL
, face
, 0);
2653 CHECK_LIVE_FRAME (frame
);
2655 lface
= lface_from_face_name (f
, face
, 0);
2658 f
= NULL
, lface
= Qnil
;
2660 /* Add a global definition if there is none. */
2661 if (NILP (global_lface
))
2663 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2665 ASET (global_lface
, 0, Qface
);
2666 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2667 Vface_new_frame_defaults
);
2669 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2670 face id to Lisp face is given by the vector lface_id_to_name.
2671 The mapping from Lisp face to Lisp face id is given by the
2672 property `face' of the Lisp face name. */
2673 if (next_lface_id
== lface_id_to_name_size
)
2675 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2676 sizeof *lface_id_to_name
);
2678 lface_id_to_name
[next_lface_id
] = face
;
2679 Fput (face
, Qface
, make_number (next_lface_id
));
2683 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2684 ASET (global_lface
, i
, Qunspecified
);
2686 /* Add a frame-local definition. */
2691 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2693 ASET (lface
, 0, Qface
);
2694 fset_face_alist (f
, Fcons (Fcons (face
, lface
), f
->face_alist
));
2697 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2698 ASET (lface
, i
, Qunspecified
);
2701 lface
= global_lface
;
2703 /* Changing a named face means that all realized faces depending on
2704 that face are invalid. Since we cannot tell which realized faces
2705 depend on the face, make sure they are all removed. This is done
2706 by incrementing face_change_count. The next call to
2707 init_iterator will then free realized faces. */
2708 if (NILP (Fget (face
, Qface_no_inherit
)))
2710 ++face_change_count
;
2711 ++windows_or_buffers_changed
;
2714 eassert (LFACEP (lface
));
2715 check_lface (lface
);
2720 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2721 Sinternal_lisp_face_p
, 1, 2, 0,
2722 doc
: /* Return non-nil if FACE names a face.
2723 FACE should be a symbol or string.
2724 If optional second argument FRAME is non-nil, check for the
2725 existence of a frame-local face with name FACE on that frame.
2726 Otherwise check for the existence of a global face. */)
2727 (Lisp_Object face
, Lisp_Object frame
)
2731 face
= resolve_face_name (face
, 1);
2735 CHECK_LIVE_FRAME (frame
);
2736 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2739 lface
= lface_from_face_name (NULL
, face
, 0);
2745 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2746 Sinternal_copy_lisp_face
, 4, 4, 0,
2747 doc
: /* Copy face FROM to TO.
2748 If FRAME is t, copy the global face definition of FROM.
2749 Otherwise, copy the frame-local definition of FROM on FRAME.
2750 If NEW-FRAME is a frame, copy that data into the frame-local
2751 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2752 FRAME controls where the data is copied to.
2754 The value is TO. */)
2755 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2757 Lisp_Object lface
, copy
;
2759 CHECK_SYMBOL (from
);
2764 /* Copy global definition of FROM. We don't make copies of
2765 strings etc. because 20.2 didn't do it either. */
2766 lface
= lface_from_face_name (NULL
, from
, 1);
2767 copy
= Finternal_make_lisp_face (to
, Qnil
);
2771 /* Copy frame-local definition of FROM. */
2772 if (NILP (new_frame
))
2774 CHECK_LIVE_FRAME (frame
);
2775 CHECK_LIVE_FRAME (new_frame
);
2776 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2777 copy
= Finternal_make_lisp_face (to
, new_frame
);
2780 vcopy (copy
, 0, XVECTOR (lface
)->contents
, LFACE_VECTOR_SIZE
);
2782 /* Changing a named face means that all realized faces depending on
2783 that face are invalid. Since we cannot tell which realized faces
2784 depend on the face, make sure they are all removed. This is done
2785 by incrementing face_change_count. The next call to
2786 init_iterator will then free realized faces. */
2787 if (NILP (Fget (to
, Qface_no_inherit
)))
2789 ++face_change_count
;
2790 ++windows_or_buffers_changed
;
2797 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2798 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2799 doc
: /* Set attribute ATTR of FACE to VALUE.
2800 FRAME being a frame means change the face on that frame.
2801 FRAME nil means change the face of the selected frame.
2802 FRAME t means change the default for new frames.
2803 FRAME 0 means change the face on all frames, and change the default
2805 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2808 Lisp_Object old_value
= Qnil
;
2809 /* Set one of enum font_property_index (> 0) if ATTR is one of
2810 font-related attributes other than QCfont and QCfontset. */
2811 enum font_property_index prop_index
= 0;
2813 CHECK_SYMBOL (face
);
2814 CHECK_SYMBOL (attr
);
2816 face
= resolve_face_name (face
, 1);
2818 /* If FRAME is 0, change face on all frames, and change the
2819 default for new frames. */
2820 if (INTEGERP (frame
) && XINT (frame
) == 0)
2823 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2824 FOR_EACH_FRAME (tail
, frame
)
2825 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2829 /* Set lface to the Lisp attribute vector of FACE. */
2832 lface
= lface_from_face_name (NULL
, face
, 1);
2834 /* When updating face-new-frame-defaults, we put :ignore-defface
2835 where the caller wants `unspecified'. This forces the frame
2836 defaults to ignore the defface value. Otherwise, the defface
2837 will take effect, which is generally not what is intended.
2838 The value of that attribute will be inherited from some other
2839 face during face merging. See internal_merge_in_global_face. */
2840 if (UNSPECIFIEDP (value
))
2841 value
= QCignore_defface
;
2846 frame
= selected_frame
;
2848 CHECK_LIVE_FRAME (frame
);
2849 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2851 /* If a frame-local face doesn't exist yet, create one. */
2853 lface
= Finternal_make_lisp_face (face
, frame
);
2856 if (EQ (attr
, QCfamily
))
2858 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2860 CHECK_STRING (value
);
2861 if (SCHARS (value
) == 0)
2862 signal_error ("Invalid face family", value
);
2864 old_value
= LFACE_FAMILY (lface
);
2865 ASET (lface
, LFACE_FAMILY_INDEX
, value
);
2866 prop_index
= FONT_FAMILY_INDEX
;
2868 else if (EQ (attr
, QCfoundry
))
2870 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2872 CHECK_STRING (value
);
2873 if (SCHARS (value
) == 0)
2874 signal_error ("Invalid face foundry", value
);
2876 old_value
= LFACE_FOUNDRY (lface
);
2877 ASET (lface
, LFACE_FOUNDRY_INDEX
, value
);
2878 prop_index
= FONT_FOUNDRY_INDEX
;
2880 else if (EQ (attr
, QCheight
))
2882 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2884 if (EQ (face
, Qdefault
))
2886 /* The default face must have an absolute size. */
2887 if (!INTEGERP (value
) || XINT (value
) <= 0)
2888 signal_error ("Default face height not absolute and positive",
2893 /* For non-default faces, do a test merge with a random
2894 height to see if VALUE's ok. */
2895 Lisp_Object test
= merge_face_heights (value
,
2898 if (!INTEGERP (test
) || XINT (test
) <= 0)
2899 signal_error ("Face height does not produce a positive integer",
2904 old_value
= LFACE_HEIGHT (lface
);
2905 ASET (lface
, LFACE_HEIGHT_INDEX
, value
);
2906 prop_index
= FONT_SIZE_INDEX
;
2908 else if (EQ (attr
, QCweight
))
2910 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2912 CHECK_SYMBOL (value
);
2913 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2914 signal_error ("Invalid face weight", value
);
2916 old_value
= LFACE_WEIGHT (lface
);
2917 ASET (lface
, LFACE_WEIGHT_INDEX
, value
);
2918 prop_index
= FONT_WEIGHT_INDEX
;
2920 else if (EQ (attr
, QCslant
))
2922 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2924 CHECK_SYMBOL (value
);
2925 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2926 signal_error ("Invalid face slant", value
);
2928 old_value
= LFACE_SLANT (lface
);
2929 ASET (lface
, LFACE_SLANT_INDEX
, value
);
2930 prop_index
= FONT_SLANT_INDEX
;
2932 else if (EQ (attr
, QCunderline
))
2936 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2938 else if (NILP (value
) || EQ (value
, Qt
))
2940 else if (STRINGP (value
) && SCHARS (value
) > 0)
2942 else if (CONSP (value
))
2944 Lisp_Object key
, val
, list
;
2949 while (!NILP (CAR_SAFE(list
)))
2951 key
= CAR_SAFE (list
);
2952 list
= CDR_SAFE (list
);
2953 val
= CAR_SAFE (list
);
2954 list
= CDR_SAFE (list
);
2956 if (NILP (key
) || NILP (val
))
2962 else if (EQ (key
, QCcolor
)
2963 && !(EQ (val
, Qforeground_color
)
2964 || (STRINGP (val
) && SCHARS (val
) > 0)))
2970 else if (EQ (key
, QCstyle
)
2971 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2980 signal_error ("Invalid face underline", value
);
2982 old_value
= LFACE_UNDERLINE (lface
);
2983 ASET (lface
, LFACE_UNDERLINE_INDEX
, value
);
2985 else if (EQ (attr
, QCoverline
))
2987 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2988 if ((SYMBOLP (value
)
2990 && !EQ (value
, Qnil
))
2991 /* Overline color. */
2993 && SCHARS (value
) == 0))
2994 signal_error ("Invalid face overline", value
);
2996 old_value
= LFACE_OVERLINE (lface
);
2997 ASET (lface
, LFACE_OVERLINE_INDEX
, value
);
2999 else if (EQ (attr
, QCstrike_through
))
3001 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3002 if ((SYMBOLP (value
)
3004 && !EQ (value
, Qnil
))
3005 /* Strike-through color. */
3007 && SCHARS (value
) == 0))
3008 signal_error ("Invalid face strike-through", value
);
3010 old_value
= LFACE_STRIKE_THROUGH (lface
);
3011 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, value
);
3013 else if (EQ (attr
, QCbox
))
3017 /* Allow t meaning a simple box of width 1 in foreground color
3020 value
= make_number (1);
3022 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3024 else if (NILP (value
))
3026 else if (INTEGERP (value
))
3027 valid_p
= XINT (value
) != 0;
3028 else if (STRINGP (value
))
3029 valid_p
= SCHARS (value
) > 0;
3030 else if (CONSP (value
))
3046 if (EQ (k
, QCline_width
))
3048 if (!INTEGERP (v
) || XINT (v
) == 0)
3051 else if (EQ (k
, QCcolor
))
3053 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3056 else if (EQ (k
, QCstyle
))
3058 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3065 valid_p
= NILP (tem
);
3071 signal_error ("Invalid face box", value
);
3073 old_value
= LFACE_BOX (lface
);
3074 ASET (lface
, LFACE_BOX_INDEX
, value
);
3076 else if (EQ (attr
, QCinverse_video
)
3077 || EQ (attr
, QCreverse_video
))
3079 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3081 CHECK_SYMBOL (value
);
3082 if (!EQ (value
, Qt
) && !NILP (value
))
3083 signal_error ("Invalid inverse-video face attribute value", value
);
3085 old_value
= LFACE_INVERSE (lface
);
3086 ASET (lface
, LFACE_INVERSE_INDEX
, value
);
3088 else if (EQ (attr
, QCforeground
))
3090 /* Compatibility with 20.x. */
3092 value
= Qunspecified
;
3093 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3095 /* Don't check for valid color names here because it depends
3096 on the frame (display) whether the color will be valid
3097 when the face is realized. */
3098 CHECK_STRING (value
);
3099 if (SCHARS (value
) == 0)
3100 signal_error ("Empty foreground color value", value
);
3102 old_value
= LFACE_FOREGROUND (lface
);
3103 ASET (lface
, LFACE_FOREGROUND_INDEX
, value
);
3105 else if (EQ (attr
, QCbackground
))
3107 /* Compatibility with 20.x. */
3109 value
= Qunspecified
;
3110 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3112 /* Don't check for valid color names here because it depends
3113 on the frame (display) whether the color will be valid
3114 when the face is realized. */
3115 CHECK_STRING (value
);
3116 if (SCHARS (value
) == 0)
3117 signal_error ("Empty background color value", value
);
3119 old_value
= LFACE_BACKGROUND (lface
);
3120 ASET (lface
, LFACE_BACKGROUND_INDEX
, value
);
3122 else if (EQ (attr
, QCstipple
))
3124 #if defined (HAVE_WINDOW_SYSTEM)
3125 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3127 && NILP (Fbitmap_spec_p (value
)))
3128 signal_error ("Invalid stipple attribute", value
);
3129 old_value
= LFACE_STIPPLE (lface
);
3130 ASET (lface
, LFACE_STIPPLE_INDEX
, value
);
3131 #endif /* HAVE_WINDOW_SYSTEM */
3133 else if (EQ (attr
, QCwidth
))
3135 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3137 CHECK_SYMBOL (value
);
3138 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3139 signal_error ("Invalid face width", value
);
3141 old_value
= LFACE_SWIDTH (lface
);
3142 ASET (lface
, LFACE_SWIDTH_INDEX
, value
);
3143 prop_index
= FONT_WIDTH_INDEX
;
3145 else if (EQ (attr
, QCfont
))
3147 #ifdef HAVE_WINDOW_SYSTEM
3148 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3150 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3154 old_value
= LFACE_FONT (lface
);
3155 if (! FONTP (value
))
3157 if (STRINGP (value
))
3159 Lisp_Object name
= value
;
3160 int fontset
= fs_query_fontset (name
, 0);
3163 name
= fontset_ascii (fontset
);
3164 value
= font_spec_from_name (name
);
3166 signal_error ("Invalid font name", name
);
3169 signal_error ("Invalid font or font-spec", value
);
3172 f
= XFRAME (selected_frame
);
3175 if (! FONT_OBJECT_P (value
))
3177 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3178 Lisp_Object font_object
;
3180 font_object
= font_load_for_lface (f
, attrs
, value
);
3181 if (NILP (font_object
))
3182 signal_error ("Font not available", value
);
3183 value
= font_object
;
3185 set_lface_from_font (f
, lface
, value
, 1);
3188 ASET (lface
, LFACE_FONT_INDEX
, value
);
3190 #endif /* HAVE_WINDOW_SYSTEM */
3192 else if (EQ (attr
, QCfontset
))
3194 #ifdef HAVE_WINDOW_SYSTEM
3195 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3199 old_value
= LFACE_FONTSET (lface
);
3200 tmp
= Fquery_fontset (value
, Qnil
);
3202 signal_error ("Invalid fontset name", value
);
3203 ASET (lface
, LFACE_FONTSET_INDEX
, value
= tmp
);
3205 #endif /* HAVE_WINDOW_SYSTEM */
3207 else if (EQ (attr
, QCinherit
))
3210 if (SYMBOLP (value
))
3213 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3214 if (!SYMBOLP (XCAR (tail
)))
3217 ASET (lface
, LFACE_INHERIT_INDEX
, value
);
3219 signal_error ("Invalid face inheritance", value
);
3221 else if (EQ (attr
, QCbold
))
3223 old_value
= LFACE_WEIGHT (lface
);
3224 ASET (lface
, LFACE_WEIGHT_INDEX
, NILP (value
) ? Qnormal
: Qbold
);
3225 prop_index
= FONT_WEIGHT_INDEX
;
3227 else if (EQ (attr
, QCitalic
))
3230 old_value
= LFACE_SLANT (lface
);
3231 ASET (lface
, LFACE_SLANT_INDEX
, NILP (value
) ? Qnormal
: Qitalic
);
3232 prop_index
= FONT_SLANT_INDEX
;
3235 signal_error ("Invalid face attribute name", attr
);
3239 /* If a font-related attribute other than QCfont and QCfontset
3240 is specified, and if the original QCfont attribute has a font
3241 (font-spec or font-object), set the corresponding property in
3242 the font to nil so that the font selector doesn't think that
3243 the attribute is mandatory. Also, clear the average
3245 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3248 /* Changing a named face means that all realized faces depending on
3249 that face are invalid. Since we cannot tell which realized faces
3250 depend on the face, make sure they are all removed. This is done
3251 by incrementing face_change_count. The next call to
3252 init_iterator will then free realized faces. */
3254 && NILP (Fget (face
, Qface_no_inherit
))
3255 && NILP (Fequal (old_value
, value
)))
3257 ++face_change_count
;
3258 ++windows_or_buffers_changed
;
3261 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3262 && NILP (Fequal (old_value
, value
)))
3268 if (EQ (face
, Qdefault
))
3270 #ifdef HAVE_WINDOW_SYSTEM
3271 /* Changed font-related attributes of the `default' face are
3272 reflected in changed `font' frame parameters. */
3274 && (prop_index
|| EQ (attr
, QCfont
))
3275 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3276 set_font_frame_param (frame
, lface
);
3278 #endif /* HAVE_WINDOW_SYSTEM */
3280 if (EQ (attr
, QCforeground
))
3281 param
= Qforeground_color
;
3282 else if (EQ (attr
, QCbackground
))
3283 param
= Qbackground_color
;
3285 #ifdef HAVE_WINDOW_SYSTEM
3287 else if (EQ (face
, Qscroll_bar
))
3289 /* Changing the colors of `scroll-bar' sets frame parameters
3290 `scroll-bar-foreground' and `scroll-bar-background'. */
3291 if (EQ (attr
, QCforeground
))
3292 param
= Qscroll_bar_foreground
;
3293 else if (EQ (attr
, QCbackground
))
3294 param
= Qscroll_bar_background
;
3296 #endif /* not HAVE_NTGUI */
3297 else if (EQ (face
, Qborder
))
3299 /* Changing background color of `border' sets frame parameter
3301 if (EQ (attr
, QCbackground
))
3302 param
= Qborder_color
;
3304 else if (EQ (face
, Qcursor
))
3306 /* Changing background color of `cursor' sets frame parameter
3308 if (EQ (attr
, QCbackground
))
3309 param
= Qcursor_color
;
3311 else if (EQ (face
, Qmouse
))
3313 /* Changing background color of `mouse' sets frame parameter
3315 if (EQ (attr
, QCbackground
))
3316 param
= Qmouse_color
;
3318 #endif /* HAVE_WINDOW_SYSTEM */
3319 else if (EQ (face
, Qmenu
))
3321 /* Indicate that we have to update the menu bar when
3322 realizing faces on FRAME. FRAME t change the
3323 default for new frames. We do this by setting
3324 setting the flag in new face caches */
3327 struct frame
*f
= XFRAME (frame
);
3328 if (FRAME_FACE_CACHE (f
) == NULL
)
3329 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3330 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3333 menu_face_changed_default
= 1;
3339 /* Update `default-frame-alist', which is used for new frames. */
3341 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3344 /* Update the current frame's parameters. */
3347 cons
= XCAR (Vparam_value_alist
);
3348 XSETCAR (cons
, param
);
3349 XSETCDR (cons
, value
);
3350 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3359 /* Update the corresponding face when frame parameter PARAM on frame F
3360 has been assigned the value NEW_VALUE. */
3363 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3364 Lisp_Object new_value
)
3366 Lisp_Object face
= Qnil
;
3369 /* If there are no faces yet, give up. This is the case when called
3370 from Fx_create_frame, and we do the necessary things later in
3371 face-set-after-frame-defaults. */
3372 if (NILP (f
->face_alist
))
3375 if (EQ (param
, Qforeground_color
))
3378 lface
= lface_from_face_name (f
, face
, 1);
3379 ASET (lface
, LFACE_FOREGROUND_INDEX
,
3380 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3381 realize_basic_faces (f
);
3383 else if (EQ (param
, Qbackground_color
))
3387 /* Changing the background color might change the background
3388 mode, so that we have to load new defface specs.
3389 Call frame-set-background-mode to do that. */
3390 XSETFRAME (frame
, f
);
3391 call1 (Qframe_set_background_mode
, frame
);
3394 lface
= lface_from_face_name (f
, face
, 1);
3395 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3396 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3397 realize_basic_faces (f
);
3399 #ifdef HAVE_WINDOW_SYSTEM
3400 else if (EQ (param
, Qborder_color
))
3403 lface
= lface_from_face_name (f
, face
, 1);
3404 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3405 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3407 else if (EQ (param
, Qcursor_color
))
3410 lface
= lface_from_face_name (f
, face
, 1);
3411 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3412 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3414 else if (EQ (param
, Qmouse_color
))
3417 lface
= lface_from_face_name (f
, face
, 1);
3418 ASET (lface
, LFACE_BACKGROUND_INDEX
,
3419 (STRINGP (new_value
) ? new_value
: Qunspecified
));
3423 /* Changing a named face means that all realized faces depending on
3424 that face are invalid. Since we cannot tell which realized faces
3425 depend on the face, make sure they are all removed. This is done
3426 by incrementing face_change_count. The next call to
3427 init_iterator will then free realized faces. */
3429 && NILP (Fget (face
, Qface_no_inherit
)))
3431 ++face_change_count
;
3432 ++windows_or_buffers_changed
;
3437 #ifdef HAVE_WINDOW_SYSTEM
3439 /* Set the `font' frame parameter of FRAME determined from the
3440 font-object set in `default' face attributes LFACE. */
3443 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3445 struct frame
*f
= XFRAME (frame
);
3448 if (FRAME_WINDOW_P (f
)
3449 /* Don't do anything if the font is `unspecified'. This can
3450 happen during frame creation. */
3451 && (font
= LFACE_FONT (lface
),
3452 ! UNSPECIFIEDP (font
)))
3454 if (FONT_SPEC_P (font
))
3456 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3459 ASET (lface
, LFACE_FONT_INDEX
, font
);
3461 f
->default_face_done_p
= 0;
3462 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3467 /* Get the value of X resource RESOURCE, class CLASS for the display
3468 of frame FRAME. This is here because ordinary `x-get-resource'
3469 doesn't take a frame argument. */
3471 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3472 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3473 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3475 Lisp_Object value
= Qnil
;
3476 CHECK_STRING (resource
);
3477 CHECK_STRING (class);
3478 CHECK_LIVE_FRAME (frame
);
3480 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3481 resource
, class, Qnil
, Qnil
);
3487 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3488 If VALUE is "on" or "true", return t. If VALUE is "off" or
3489 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3490 error; if SIGNAL_P is zero, return 0. */
3493 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3495 Lisp_Object result
= make_number (0);
3497 eassert (STRINGP (value
));
3499 if (xstrcasecmp (SSDATA (value
), "on") == 0
3500 || xstrcasecmp (SSDATA (value
), "true") == 0)
3502 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3503 || xstrcasecmp (SSDATA (value
), "false") == 0)
3505 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3506 result
= Qunspecified
;
3508 signal_error ("Invalid face attribute value from X resource", value
);
3514 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3515 Finternal_set_lisp_face_attribute_from_resource
,
3516 Sinternal_set_lisp_face_attribute_from_resource
,
3517 3, 4, 0, doc
: /* */)
3518 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3520 CHECK_SYMBOL (face
);
3521 CHECK_SYMBOL (attr
);
3522 CHECK_STRING (value
);
3524 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3525 value
= Qunspecified
;
3526 else if (EQ (attr
, QCheight
))
3528 value
= Fstring_to_number (value
, make_number (10));
3529 if (XINT (value
) <= 0)
3530 signal_error ("Invalid face height from X resource", value
);
3532 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3533 value
= face_boolean_x_resource_value (value
, 1);
3534 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3535 value
= intern (SSDATA (value
));
3536 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3537 value
= face_boolean_x_resource_value (value
, 1);
3538 else if (EQ (attr
, QCunderline
)
3539 || EQ (attr
, QCoverline
)
3540 || EQ (attr
, QCstrike_through
))
3542 Lisp_Object boolean_value
;
3544 /* If the result of face_boolean_x_resource_value is t or nil,
3545 VALUE does NOT specify a color. */
3546 boolean_value
= face_boolean_x_resource_value (value
, 0);
3547 if (SYMBOLP (boolean_value
))
3548 value
= boolean_value
;
3550 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3551 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3553 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3556 #endif /* HAVE_WINDOW_SYSTEM */
3559 /***********************************************************************
3561 ***********************************************************************/
3563 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3565 /* Make menus on frame F appear as specified by the `menu' face. */
3568 x_update_menu_appearance (struct frame
*f
)
3570 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3574 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3579 ptrdiff_t bufsize
= sizeof line
;
3580 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3581 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3582 const char *myname
= SSDATA (Vx_resource_name
);
3585 const char *popup_path
= "popup_menu";
3587 const char *popup_path
= "menu.popup";
3590 if (STRINGP (LFACE_FOREGROUND (lface
)))
3592 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3594 SDATA (LFACE_FOREGROUND (lface
)));
3595 XrmPutLineResource (&rdb
, line
);
3596 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3597 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3598 XrmPutLineResource (&rdb
, line
);
3602 if (STRINGP (LFACE_BACKGROUND (lface
)))
3604 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3606 SDATA (LFACE_BACKGROUND (lface
)));
3607 XrmPutLineResource (&rdb
, line
);
3609 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3610 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3611 XrmPutLineResource (&rdb
, line
);
3616 /* On Solaris 5.8, it's been reported that the `menu' face
3617 can be unspecified here, during startup. Why this
3618 happens remains unknown. -- cyd */
3619 && FONTP (LFACE_FONT (lface
))
3620 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3621 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3622 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3623 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3624 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3625 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3627 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3629 const char *suffix
= "List";
3632 #if defined HAVE_X_I18N
3634 const char *suffix
= "Set";
3636 const char *suffix
= "";
3643 #if defined HAVE_X_I18N
3644 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3646 char *fontsetname
= SSDATA (xlfd
);
3648 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3649 myname
, suffix
, fontsetname
);
3650 XrmPutLineResource (&rdb
, line
);
3652 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3653 myname
, popup_path
, suffix
, fontsetname
);
3654 XrmPutLineResource (&rdb
, line
);
3656 if (fontsetname
!= SSDATA (xlfd
))
3657 xfree (fontsetname
);
3661 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3662 free_frame_menubar (f
);
3669 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3672 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3673 Sface_attribute_relative_p
,
3675 doc
: /* Check whether a face attribute value is relative.
3676 Specifically, this function returns t if the attribute ATTRIBUTE
3677 with the value VALUE is relative.
3679 A relative value is one that doesn't entirely override whatever is
3680 inherited from another face. For most possible attributes,
3681 the only relative value that users see is `unspecified'.
3682 However, for :height, floating point values are also relative. */)
3683 (Lisp_Object attribute
, Lisp_Object value
)
3685 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3687 else if (EQ (attribute
, QCheight
))
3688 return INTEGERP (value
) ? Qnil
: Qt
;
3693 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3695 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3696 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3697 the result will be absolute, otherwise it will be relative. */)
3698 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3700 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3702 else if (EQ (attribute
, QCheight
))
3703 return merge_face_heights (value1
, value2
, value1
);
3709 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3710 Sinternal_get_lisp_face_attribute
,
3712 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3713 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3714 face attribute name, signal an error.
3715 If the optional argument FRAME is given, report on face SYMBOL in that
3716 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3717 frames). If FRAME is omitted or nil, use the selected frame. */)
3718 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3720 Lisp_Object lface
, value
= Qnil
;
3722 CHECK_SYMBOL (symbol
);
3723 CHECK_SYMBOL (keyword
);
3726 lface
= lface_from_face_name (NULL
, symbol
, 1);
3730 frame
= selected_frame
;
3731 CHECK_LIVE_FRAME (frame
);
3732 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3735 if (EQ (keyword
, QCfamily
))
3736 value
= LFACE_FAMILY (lface
);
3737 else if (EQ (keyword
, QCfoundry
))
3738 value
= LFACE_FOUNDRY (lface
);
3739 else if (EQ (keyword
, QCheight
))
3740 value
= LFACE_HEIGHT (lface
);
3741 else if (EQ (keyword
, QCweight
))
3742 value
= LFACE_WEIGHT (lface
);
3743 else if (EQ (keyword
, QCslant
))
3744 value
= LFACE_SLANT (lface
);
3745 else if (EQ (keyword
, QCunderline
))
3746 value
= LFACE_UNDERLINE (lface
);
3747 else if (EQ (keyword
, QCoverline
))
3748 value
= LFACE_OVERLINE (lface
);
3749 else if (EQ (keyword
, QCstrike_through
))
3750 value
= LFACE_STRIKE_THROUGH (lface
);
3751 else if (EQ (keyword
, QCbox
))
3752 value
= LFACE_BOX (lface
);
3753 else if (EQ (keyword
, QCinverse_video
)
3754 || EQ (keyword
, QCreverse_video
))
3755 value
= LFACE_INVERSE (lface
);
3756 else if (EQ (keyword
, QCforeground
))
3757 value
= LFACE_FOREGROUND (lface
);
3758 else if (EQ (keyword
, QCbackground
))
3759 value
= LFACE_BACKGROUND (lface
);
3760 else if (EQ (keyword
, QCstipple
))
3761 value
= LFACE_STIPPLE (lface
);
3762 else if (EQ (keyword
, QCwidth
))
3763 value
= LFACE_SWIDTH (lface
);
3764 else if (EQ (keyword
, QCinherit
))
3765 value
= LFACE_INHERIT (lface
);
3766 else if (EQ (keyword
, QCfont
))
3767 value
= LFACE_FONT (lface
);
3768 else if (EQ (keyword
, QCfontset
))
3769 value
= LFACE_FONTSET (lface
);
3771 signal_error ("Invalid face attribute name", keyword
);
3773 if (IGNORE_DEFFACE_P (value
))
3774 return Qunspecified
;
3780 DEFUN ("internal-lisp-face-attribute-values",
3781 Finternal_lisp_face_attribute_values
,
3782 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3783 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3784 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3787 Lisp_Object result
= Qnil
;
3789 CHECK_SYMBOL (attr
);
3791 if (EQ (attr
, QCunderline
))
3792 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3793 else if (EQ (attr
, QCoverline
))
3794 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3795 else if (EQ (attr
, QCstrike_through
))
3796 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3797 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3798 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3804 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3805 Sinternal_merge_in_global_face
, 2, 2, 0,
3806 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3807 Default face attributes override any local face attributes. */)
3808 (Lisp_Object face
, Lisp_Object frame
)
3811 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3812 struct frame
*f
= XFRAME (frame
);
3814 CHECK_LIVE_FRAME (frame
);
3815 global_lface
= lface_from_face_name (NULL
, face
, 1);
3816 local_lface
= lface_from_face_name (f
, face
, 0);
3817 if (NILP (local_lface
))
3818 local_lface
= Finternal_make_lisp_face (face
, frame
);
3820 /* Make every specified global attribute override the local one.
3821 BEWARE!! This is only used from `face-set-after-frame-default' where
3822 the local frame is defined from default specs in `face-defface-spec'
3823 and those should be overridden by global settings. Hence the strange
3824 "global before local" priority. */
3825 lvec
= XVECTOR (local_lface
)->contents
;
3826 gvec
= XVECTOR (global_lface
)->contents
;
3827 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3828 if (IGNORE_DEFFACE_P (gvec
[i
]))
3829 ASET (local_lface
, i
, Qunspecified
);
3830 else if (! UNSPECIFIEDP (gvec
[i
]))
3831 ASET (local_lface
, i
, AREF (global_lface
, i
));
3833 /* If the default face was changed, update the face cache and the
3834 `font' frame parameter. */
3835 if (EQ (face
, Qdefault
))
3837 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3838 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3839 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3841 /* This can be NULL (e.g., in batch mode). */
3844 /* Ensure that the face vector is fully specified by merging
3845 the previously-cached vector. */
3846 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3847 merge_face_vectors (f
, lvec
, attrs
, 0);
3848 vcopy (local_lface
, 0, attrs
, LFACE_VECTOR_SIZE
);
3849 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3851 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3852 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3853 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3854 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3855 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3856 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3857 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3860 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3861 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3865 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3866 Fmodify_frame_parameters (frame
,
3867 Fcons (Fcons (Qforeground_color
,
3868 gvec
[LFACE_FOREGROUND_INDEX
]),
3871 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3872 Fmodify_frame_parameters (frame
,
3873 Fcons (Fcons (Qbackground_color
,
3874 gvec
[LFACE_BACKGROUND_INDEX
]),
3883 /* The following function is implemented for compatibility with 20.2.
3884 The function is used in x-resolve-fonts when it is asked to
3885 return fonts with the same size as the font of a face. This is
3886 done in fontset.el. */
3888 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3889 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3890 The font name is, by default, for ASCII characters.
3891 If the optional argument FRAME is given, report on face FACE in that frame.
3892 If FRAME is t, report on the defaults for face FACE (for new frames).
3893 The font default for a face is either nil, or a list
3894 of the form (bold), (italic) or (bold italic).
3895 If FRAME is omitted or nil, use the selected frame. And, in this case,
3896 if the optional third argument CHARACTER is given,
3897 return the font name used for CHARACTER. */)
3898 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3902 Lisp_Object result
= Qnil
;
3903 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3905 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3906 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3907 result
= Fcons (Qbold
, result
);
3909 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3910 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3911 result
= Fcons (Qitalic
, result
);
3917 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3918 int face_id
= lookup_named_face (f
, face
, 1);
3919 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3923 #ifdef HAVE_WINDOW_SYSTEM
3924 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3926 CHECK_CHARACTER (character
);
3927 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3928 fface
= FACE_FROM_ID (f
, face_id
);
3931 ? fface
->font
->props
[FONT_NAME_INDEX
]
3933 #else /* !HAVE_WINDOW_SYSTEM */
3934 return build_string (FRAME_MSDOS_P (f
)
3936 : FRAME_W32_P (f
) ? "w32term"
3943 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3944 all attributes are `equal'. Tries to be fast because this function
3945 is called quite often. */
3948 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3950 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3951 and the other is specified. */
3952 if (XTYPE (v1
) != XTYPE (v2
))
3961 if (SBYTES (v1
) != SBYTES (v2
))
3964 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3971 return !NILP (Fequal (v1
, v2
));
3976 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3977 all attributes are `equal'. Tries to be fast because this function
3978 is called quite often. */
3981 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3985 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3986 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3992 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3993 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3994 doc
: /* True if FACE1 and FACE2 are equal.
3995 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3996 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3997 If FRAME is omitted or nil, use the selected frame. */)
3998 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
4002 Lisp_Object lface1
, lface2
;
4007 /* Don't use check_x_frame here because this function is called
4008 before X frames exist. At that time, if FRAME is nil,
4009 selected_frame will be used which is the frame dumped with
4010 Emacs. That frame is not an X frame. */
4011 f
= frame_or_selected_frame (frame
, 2);
4013 lface1
= lface_from_face_name (f
, face1
, 1);
4014 lface2
= lface_from_face_name (f
, face2
, 1);
4015 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4016 XVECTOR (lface2
)->contents
);
4017 return equal_p
? Qt
: Qnil
;
4021 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4022 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4023 doc
: /* True if FACE has no attribute specified.
4024 If the optional argument FRAME is given, report on face FACE in that frame.
4025 If FRAME is t, report on the defaults for face FACE (for new frames).
4026 If FRAME is omitted or nil, use the selected frame. */)
4027 (Lisp_Object face
, Lisp_Object frame
)
4034 frame
= selected_frame
;
4035 CHECK_LIVE_FRAME (frame
);
4039 lface
= lface_from_face_name (NULL
, face
, 1);
4041 lface
= lface_from_face_name (f
, face
, 1);
4043 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4044 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4047 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4051 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4053 doc
: /* Return an alist of frame-local faces defined on FRAME.
4054 For internal use only. */)
4057 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4058 return f
->face_alist
;
4062 /* Return a hash code for Lisp string STRING with case ignored. Used
4063 below in computing a hash value for a Lisp face. */
4065 static inline unsigned
4066 hash_string_case_insensitive (Lisp_Object string
)
4068 const unsigned char *s
;
4070 eassert (STRINGP (string
));
4071 for (s
= SDATA (string
); *s
; ++s
)
4072 hash
= (hash
<< 1) ^ c_tolower (*s
);
4077 /* Return a hash code for face attribute vector V. */
4079 static inline unsigned
4080 lface_hash (Lisp_Object
*v
)
4082 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4083 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4084 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4085 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4086 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4087 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4088 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4089 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4093 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4094 considering charsets/registries). They do if they specify the same
4095 family, point size, weight, width, slant, and font. Both
4096 LFACE1 and LFACE2 must be fully-specified. */
4099 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4101 eassert (lface_fully_specified_p (lface1
)
4102 && lface_fully_specified_p (lface2
));
4103 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4104 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4105 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4106 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4107 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4108 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4109 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4110 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4111 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4112 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4113 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4114 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4115 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4116 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4122 /***********************************************************************
4124 ***********************************************************************/
4126 /* Allocate and return a new realized face for Lisp face attribute
4129 static struct face
*
4130 make_realized_face (Lisp_Object
*attr
)
4132 struct face
*face
= xzalloc (sizeof *face
);
4133 face
->ascii_face
= face
;
4134 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4139 /* Free realized face FACE, including its X resources. FACE may
4143 free_realized_face (struct frame
*f
, struct face
*face
)
4147 #ifdef HAVE_WINDOW_SYSTEM
4148 if (FRAME_WINDOW_P (f
))
4150 /* Free fontset of FACE if it is ASCII face. */
4151 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4152 free_face_fontset (f
, face
);
4157 font_done_for_face (f
, face
);
4158 x_free_gc (f
, face
->gc
);
4163 free_face_colors (f
, face
);
4164 x_destroy_bitmap (f
, face
->stipple
);
4166 #endif /* HAVE_WINDOW_SYSTEM */
4173 /* Prepare face FACE for subsequent display on frame F. This
4174 allocated GCs if they haven't been allocated yet or have been freed
4175 by clearing the face cache. */
4178 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4180 #ifdef HAVE_WINDOW_SYSTEM
4181 eassert (FRAME_WINDOW_P (f
));
4186 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4188 xgcv
.foreground
= face
->foreground
;
4189 xgcv
.background
= face
->background
;
4190 #ifdef HAVE_X_WINDOWS
4191 xgcv
.graphics_exposures
= False
;
4195 #ifdef HAVE_X_WINDOWS
4198 xgcv
.fill_style
= FillOpaqueStippled
;
4199 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4200 mask
|= GCFillStyle
| GCStipple
;
4203 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4205 font_prepare_for_face (f
, face
);
4208 #endif /* HAVE_WINDOW_SYSTEM */
4212 /* Returns the `distance' between the colors X and Y. */
4215 color_distance (XColor
*x
, XColor
*y
)
4217 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4218 Quoting from that paper:
4220 This formula has results that are very close to L*u*v* (with the
4221 modified lightness curve) and, more importantly, it is a more even
4222 algorithm: it does not have a range of colors where it suddenly
4223 gives far from optimal results.
4225 See <http://www.compuphase.com/cmetric.htm> for more info. */
4227 long r
= (x
->red
- y
->red
) >> 8;
4228 long g
= (x
->green
- y
->green
) >> 8;
4229 long b
= (x
->blue
- y
->blue
) >> 8;
4230 long r_mean
= (x
->red
+ y
->red
) >> 9;
4233 (((512 + r_mean
) * r
* r
) >> 8)
4235 + (((767 - r_mean
) * b
* b
) >> 8);
4239 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4240 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4241 COLOR1 and COLOR2 may be either strings containing the color name,
4242 or lists of the form (RED GREEN BLUE).
4243 If FRAME is unspecified or nil, the current frame is used. */)
4244 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4247 XColor cdef1
, cdef2
;
4250 frame
= selected_frame
;
4251 CHECK_LIVE_FRAME (frame
);
4254 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4255 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4256 signal_error ("Invalid color", color1
);
4257 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4258 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4259 signal_error ("Invalid color", color2
);
4261 return make_number (color_distance (&cdef1
, &cdef2
));
4265 /***********************************************************************
4267 ***********************************************************************/
4269 /* Return a new face cache for frame F. */
4271 static struct face_cache
*
4272 make_face_cache (struct frame
*f
)
4274 struct face_cache
*c
;
4277 c
= xzalloc (sizeof *c
);
4278 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4279 c
->buckets
= xzalloc (size
);
4281 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4283 c
->menu_face_changed_p
= menu_face_changed_default
;
4288 /* Clear out all graphics contexts for all realized faces, except for
4289 the basic faces. This should be done from time to time just to avoid
4290 keeping too many graphics contexts that are no longer needed. */
4293 clear_face_gcs (struct face_cache
*c
)
4295 if (c
&& FRAME_WINDOW_P (c
->f
))
4297 #ifdef HAVE_WINDOW_SYSTEM
4299 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4301 struct face
*face
= c
->faces_by_id
[i
];
4302 if (face
&& face
->gc
)
4306 font_done_for_face (c
->f
, face
);
4307 x_free_gc (c
->f
, face
->gc
);
4312 #endif /* HAVE_WINDOW_SYSTEM */
4317 /* Free all realized faces in face cache C, including basic faces.
4318 C may be null. If faces are freed, make sure the frame's current
4319 matrix is marked invalid, so that a display caused by an expose
4320 event doesn't try to use faces we destroyed. */
4323 free_realized_faces (struct face_cache
*c
)
4328 struct frame
*f
= c
->f
;
4330 /* We must block input here because we can't process X events
4331 safely while only some faces are freed, or when the frame's
4332 current matrix still references freed faces. */
4335 for (i
= 0; i
< c
->used
; ++i
)
4337 free_realized_face (f
, c
->faces_by_id
[i
]);
4338 c
->faces_by_id
[i
] = NULL
;
4342 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4343 memset (c
->buckets
, 0, size
);
4345 /* Must do a thorough redisplay the next time. Mark current
4346 matrices as invalid because they will reference faces freed
4347 above. This function is also called when a frame is
4348 destroyed. In this case, the root window of F is nil. */
4349 if (WINDOWP (f
->root_window
))
4351 clear_current_matrices (f
);
4352 ++windows_or_buffers_changed
;
4360 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4361 This is done after attributes of a named face have been changed,
4362 because we can't tell which realized faces depend on that face. */
4365 free_all_realized_faces (Lisp_Object frame
)
4370 FOR_EACH_FRAME (rest
, frame
)
4371 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4374 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4378 /* Free face cache C and faces in it, including their X resources. */
4381 free_face_cache (struct face_cache
*c
)
4385 free_realized_faces (c
);
4387 xfree (c
->faces_by_id
);
4393 /* Cache realized face FACE in face cache C. HASH is the hash value
4394 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4395 FACE), insert the new face to the beginning of the collision list
4396 of the face hash table of C. Otherwise, add the new face to the
4397 end of the collision list. This way, lookup_face can quickly find
4398 that a requested face is not cached. */
4401 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4403 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4407 if (face
->ascii_face
!= face
)
4409 struct face
*last
= c
->buckets
[i
];
4420 c
->buckets
[i
] = face
;
4421 face
->prev
= face
->next
= NULL
;
4427 face
->next
= c
->buckets
[i
];
4429 face
->next
->prev
= face
;
4430 c
->buckets
[i
] = face
;
4433 /* Find a free slot in C->faces_by_id and use the index of the free
4434 slot as FACE->id. */
4435 for (i
= 0; i
< c
->used
; ++i
)
4436 if (c
->faces_by_id
[i
] == NULL
)
4441 /* Check that FACE got a unique id. */
4446 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4447 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4453 #endif /* GLYPH_DEBUG */
4455 /* Maybe enlarge C->faces_by_id. */
4458 if (c
->used
== c
->size
)
4459 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4460 sizeof *c
->faces_by_id
);
4464 c
->faces_by_id
[i
] = face
;
4468 /* Remove face FACE from cache C. */
4471 uncache_face (struct face_cache
*c
, struct face
*face
)
4473 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4476 face
->prev
->next
= face
->next
;
4478 c
->buckets
[i
] = face
->next
;
4481 face
->next
->prev
= face
->prev
;
4483 c
->faces_by_id
[face
->id
] = NULL
;
4484 if (face
->id
== c
->used
)
4489 /* Look up a realized face with face attributes ATTR in the face cache
4490 of frame F. The face will be used to display ASCII characters.
4491 Value is the ID of the face found. If no suitable face is found,
4492 realize a new one. */
4495 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4497 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4502 eassert (cache
!= NULL
);
4503 check_lface_attrs (attr
);
4505 /* Look up ATTR in the face cache. */
4506 hash
= lface_hash (attr
);
4507 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4509 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4511 if (face
->ascii_face
!= face
)
4513 /* There's no more ASCII face. */
4517 if (face
->hash
== hash
4518 && lface_equal_p (face
->lface
, attr
))
4522 /* If not found, realize a new face. */
4524 face
= realize_face (cache
, attr
, -1);
4527 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4528 #endif /* GLYPH_DEBUG */
4533 #ifdef HAVE_WINDOW_SYSTEM
4534 /* Look up a realized face that has the same attributes as BASE_FACE
4535 except for the font in the face cache of frame F. If FONT-OBJECT
4536 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4537 the face has no font. Value is the ID of the face found. If no
4538 suitable face is found, realize a new one. */
4541 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4543 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4548 eassert (cache
!= NULL
);
4549 base_face
= base_face
->ascii_face
;
4550 hash
= lface_hash (base_face
->lface
);
4551 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4553 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4555 if (face
->ascii_face
== face
)
4557 if (face
->ascii_face
== base_face
4558 && face
->font
== (NILP (font_object
) ? NULL
4559 : XFONT_OBJECT (font_object
))
4560 && lface_equal_p (face
->lface
, base_face
->lface
))
4564 /* If not found, realize a new face. */
4565 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4568 #endif /* HAVE_WINDOW_SYSTEM */
4570 /* Return the face id of the realized face for named face SYMBOL on
4571 frame F suitable for displaying ASCII characters. Value is -1 if
4572 the face couldn't be determined, which might happen if the default
4573 face isn't realized and cannot be realized. */
4576 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4578 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4579 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4580 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4582 if (default_face
== NULL
)
4584 if (!realize_basic_faces (f
))
4586 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4587 if (default_face
== NULL
)
4588 abort (); /* realize_basic_faces must have set it up */
4591 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4594 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4595 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4597 return lookup_face (f
, attrs
);
4601 /* Return the display face-id of the basic face whose canonical face-id
4602 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4603 basic face has bee remapped via Vface_remapping_alist. This function is
4604 conservative: if something goes wrong, it will simply return FACE_ID
4605 rather than signal an error. */
4608 lookup_basic_face (struct frame
*f
, int face_id
)
4610 Lisp_Object name
, mapping
;
4611 int remapped_face_id
;
4613 if (NILP (Vface_remapping_alist
))
4614 return face_id
; /* Nothing to do. */
4618 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4619 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4620 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4621 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4622 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4623 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4624 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4625 case BORDER_FACE_ID
: name
= Qborder
; break;
4626 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4627 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4628 case MENU_FACE_ID
: name
= Qmenu
; break;
4631 abort (); /* the caller is supposed to pass us a basic face id */
4634 /* Do a quick scan through Vface_remapping_alist, and return immediately
4635 if there is no remapping for face NAME. This is just an optimization
4636 for the very common no-remapping case. */
4637 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4639 return face_id
; /* Give up. */
4641 /* If there is a remapping entry, lookup the face using NAME, which will
4642 handle the remapping too. */
4643 remapped_face_id
= lookup_named_face (f
, name
, 0);
4644 if (remapped_face_id
< 0)
4645 return face_id
; /* Give up. */
4647 return remapped_face_id
;
4651 /* Return a face for charset ASCII that is like the face with id
4652 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4653 STEPS < 0 means larger. Value is the id of the face. */
4656 smaller_face (struct frame
*f
, int face_id
, int steps
)
4658 #ifdef HAVE_WINDOW_SYSTEM
4660 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4661 int pt
, last_pt
, last_height
;
4664 struct face
*new_face
;
4666 /* If not called for an X frame, just return the original face. */
4667 if (FRAME_TERMCAP_P (f
))
4670 /* Try in increments of 1/2 pt. */
4671 delta
= steps
< 0 ? 5 : -5;
4672 steps
= eabs (steps
);
4674 face
= FACE_FROM_ID (f
, face_id
);
4675 memcpy (attrs
, face
->lface
, sizeof attrs
);
4676 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4677 new_face_id
= face_id
;
4678 last_height
= FONT_HEIGHT (face
->font
);
4682 /* Give up if we cannot find a font within 10pt. */
4683 && eabs (last_pt
- pt
) < 100)
4685 /* Look up a face for a slightly smaller/larger font. */
4687 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4688 new_face_id
= lookup_face (f
, attrs
);
4689 new_face
= FACE_FROM_ID (f
, new_face_id
);
4691 /* If height changes, count that as one step. */
4692 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4693 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4696 last_height
= FONT_HEIGHT (new_face
->font
);
4703 #else /* not HAVE_WINDOW_SYSTEM */
4707 #endif /* not HAVE_WINDOW_SYSTEM */
4711 /* Return a face for charset ASCII that is like the face with id
4712 FACE_ID on frame F, but has height HEIGHT. */
4715 face_with_height (struct frame
*f
, int face_id
, int height
)
4717 #ifdef HAVE_WINDOW_SYSTEM
4719 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4721 if (FRAME_TERMCAP_P (f
)
4725 face
= FACE_FROM_ID (f
, face_id
);
4726 memcpy (attrs
, face
->lface
, sizeof attrs
);
4727 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4728 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4729 face_id
= lookup_face (f
, attrs
);
4730 #endif /* HAVE_WINDOW_SYSTEM */
4736 /* Return the face id of the realized face for named face SYMBOL on
4737 frame F suitable for displaying ASCII characters, and use
4738 attributes of the face FACE_ID for attributes that aren't
4739 completely specified by SYMBOL. This is like lookup_named_face,
4740 except that the default attributes come from FACE_ID, not from the
4741 default face. FACE_ID is assumed to be already realized. */
4744 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4747 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4748 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4749 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4754 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4757 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4758 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4759 return lookup_face (f
, attrs
);
4762 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4763 Sface_attributes_as_vector
, 1, 1, 0,
4764 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4768 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4770 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4777 /***********************************************************************
4778 Face capability testing
4779 ***********************************************************************/
4782 /* If the distance (as returned by color_distance) between two colors is
4783 less than this, then they are considered the same, for determining
4784 whether a color is supported or not. The range of values is 0-65535. */
4786 #define TTY_SAME_COLOR_THRESHOLD 10000
4788 #ifdef HAVE_WINDOW_SYSTEM
4790 /* Return non-zero if all the face attributes in ATTRS are supported
4791 on the window-system frame F.
4793 The definition of `supported' is somewhat heuristic, but basically means
4794 that a face containing all the attributes in ATTRS, when merged with the
4795 default face for display, can be represented in a way that's
4797 \(1) different in appearance than the default face, and
4798 \(2) `close in spirit' to what the attributes specify, if not exact. */
4801 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4802 struct face
*def_face
)
4804 Lisp_Object
*def_attrs
= def_face
->lface
;
4806 /* Check that other specified attributes are different that the default
4808 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4809 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4810 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4811 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4812 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4813 def_attrs
[LFACE_INVERSE_INDEX
]))
4814 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4815 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4816 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4817 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4818 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4819 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4820 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4821 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4822 def_attrs
[LFACE_STIPPLE_INDEX
]))
4823 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4824 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4825 def_attrs
[LFACE_OVERLINE_INDEX
]))
4826 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4827 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4828 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4829 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4830 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4831 def_attrs
[LFACE_BOX_INDEX
])))
4834 /* Check font-related attributes, as those are the most commonly
4835 "unsupported" on a window-system (because of missing fonts). */
4836 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4837 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4838 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4839 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4840 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4841 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4845 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4848 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4850 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4852 face_id
= lookup_face (f
, merged_attrs
);
4853 face
= FACE_FROM_ID (f
, face_id
);
4856 error ("Cannot make face");
4858 /* If the font is the same, or no font is found, then not
4860 if (face
->font
== def_face
->font
4863 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4864 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4868 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4869 || face
->font
->driver
->case_sensitive
)
4871 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4872 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4873 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4874 s2
, make_number (0), Qnil
, Qt
), Qt
))
4880 /* Everything checks out, this face is supported. */
4884 #endif /* HAVE_WINDOW_SYSTEM */
4886 /* Return non-zero if all the face attributes in ATTRS are supported
4889 The definition of `supported' is somewhat heuristic, but basically means
4890 that a face containing all the attributes in ATTRS, when merged
4891 with the default face for display, can be represented in a way that's
4893 \(1) different in appearance than the default face, and
4894 \(2) `close in spirit' to what the attributes specify, if not exact.
4896 Point (2) implies that a `:weight black' attribute will be satisfied
4897 by any terminal that can display bold, and a `:foreground "yellow"' as
4898 long as the terminal can display a yellowish color, but `:slant italic'
4899 will _not_ be satisfied by the tty display code's automatic
4900 substitution of a `dim' face for italic. */
4903 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4904 struct face
*def_face
)
4907 Lisp_Object val
, fg
, bg
;
4908 XColor fg_tty_color
, fg_std_color
;
4909 XColor bg_tty_color
, bg_std_color
;
4910 unsigned test_caps
= 0;
4911 Lisp_Object
*def_attrs
= def_face
->lface
;
4913 /* First check some easy-to-check stuff; ttys support none of the
4914 following attributes, so we can just return false if any are requested
4915 (even if `nominal' values are specified, we should still return false,
4916 as that will be the same value that the default face uses). We
4917 consider :slant unsupportable on ttys, even though the face code
4918 actually `fakes' them using a dim attribute if possible. This is
4919 because the faked result is too different from what the face
4921 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4922 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4923 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4924 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4925 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4926 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4927 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4928 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4931 /* Test for terminal `capabilities' (non-color character attributes). */
4933 /* font weight (bold/dim) */
4934 val
= attrs
[LFACE_WEIGHT_INDEX
];
4935 if (!UNSPECIFIEDP (val
)
4936 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4938 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4942 if (def_weight
> 100)
4943 return 0; /* same as default */
4944 test_caps
= TTY_CAP_BOLD
;
4946 else if (weight
< 100)
4948 if (def_weight
< 100)
4949 return 0; /* same as default */
4950 test_caps
= TTY_CAP_DIM
;
4952 else if (def_weight
== 100)
4953 return 0; /* same as default */
4957 val
= attrs
[LFACE_SLANT_INDEX
];
4958 if (!UNSPECIFIEDP (val
)
4959 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4961 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4962 if (slant
== 100 || slant
== def_slant
)
4963 return 0; /* same as default */
4965 test_caps
|= TTY_CAP_ITALIC
;
4969 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4970 if (!UNSPECIFIEDP (val
))
4973 return 0; /* ttys can't use colored underlines */
4974 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4975 return 0; /* same as default */
4977 test_caps
|= TTY_CAP_UNDERLINE
;
4981 val
= attrs
[LFACE_INVERSE_INDEX
];
4982 if (!UNSPECIFIEDP (val
))
4984 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4985 return 0; /* same as default */
4987 test_caps
|= TTY_CAP_INVERSE
;
4991 /* Color testing. */
4993 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4994 we use them when calling `tty_capable_p' below, even if the face
4995 specifies no colors. */
4996 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4997 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4999 /* Check if foreground color is close enough. */
5000 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5003 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
5005 if (face_attr_equal_p (fg
, def_fg
))
5006 return 0; /* same as default */
5007 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5008 return 0; /* not a valid color */
5009 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5010 > TTY_SAME_COLOR_THRESHOLD
)
5011 return 0; /* displayed color is too different */
5013 /* Make sure the color is really different than the default. */
5015 XColor def_fg_color
;
5016 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5017 && (color_distance (&fg_tty_color
, &def_fg_color
)
5018 <= TTY_SAME_COLOR_THRESHOLD
))
5023 /* Check if background color is close enough. */
5024 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5027 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5029 if (face_attr_equal_p (bg
, def_bg
))
5030 return 0; /* same as default */
5031 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5032 return 0; /* not a valid color */
5033 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5034 > TTY_SAME_COLOR_THRESHOLD
)
5035 return 0; /* displayed color is too different */
5037 /* Make sure the color is really different than the default. */
5039 XColor def_bg_color
;
5040 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5041 && (color_distance (&bg_tty_color
, &def_bg_color
)
5042 <= TTY_SAME_COLOR_THRESHOLD
))
5047 /* If both foreground and background are requested, see if the
5048 distance between them is OK. We just check to see if the distance
5049 between the tty's foreground and background is close enough to the
5050 distance between the standard foreground and background. */
5051 if (STRINGP (fg
) && STRINGP (bg
))
5054 = (color_distance (&fg_std_color
, &bg_std_color
)
5055 - color_distance (&fg_tty_color
, &bg_tty_color
));
5056 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5057 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5062 /* See if the capabilities we selected above are supported, with the
5064 if (test_caps
!= 0 &&
5065 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
5066 bg_tty_color
.pixel
))
5070 /* Hmmm, everything checks out, this terminal must support this face. */
5075 DEFUN ("display-supports-face-attributes-p",
5076 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5078 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5079 The optional argument DISPLAY can be a display name, a frame, or
5080 nil (meaning the selected frame's display).
5082 The definition of `supported' is somewhat heuristic, but basically means
5083 that a face containing all the attributes in ATTRIBUTES, when merged
5084 with the default face for display, can be represented in a way that's
5086 \(1) different in appearance than the default face, and
5087 \(2) `close in spirit' to what the attributes specify, if not exact.
5089 Point (2) implies that a `:weight black' attribute will be satisfied by
5090 any display that can display bold, and a `:foreground \"yellow\"' as long
5091 as it can display a yellowish color, but `:slant italic' will _not_ be
5092 satisfied by the tty display code's automatic substitution of a `dim'
5093 face for italic. */)
5094 (Lisp_Object attributes
, Lisp_Object display
)
5096 int supports
= 0, i
;
5099 struct face
*def_face
;
5100 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5102 if (noninteractive
|| !initialized
)
5103 /* We may not be able to access low-level face information in batch
5104 mode, or before being dumped, and this function is not going to
5105 be very useful in those cases anyway, so just give up. */
5109 frame
= selected_frame
;
5110 else if (FRAMEP (display
))
5114 /* Find any frame on DISPLAY. */
5115 Lisp_Object fl_tail
;
5118 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5120 frame
= XCAR (fl_tail
);
5121 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5122 XFRAME (frame
)->param_alist
)),
5128 CHECK_LIVE_FRAME (frame
);
5131 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5132 attrs
[i
] = Qunspecified
;
5133 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5135 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5136 if (def_face
== NULL
)
5138 if (! realize_basic_faces (f
))
5139 error ("Cannot realize default face");
5140 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5141 if (def_face
== NULL
)
5142 abort (); /* realize_basic_faces must have set it up */
5145 /* Dispatch to the appropriate handler. */
5146 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5147 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5148 #ifdef HAVE_WINDOW_SYSTEM
5150 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5153 return supports
? Qt
: Qnil
;
5157 /***********************************************************************
5159 ***********************************************************************/
5161 DEFUN ("internal-set-font-selection-order",
5162 Finternal_set_font_selection_order
,
5163 Sinternal_set_font_selection_order
, 1, 1, 0,
5164 doc
: /* Set font selection order for face font selection to ORDER.
5165 ORDER must be a list of length 4 containing the symbols `:width',
5166 `:height', `:weight', and `:slant'. Face attributes appearing
5167 first in ORDER are matched first, e.g. if `:height' appears before
5168 `:weight' in ORDER, font selection first tries to find a font with
5169 a suitable height, and then tries to match the font weight.
5175 int indices
[DIM (font_sort_order
)];
5178 memset (indices
, 0, sizeof indices
);
5182 CONSP (list
) && i
< DIM (indices
);
5183 list
= XCDR (list
), ++i
)
5185 Lisp_Object attr
= XCAR (list
);
5188 if (EQ (attr
, QCwidth
))
5190 else if (EQ (attr
, QCheight
))
5191 xlfd
= XLFD_POINT_SIZE
;
5192 else if (EQ (attr
, QCweight
))
5194 else if (EQ (attr
, QCslant
))
5199 if (indices
[i
] != 0)
5204 if (!NILP (list
) || i
!= DIM (indices
))
5205 signal_error ("Invalid font sort order", order
);
5206 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5207 if (indices
[i
] == 0)
5208 signal_error ("Invalid font sort order", order
);
5210 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5212 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5213 free_all_realized_faces (Qnil
);
5216 font_update_sort_order (font_sort_order
);
5222 DEFUN ("internal-set-alternative-font-family-alist",
5223 Finternal_set_alternative_font_family_alist
,
5224 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5225 doc
: /* Define alternative font families to try in face font selection.
5226 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5227 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5228 be found. Value is ALIST. */)
5231 Lisp_Object entry
, tail
, tail2
;
5234 alist
= Fcopy_sequence (alist
);
5235 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5237 entry
= XCAR (tail
);
5239 entry
= Fcopy_sequence (entry
);
5240 XSETCAR (tail
, entry
);
5241 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5242 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5245 Vface_alternative_font_family_alist
= alist
;
5246 free_all_realized_faces (Qnil
);
5251 DEFUN ("internal-set-alternative-font-registry-alist",
5252 Finternal_set_alternative_font_registry_alist
,
5253 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5254 doc
: /* Define alternative font registries to try in face font selection.
5255 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5256 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5257 be found. Value is ALIST. */)
5260 Lisp_Object entry
, tail
, tail2
;
5263 alist
= Fcopy_sequence (alist
);
5264 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5266 entry
= XCAR (tail
);
5268 entry
= Fcopy_sequence (entry
);
5269 XSETCAR (tail
, entry
);
5270 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5271 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5273 Vface_alternative_font_registry_alist
= alist
;
5274 free_all_realized_faces (Qnil
);
5279 #ifdef HAVE_WINDOW_SYSTEM
5281 /* Return the fontset id of the base fontset name or alias name given
5282 by the fontset attribute of ATTRS. Value is -1 if the fontset
5283 attribute of ATTRS doesn't name a fontset. */
5286 face_fontset (Lisp_Object
*attrs
)
5290 name
= attrs
[LFACE_FONTSET_INDEX
];
5291 if (!STRINGP (name
))
5293 return fs_query_fontset (name
, 0);
5296 #endif /* HAVE_WINDOW_SYSTEM */
5300 /***********************************************************************
5302 ***********************************************************************/
5304 /* Realize basic faces on frame F. Value is zero if frame parameters
5305 of F don't contain enough information needed to realize the default
5309 realize_basic_faces (struct frame
*f
)
5312 ptrdiff_t count
= SPECPDL_INDEX ();
5314 /* Block input here so that we won't be surprised by an X expose
5315 event, for instance, without having the faces set up. */
5317 specbind (Qscalable_fonts_allowed
, Qt
);
5319 if (realize_default_face (f
))
5321 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5322 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5323 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5324 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5325 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5326 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5327 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5328 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5329 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5330 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5331 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5333 /* Reflect changes in the `menu' face in menu bars. */
5334 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5336 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5337 #ifdef USE_X_TOOLKIT
5338 if (FRAME_WINDOW_P (f
))
5339 x_update_menu_appearance (f
);
5346 unbind_to (count
, Qnil
);
5352 /* Realize the default face on frame F. If the face is not fully
5353 specified, make it fully-specified. Attributes of the default face
5354 that are not explicitly specified are taken from frame parameters. */
5357 realize_default_face (struct frame
*f
)
5359 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5361 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5364 /* If the `default' face is not yet known, create it. */
5365 lface
= lface_from_face_name (f
, Qdefault
, 0);
5369 XSETFRAME (frame
, f
);
5370 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5373 #ifdef HAVE_WINDOW_SYSTEM
5374 if (FRAME_WINDOW_P (f
))
5376 Lisp_Object font_object
;
5378 XSETFONT (font_object
, FRAME_FONT (f
));
5379 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5380 ASET (lface
, LFACE_FONTSET_INDEX
, fontset_name (FRAME_FONTSET (f
)));
5381 f
->default_face_done_p
= 1;
5383 #endif /* HAVE_WINDOW_SYSTEM */
5385 if (!FRAME_WINDOW_P (f
))
5387 ASET (lface
, LFACE_FAMILY_INDEX
, build_string ("default"));
5388 ASET (lface
, LFACE_FOUNDRY_INDEX
, LFACE_FAMILY (lface
));
5389 ASET (lface
, LFACE_SWIDTH_INDEX
, Qnormal
);
5390 ASET (lface
, LFACE_HEIGHT_INDEX
, make_number (1));
5391 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5392 ASET (lface
, LFACE_WEIGHT_INDEX
, Qnormal
);
5393 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5394 ASET (lface
, LFACE_SLANT_INDEX
, Qnormal
);
5395 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5396 ASET (lface
, LFACE_FONTSET_INDEX
, Qnil
);
5399 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5400 ASET (lface
, LFACE_UNDERLINE_INDEX
, Qnil
);
5402 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5403 ASET (lface
, LFACE_OVERLINE_INDEX
, Qnil
);
5405 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5406 ASET (lface
, LFACE_STRIKE_THROUGH_INDEX
, Qnil
);
5408 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5409 ASET (lface
, LFACE_BOX_INDEX
, Qnil
);
5411 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5412 ASET (lface
, LFACE_INVERSE_INDEX
, Qnil
);
5414 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5416 /* This function is called so early that colors are not yet
5417 set in the frame parameter list. */
5418 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5420 if (CONSP (color
) && STRINGP (XCDR (color
)))
5421 ASET (lface
, LFACE_FOREGROUND_INDEX
, XCDR (color
));
5422 else if (FRAME_WINDOW_P (f
))
5424 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5425 ASET (lface
, LFACE_FOREGROUND_INDEX
, build_string (unspecified_fg
));
5430 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5432 /* This function is called so early that colors are not yet
5433 set in the frame parameter list. */
5434 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5435 if (CONSP (color
) && STRINGP (XCDR (color
)))
5436 ASET (lface
, LFACE_BACKGROUND_INDEX
, XCDR (color
));
5437 else if (FRAME_WINDOW_P (f
))
5439 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5440 ASET (lface
, LFACE_BACKGROUND_INDEX
, build_string (unspecified_bg
));
5445 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5446 ASET (lface
, LFACE_STIPPLE_INDEX
, Qnil
);
5448 /* Realize the face; it must be fully-specified now. */
5449 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5450 check_lface (lface
);
5451 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5452 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5454 #ifdef HAVE_WINDOW_SYSTEM
5455 #ifdef HAVE_X_WINDOWS
5456 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5458 /* This can happen when making a frame on a display that does
5459 not support the default font. */
5463 /* Otherwise, the font specified for the frame was not
5464 acceptable as a font for the default face (perhaps because
5465 auto-scaled fonts are rejected), so we must adjust the frame
5467 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5469 #endif /* HAVE_X_WINDOWS */
5470 #endif /* HAVE_WINDOW_SYSTEM */
5475 /* Realize basic faces other than the default face in face cache C.
5476 SYMBOL is the face name, ID is the face id the realized face must
5477 have. The default face must have been realized already. */
5480 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5482 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5483 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5484 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5485 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5487 /* The default face must exist and be fully specified. */
5488 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5489 check_lface_attrs (attrs
);
5490 eassert (lface_fully_specified_p (attrs
));
5492 /* If SYMBOL isn't know as a face, create it. */
5496 XSETFRAME (frame
, f
);
5497 lface
= Finternal_make_lisp_face (symbol
, frame
);
5500 /* Merge SYMBOL's face with the default face. */
5501 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5502 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5504 /* Realize the face. */
5505 realize_face (c
, attrs
, id
);
5509 /* Realize the fully-specified face with attributes ATTRS in face
5510 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5511 non-negative, it is an ID of face to remove before caching the new
5512 face. Value is a pointer to the newly created realized face. */
5514 static struct face
*
5515 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5519 /* LFACE must be fully specified. */
5520 eassert (cache
!= NULL
);
5521 check_lface_attrs (attrs
);
5523 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5525 /* Remove the former face. */
5526 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5527 uncache_face (cache
, former_face
);
5528 free_realized_face (cache
->f
, former_face
);
5529 SET_FRAME_GARBAGED (cache
->f
);
5532 if (FRAME_WINDOW_P (cache
->f
))
5533 face
= realize_x_face (cache
, attrs
);
5534 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5535 face
= realize_tty_face (cache
, attrs
);
5536 else if (FRAME_INITIAL_P (cache
->f
))
5538 /* Create a dummy face. */
5539 face
= make_realized_face (attrs
);
5544 /* Insert the new face. */
5545 cache_face (cache
, face
, lface_hash (attrs
));
5550 #ifdef HAVE_WINDOW_SYSTEM
5551 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5552 same attributes as BASE_FACE except for the font on frame F.
5553 FONT-OBJECT may be nil, in which case, realized a face of
5556 static struct face
*
5557 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5558 struct face
*base_face
)
5560 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5563 face
= xmalloc (sizeof *face
);
5568 = (! NILP (font_object
)
5569 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5570 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5572 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5573 face
->colors_copied_bitwise_p
= 1;
5574 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5577 cache_face (cache
, face
, face
->hash
);
5581 #endif /* HAVE_WINDOW_SYSTEM */
5584 /* Realize the fully-specified face with attributes ATTRS in face
5585 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5586 the new face doesn't share font with the default face, a fontname
5587 is allocated from the heap and set in `font_name' of the new face,
5588 but it is not yet loaded here. Value is a pointer to the newly
5589 created realized face. */
5591 static struct face
*
5592 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5594 struct face
*face
= NULL
;
5595 #ifdef HAVE_WINDOW_SYSTEM
5596 struct face
*default_face
;
5598 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5600 eassert (FRAME_WINDOW_P (cache
->f
));
5602 /* Allocate a new realized face. */
5603 face
= make_realized_face (attrs
);
5604 face
->ascii_face
= face
;
5608 /* Determine the font to use. Most of the time, the font will be
5609 the same as the font of the default face, so try that first. */
5610 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5612 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5614 face
->font
= default_face
->font
;
5616 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5620 /* If the face attribute ATTRS specifies a fontset, use it as
5621 the base of a new realized fontset. Otherwise, use the same
5622 base fontset as of the default face. The base determines
5623 registry and encoding of a font. It may also determine
5624 foundry and family. The other fields of font name pattern
5625 are constructed from ATTRS. */
5626 int fontset
= face_fontset (attrs
);
5628 /* If we are realizing the default face, ATTRS should specify a
5629 fontset. In other words, if FONTSET is -1, we are not
5630 realizing the default face, thus the default face should have
5631 already been realized. */
5635 fontset
= default_face
->fontset
;
5639 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5640 attrs
[LFACE_FONT_INDEX
]
5641 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5642 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5644 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5645 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5655 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5656 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5657 face
->overstrike
= 1;
5659 /* Load colors, and set remaining attributes. */
5661 load_face_colors (f
, face
, attrs
);
5664 box
= attrs
[LFACE_BOX_INDEX
];
5667 /* A simple box of line width 1 drawn in color given by
5669 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5671 face
->box
= FACE_SIMPLE_BOX
;
5672 face
->box_line_width
= 1;
5674 else if (INTEGERP (box
))
5676 /* Simple box of specified line width in foreground color of the
5678 eassert (XINT (box
) != 0);
5679 face
->box
= FACE_SIMPLE_BOX
;
5680 face
->box_line_width
= XINT (box
);
5681 face
->box_color
= face
->foreground
;
5682 face
->box_color_defaulted_p
= 1;
5684 else if (CONSP (box
))
5686 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5687 being one of `raised' or `sunken'. */
5688 face
->box
= FACE_SIMPLE_BOX
;
5689 face
->box_color
= face
->foreground
;
5690 face
->box_color_defaulted_p
= 1;
5691 face
->box_line_width
= 1;
5695 Lisp_Object keyword
, value
;
5697 keyword
= XCAR (box
);
5705 if (EQ (keyword
, QCline_width
))
5707 if (INTEGERP (value
) && XINT (value
) != 0)
5708 face
->box_line_width
= XINT (value
);
5710 else if (EQ (keyword
, QCcolor
))
5712 if (STRINGP (value
))
5714 face
->box_color
= load_color (f
, face
, value
,
5716 face
->use_box_color_for_shadows_p
= 1;
5719 else if (EQ (keyword
, QCstyle
))
5721 if (EQ (value
, Qreleased_button
))
5722 face
->box
= FACE_RAISED_BOX
;
5723 else if (EQ (value
, Qpressed_button
))
5724 face
->box
= FACE_SUNKEN_BOX
;
5729 /* Text underline, overline, strike-through. */
5731 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5732 if (EQ (underline
, Qt
))
5734 /* Use default color (same as foreground color). */
5735 face
->underline_p
= 1;
5736 face
->underline_type
= FACE_UNDER_LINE
;
5737 face
->underline_defaulted_p
= 1;
5738 face
->underline_color
= 0;
5740 else if (STRINGP (underline
))
5742 /* Use specified color. */
5743 face
->underline_p
= 1;
5744 face
->underline_type
= FACE_UNDER_LINE
;
5745 face
->underline_defaulted_p
= 0;
5746 face
->underline_color
5747 = load_color (f
, face
, underline
,
5748 LFACE_UNDERLINE_INDEX
);
5750 else if (NILP (underline
))
5752 face
->underline_p
= 0;
5753 face
->underline_defaulted_p
= 0;
5754 face
->underline_color
= 0;
5756 else if (CONSP (underline
))
5758 /* `(:color COLOR :style STYLE)'.
5759 STYLE being one of `line' or `wave'. */
5760 face
->underline_p
= 1;
5761 face
->underline_color
= 0;
5762 face
->underline_defaulted_p
= 1;
5763 face
->underline_type
= FACE_UNDER_LINE
;
5765 while (CONSP (underline
))
5767 Lisp_Object keyword
, value
;
5769 keyword
= XCAR (underline
);
5770 underline
= XCDR (underline
);
5772 if (!CONSP (underline
))
5774 value
= XCAR (underline
);
5775 underline
= XCDR (underline
);
5777 if (EQ (keyword
, QCcolor
))
5779 if (EQ (value
, Qforeground_color
))
5781 face
->underline_defaulted_p
= 1;
5782 face
->underline_color
= 0;
5784 else if (STRINGP (value
))
5786 face
->underline_defaulted_p
= 0;
5787 face
->underline_color
= load_color (f
, face
, value
,
5788 LFACE_UNDERLINE_INDEX
);
5791 else if (EQ (keyword
, QCstyle
))
5793 if (EQ (value
, Qline
))
5794 face
->underline_type
= FACE_UNDER_LINE
;
5795 else if (EQ (value
, Qwave
))
5796 face
->underline_type
= FACE_UNDER_WAVE
;
5801 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5802 if (STRINGP (overline
))
5804 face
->overline_color
5805 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5806 LFACE_OVERLINE_INDEX
);
5807 face
->overline_p
= 1;
5809 else if (EQ (overline
, Qt
))
5811 face
->overline_color
= face
->foreground
;
5812 face
->overline_color_defaulted_p
= 1;
5813 face
->overline_p
= 1;
5816 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5817 if (STRINGP (strike_through
))
5819 face
->strike_through_color
5820 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5821 LFACE_STRIKE_THROUGH_INDEX
);
5822 face
->strike_through_p
= 1;
5824 else if (EQ (strike_through
, Qt
))
5826 face
->strike_through_color
= face
->foreground
;
5827 face
->strike_through_color_defaulted_p
= 1;
5828 face
->strike_through_p
= 1;
5831 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5832 if (!NILP (stipple
))
5833 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5834 #endif /* HAVE_WINDOW_SYSTEM */
5840 /* Map a specified color of face FACE on frame F to a tty color index.
5841 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5842 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5843 default foreground/background colors. */
5846 map_tty_color (struct frame
*f
, struct face
*face
,
5847 enum lface_attribute_index idx
, int *defaulted
)
5849 Lisp_Object frame
, color
, def
;
5850 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5851 unsigned long default_pixel
=
5852 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5853 unsigned long pixel
= default_pixel
;
5855 unsigned long default_other_pixel
=
5856 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5859 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5861 XSETFRAME (frame
, f
);
5862 color
= face
->lface
[idx
];
5866 && CONSP (Vtty_defined_color_alist
)
5867 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5870 /* Associations in tty-defined-color-alist are of the form
5871 (NAME INDEX R G B). We need the INDEX part. */
5872 pixel
= XINT (XCAR (XCDR (def
)));
5875 if (pixel
== default_pixel
&& STRINGP (color
))
5877 pixel
= load_color (f
, face
, color
, idx
);
5880 /* If the foreground of the default face is the default color,
5881 use the foreground color defined by the frame. */
5882 if (FRAME_MSDOS_P (f
))
5884 if (pixel
== default_pixel
5885 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5888 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5890 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5891 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5894 else if (pixel
== default_other_pixel
)
5897 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5899 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5900 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5908 face
->foreground
= pixel
;
5910 face
->background
= pixel
;
5914 /* Realize the fully-specified face with attributes ATTRS in face
5915 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5916 Value is a pointer to the newly created realized face. */
5918 static struct face
*
5919 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5923 int face_colors_defaulted
= 0;
5924 struct frame
*f
= cache
->f
;
5926 /* Frame must be a termcap frame. */
5927 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5929 /* Allocate a new realized face. */
5930 face
= make_realized_face (attrs
);
5932 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5935 /* Map face attributes to TTY appearances. */
5936 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5937 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5939 face
->tty_bold_p
= 1;
5941 face
->tty_italic_p
= 1;
5942 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5943 face
->tty_underline_p
= 1;
5944 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5945 face
->tty_reverse_p
= 1;
5947 /* Map color names to color indices. */
5948 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5949 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5951 /* Swap colors if face is inverse-video. If the colors are taken
5952 from the frame colors, they are already inverted, since the
5953 frame-creation function calls x-handle-reverse-video. */
5954 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5956 unsigned long tem
= face
->foreground
;
5957 face
->foreground
= face
->background
;
5958 face
->background
= tem
;
5961 if (tty_suppress_bold_inverse_default_colors_p
5963 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5964 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5965 face
->tty_bold_p
= 0;
5971 DEFUN ("tty-suppress-bold-inverse-default-colors",
5972 Ftty_suppress_bold_inverse_default_colors
,
5973 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5974 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5975 SUPPRESS non-nil means suppress it.
5976 This affects bold faces on TTYs whose foreground is the default background
5977 color of the display and whose background is the default foreground color.
5978 For such faces, the bold face attribute is ignored if this variable
5980 (Lisp_Object suppress
)
5982 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5983 ++face_change_count
;
5989 /***********************************************************************
5991 ***********************************************************************/
5993 /* Return the ID of the face to use to display character CH with face
5994 property PROP on frame F in current_buffer. */
5997 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
6001 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
6006 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6007 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6011 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6012 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6013 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6014 merge_face_ref (f
, prop
, attrs
, 1, 0);
6015 face_id
= lookup_face (f
, attrs
);
6021 /* Return the face ID associated with buffer position POS for
6022 displaying ASCII characters. Return in *ENDPTR the position at
6023 which a different face is needed, as far as text properties and
6024 overlays are concerned. W is a window displaying current_buffer.
6026 REGION_BEG, REGION_END delimit the region, so it can be
6029 LIMIT is a position not to scan beyond. That is to limit the time
6030 this function can take.
6032 If MOUSE is non-zero, use the character's mouse-face, not its face.
6034 BASE_FACE_ID, if non-negative, specifies a base face id to use
6035 instead of DEFAULT_FACE_ID.
6037 The face returned is suitable for displaying ASCII characters. */
6040 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
6041 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6042 ptrdiff_t *endptr
, ptrdiff_t limit
,
6043 int mouse
, int base_face_id
)
6045 struct frame
*f
= XFRAME (w
->frame
);
6046 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6047 Lisp_Object prop
, position
;
6048 ptrdiff_t i
, noverlays
;
6049 Lisp_Object
*overlay_vec
;
6051 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6052 Lisp_Object limit1
, end
;
6053 struct face
*default_face
;
6055 /* W must display the current buffer. We could write this function
6056 to use the frame and buffer of W, but right now it doesn't. */
6057 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6059 XSETFASTINT (position
, pos
);
6062 if (pos
< region_beg
&& region_beg
< endpos
)
6063 endpos
= region_beg
;
6065 /* Get the `face' or `mouse_face' text property at POS, and
6066 determine the next position at which the property changes. */
6067 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6068 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6069 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6071 endpos
= XINT (end
);
6073 /* Look at properties from overlays. */
6075 ptrdiff_t next_overlay
;
6077 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6078 if (next_overlay
< endpos
)
6079 endpos
= next_overlay
;
6087 if (base_face_id
>= 0)
6088 face_id
= base_face_id
;
6089 else if (NILP (Vface_remapping_alist
))
6090 face_id
= DEFAULT_FACE_ID
;
6092 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6094 default_face
= FACE_FROM_ID (f
, face_id
);
6097 /* Optimize common cases where we can use the default face. */
6100 && !(pos
>= region_beg
&& pos
< region_end
))
6101 return default_face
->id
;
6103 /* Begin with attributes from the default face. */
6104 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6106 /* Merge in attributes specified via text properties. */
6108 merge_face_ref (f
, prop
, attrs
, 1, 0);
6110 /* Now merge the overlay data. */
6111 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6112 for (i
= 0; i
< noverlays
; i
++)
6117 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6119 merge_face_ref (f
, prop
, attrs
, 1, 0);
6121 oend
= OVERLAY_END (overlay_vec
[i
]);
6122 oendpos
= OVERLAY_POSITION (oend
);
6123 if (oendpos
< endpos
)
6127 /* If in the region, merge in the region face. */
6128 if (pos
>= region_beg
&& pos
< region_end
)
6130 merge_named_face (f
, Qregion
, attrs
, 0);
6132 if (region_end
< endpos
)
6133 endpos
= region_end
;
6138 /* Look up a realized face with the given face attributes,
6139 or realize a new one for ASCII characters. */
6140 return lookup_face (f
, attrs
);
6143 /* Return the face ID at buffer position POS for displaying ASCII
6144 characters associated with overlay strings for overlay OVERLAY.
6146 Like face_at_buffer_position except for OVERLAY. Currently it
6147 simply disregards the `face' properties of all overlays. */
6150 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6151 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6152 ptrdiff_t *endptr
, ptrdiff_t limit
,
6153 int mouse
, Lisp_Object overlay
)
6155 struct frame
*f
= XFRAME (w
->frame
);
6156 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6157 Lisp_Object prop
, position
;
6159 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6160 Lisp_Object limit1
, end
;
6161 struct face
*default_face
;
6163 /* W must display the current buffer. We could write this function
6164 to use the frame and buffer of W, but right now it doesn't. */
6165 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6167 XSETFASTINT (position
, pos
);
6170 if (pos
< region_beg
&& region_beg
< endpos
)
6171 endpos
= region_beg
;
6173 /* Get the `face' or `mouse_face' text property at POS, and
6174 determine the next position at which the property changes. */
6175 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6176 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6177 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6179 endpos
= XINT (end
);
6183 /* Optimize common case where we can use the default face. */
6185 && !(pos
>= region_beg
&& pos
< region_end
)
6186 && NILP (Vface_remapping_alist
))
6187 return DEFAULT_FACE_ID
;
6189 /* Begin with attributes from the default face. */
6190 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6191 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6193 /* Merge in attributes specified via text properties. */
6195 merge_face_ref (f
, prop
, attrs
, 1, 0);
6197 /* If in the region, merge in the region face. */
6198 if (pos
>= region_beg
&& pos
< region_end
)
6200 merge_named_face (f
, Qregion
, attrs
, 0);
6202 if (region_end
< endpos
)
6203 endpos
= region_end
;
6208 /* Look up a realized face with the given face attributes,
6209 or realize a new one for ASCII characters. */
6210 return lookup_face (f
, attrs
);
6214 /* Compute the face at character position POS in Lisp string STRING on
6215 window W, for ASCII characters.
6217 If STRING is an overlay string, it comes from position BUFPOS in
6218 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6219 not an overlay string. W must display the current buffer.
6220 REGION_BEG and REGION_END give the start and end positions of the
6221 region; both are -1 if no region is visible.
6223 BASE_FACE_ID is the id of a face to merge with. For strings coming
6224 from overlays or the `display' property it is the face at BUFPOS.
6226 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6228 Set *ENDPTR to the next position where to check for faces in
6229 STRING; -1 if the face is constant from POS to the end of the
6232 Value is the id of the face to use. The face returned is suitable
6233 for displaying ASCII characters. */
6236 face_at_string_position (struct window
*w
, Lisp_Object string
,
6237 ptrdiff_t pos
, ptrdiff_t bufpos
,
6238 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6239 ptrdiff_t *endptr
, enum face_id base_face_id
,
6242 Lisp_Object prop
, position
, end
, limit
;
6243 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6244 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6245 struct face
*base_face
;
6246 int multibyte_p
= STRING_MULTIBYTE (string
);
6247 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6249 /* Get the value of the face property at the current position within
6250 STRING. Value is nil if there is no face property. */
6251 XSETFASTINT (position
, pos
);
6252 prop
= Fget_text_property (position
, prop_name
, string
);
6254 /* Get the next position at which to check for faces. Value of end
6255 is nil if face is constant all the way to the end of the string.
6256 Otherwise it is a string position where to check faces next.
6257 Limit is the maximum position up to which to check for property
6258 changes in Fnext_single_property_change. Strings are usually
6259 short, so set the limit to the end of the string. */
6260 XSETFASTINT (limit
, SCHARS (string
));
6261 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6263 *endptr
= XFASTINT (end
);
6267 base_face
= FACE_FROM_ID (f
, base_face_id
);
6268 eassert (base_face
);
6270 /* Optimize the default case that there is no face property and we
6271 are not in the region. */
6273 && (base_face_id
!= DEFAULT_FACE_ID
6274 /* BUFPOS <= 0 means STRING is not an overlay string, so
6275 that the region doesn't have to be taken into account. */
6277 || bufpos
< region_beg
6278 || bufpos
>= region_end
)
6280 /* We can't realize faces for different charsets differently
6281 if we don't have fonts, so we can stop here if not working
6282 on a window-system frame. */
6283 || !FRAME_WINDOW_P (f
)
6284 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6285 return base_face
->id
;
6287 /* Begin with attributes from the base face. */
6288 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6290 /* Merge in attributes specified via text properties. */
6292 merge_face_ref (f
, prop
, attrs
, 1, 0);
6294 /* If in the region, merge in the region face. */
6296 && bufpos
>= region_beg
6297 && bufpos
< region_end
)
6298 merge_named_face (f
, Qregion
, attrs
, 0);
6300 /* Look up a realized face with the given face attributes,
6301 or realize a new one for ASCII characters. */
6302 return lookup_face (f
, attrs
);
6306 /* Merge a face into a realized face.
6308 F is frame where faces are (to be) realized.
6310 FACE_NAME is named face to merge.
6312 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6314 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6316 BASE_FACE_ID is realized face to merge into.
6322 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6325 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6326 struct face
*base_face
;
6328 base_face
= FACE_FROM_ID (f
, base_face_id
);
6330 return base_face_id
;
6332 if (EQ (face_name
, Qt
))
6334 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6335 return base_face_id
;
6336 face_name
= lface_id_to_name
[face_id
];
6337 /* When called during make-frame, lookup_derived_face may fail
6338 if the faces are uninitialized. Don't signal an error. */
6339 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6340 return (face_id
>= 0 ? face_id
: base_face_id
);
6343 /* Begin with attributes from the base face. */
6344 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6346 if (!NILP (face_name
))
6348 if (!merge_named_face (f
, face_name
, attrs
, 0))
6349 return base_face_id
;
6355 return base_face_id
;
6356 face
= FACE_FROM_ID (f
, face_id
);
6358 return base_face_id
;
6359 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6362 /* Look up a realized face with the given face attributes,
6363 or realize a new one for ASCII characters. */
6364 return lookup_face (f
, attrs
);
6369 #ifndef HAVE_X_WINDOWS
6370 DEFUN ("x-load-color-file", Fx_load_color_file
,
6371 Sx_load_color_file
, 1, 1, 0,
6372 doc
: /* Create an alist of color entries from an external file.
6374 The file should define one named RGB color per line like so:
6376 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6377 (Lisp_Object filename
)
6380 Lisp_Object cmap
= Qnil
;
6381 Lisp_Object abspath
;
6383 CHECK_STRING (filename
);
6384 abspath
= Fexpand_file_name (filename
, Qnil
);
6386 fp
= fopen (SSDATA (abspath
), "rt");
6390 int red
, green
, blue
;
6395 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6396 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6398 char *name
= buf
+ num
;
6399 num
= strlen (name
) - 1;
6400 if (num
>= 0 && name
[num
] == '\n')
6402 cmap
= Fcons (Fcons (build_string (name
),
6404 make_number (RGB (red
, green
, blue
))),
6406 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6421 /***********************************************************************
6423 ***********************************************************************/
6427 /* Print the contents of the realized face FACE to stderr. */
6430 dump_realized_face (struct face
*face
)
6432 fprintf (stderr
, "ID: %d\n", face
->id
);
6433 #ifdef HAVE_X_WINDOWS
6434 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6436 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6438 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6439 fprintf (stderr
, "background: 0x%lx (%s)\n",
6441 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6443 fprintf (stderr
, "font_name: %s (%s)\n",
6444 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6445 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6446 #ifdef HAVE_X_WINDOWS
6447 fprintf (stderr
, "font = %p\n", face
->font
);
6449 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6450 fprintf (stderr
, "underline: %d (%s)\n",
6452 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6453 fprintf (stderr
, "hash: %d\n", face
->hash
);
6457 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6464 fprintf (stderr
, "font selection order: ");
6465 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6466 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6467 fprintf (stderr
, "\n");
6469 fprintf (stderr
, "alternative fonts: ");
6470 debug_print (Vface_alternative_font_family_alist
);
6471 fprintf (stderr
, "\n");
6473 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6474 Fdump_face (make_number (i
));
6480 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6482 error ("Not a valid face");
6483 dump_realized_face (face
);
6490 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6491 0, 0, 0, doc
: /* */)
6494 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6495 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6496 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6500 #endif /* GLYPH_DEBUG */
6504 /***********************************************************************
6506 ***********************************************************************/
6509 syms_of_xfaces (void)
6511 DEFSYM (Qface
, "face");
6512 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6513 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6514 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6516 /* Lisp face attribute keywords. */
6517 DEFSYM (QCfamily
, ":family");
6518 DEFSYM (QCheight
, ":height");
6519 DEFSYM (QCweight
, ":weight");
6520 DEFSYM (QCslant
, ":slant");
6521 DEFSYM (QCunderline
, ":underline");
6522 DEFSYM (QCinverse_video
, ":inverse-video");
6523 DEFSYM (QCreverse_video
, ":reverse-video");
6524 DEFSYM (QCforeground
, ":foreground");
6525 DEFSYM (QCbackground
, ":background");
6526 DEFSYM (QCstipple
, ":stipple");
6527 DEFSYM (QCwidth
, ":width");
6528 DEFSYM (QCfont
, ":font");
6529 DEFSYM (QCfontset
, ":fontset");
6530 DEFSYM (QCbold
, ":bold");
6531 DEFSYM (QCitalic
, ":italic");
6532 DEFSYM (QCoverline
, ":overline");
6533 DEFSYM (QCstrike_through
, ":strike-through");
6534 DEFSYM (QCbox
, ":box");
6535 DEFSYM (QCinherit
, ":inherit");
6537 /* Symbols used for Lisp face attribute values. */
6538 DEFSYM (QCcolor
, ":color");
6539 DEFSYM (QCline_width
, ":line-width");
6540 DEFSYM (QCstyle
, ":style");
6541 DEFSYM (Qline
, "line");
6542 DEFSYM (Qwave
, "wave");
6543 DEFSYM (Qreleased_button
, "released-button");
6544 DEFSYM (Qpressed_button
, "pressed-button");
6545 DEFSYM (Qnormal
, "normal");
6546 DEFSYM (Qultra_light
, "ultra-light");
6547 DEFSYM (Qextra_light
, "extra-light");
6548 DEFSYM (Qlight
, "light");
6549 DEFSYM (Qsemi_light
, "semi-light");
6550 DEFSYM (Qsemi_bold
, "semi-bold");
6551 DEFSYM (Qbold
, "bold");
6552 DEFSYM (Qextra_bold
, "extra-bold");
6553 DEFSYM (Qultra_bold
, "ultra-bold");
6554 DEFSYM (Qoblique
, "oblique");
6555 DEFSYM (Qitalic
, "italic");
6556 DEFSYM (Qreverse_oblique
, "reverse-oblique");
6557 DEFSYM (Qreverse_italic
, "reverse-italic");
6558 DEFSYM (Qultra_condensed
, "ultra-condensed");
6559 DEFSYM (Qextra_condensed
, "extra-condensed");
6560 DEFSYM (Qcondensed
, "condensed");
6561 DEFSYM (Qsemi_condensed
, "semi-condensed");
6562 DEFSYM (Qsemi_expanded
, "semi-expanded");
6563 DEFSYM (Qexpanded
, "expanded");
6564 DEFSYM (Qextra_expanded
, "extra-expanded");
6565 DEFSYM (Qultra_expanded
, "ultra-expanded");
6566 DEFSYM (Qbackground_color
, "background-color");
6567 DEFSYM (Qforeground_color
, "foreground-color");
6568 DEFSYM (Qunspecified
, "unspecified");
6569 DEFSYM (QCignore_defface
, ":ignore-defface");
6571 DEFSYM (Qface_alias
, "face-alias");
6572 DEFSYM (Qdefault
, "default");
6573 DEFSYM (Qtool_bar
, "tool-bar");
6574 DEFSYM (Qregion
, "region");
6575 DEFSYM (Qfringe
, "fringe");
6576 DEFSYM (Qheader_line
, "header-line");
6577 DEFSYM (Qscroll_bar
, "scroll-bar");
6578 DEFSYM (Qmenu
, "menu");
6579 DEFSYM (Qcursor
, "cursor");
6580 DEFSYM (Qborder
, "border");
6581 DEFSYM (Qmouse
, "mouse");
6582 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6583 DEFSYM (Qvertical_border
, "vertical-border");
6584 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6585 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6586 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6587 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6588 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6590 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6591 staticpro (&Vparam_value_alist
);
6592 Vface_alternative_font_family_alist
= Qnil
;
6593 staticpro (&Vface_alternative_font_family_alist
);
6594 Vface_alternative_font_registry_alist
= Qnil
;
6595 staticpro (&Vface_alternative_font_registry_alist
);
6597 defsubr (&Sinternal_make_lisp_face
);
6598 defsubr (&Sinternal_lisp_face_p
);
6599 defsubr (&Sinternal_set_lisp_face_attribute
);
6600 #ifdef HAVE_WINDOW_SYSTEM
6601 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6603 defsubr (&Scolor_gray_p
);
6604 defsubr (&Scolor_supported_p
);
6605 #ifndef HAVE_X_WINDOWS
6606 defsubr (&Sx_load_color_file
);
6608 defsubr (&Sface_attribute_relative_p
);
6609 defsubr (&Smerge_face_attribute
);
6610 defsubr (&Sinternal_get_lisp_face_attribute
);
6611 defsubr (&Sinternal_lisp_face_attribute_values
);
6612 defsubr (&Sinternal_lisp_face_equal_p
);
6613 defsubr (&Sinternal_lisp_face_empty_p
);
6614 defsubr (&Sinternal_copy_lisp_face
);
6615 defsubr (&Sinternal_merge_in_global_face
);
6616 defsubr (&Sface_font
);
6617 defsubr (&Sframe_face_alist
);
6618 defsubr (&Sdisplay_supports_face_attributes_p
);
6619 defsubr (&Scolor_distance
);
6620 defsubr (&Sinternal_set_font_selection_order
);
6621 defsubr (&Sinternal_set_alternative_font_family_alist
);
6622 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6623 defsubr (&Sface_attributes_as_vector
);
6625 defsubr (&Sdump_face
);
6626 defsubr (&Sshow_face_resources
);
6627 #endif /* GLYPH_DEBUG */
6628 defsubr (&Sclear_face_cache
);
6629 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6631 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6632 defsubr (&Sdump_colors
);
6635 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6636 doc
: /* Limit for font matching.
6637 If an integer > 0, font matching functions won't load more than
6638 that number of fonts when searching for a matching font. */);
6639 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6641 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6642 doc
: /* List of global face definitions (for internal use only.) */);
6643 Vface_new_frame_defaults
= Qnil
;
6645 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6646 doc
: /* Default stipple pattern used on monochrome displays.
6647 This stipple pattern is used on monochrome displays
6648 instead of shades of gray for a face background color.
6649 See `set-face-stipple' for possible values for this variable. */);
6650 Vface_default_stipple
= build_pure_c_string ("gray3");
6652 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6653 doc
: /* An alist of defined terminal colors and their RGB values.
6654 See the docstring of `tty-color-alist' for the details. */);
6655 Vtty_defined_color_alist
= Qnil
;
6657 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6658 doc
: /* Allowed scalable fonts.
6659 A value of nil means don't allow any scalable fonts.
6660 A value of t means allow any scalable font.
6661 Otherwise, value must be a list of regular expressions. A font may be
6662 scaled if its name matches a regular expression in the list.
6663 Note that if value is nil, a scalable font might still be used, if no
6664 other font of the appropriate family and registry is available. */);
6665 Vscalable_fonts_allowed
= Qnil
;
6667 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6668 doc
: /* List of ignored fonts.
6669 Each element is a regular expression that matches names of fonts to
6671 Vface_ignored_fonts
= Qnil
;
6673 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6674 doc
: /* Alist of face remappings.
6675 Each element is of the form:
6677 (FACE . REPLACEMENT),
6679 which causes display of the face FACE to use REPLACEMENT instead.
6680 REPLACEMENT is a face specification, i.e. one of the following:
6683 (2) a property list of attribute/value pairs, or
6684 (3) a list in which each element has the form of (1) or (2).
6686 List values for REPLACEMENT are merged to form the final face
6687 specification, with earlier entries taking precedence, in the same as
6688 as in the `face' text property.
6690 Face-name remapping cycles are suppressed; recursive references use
6691 the underlying face instead of the remapped face. So a remapping of
6694 (FACE EXTRA-FACE... FACE)
6698 (FACE (FACE-ATTR VAL ...) FACE)
6700 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6701 existing definition of FACE. Note that this isn't necessary for the
6702 default face, since every face inherits from the default face.
6704 If this variable is made buffer-local, the face remapping takes effect
6705 only in that buffer. For instance, the mode my-mode could define a
6706 face `my-mode-default', and then in the mode setup function, do:
6708 (set (make-local-variable 'face-remapping-alist)
6709 '((default my-mode-default)))).
6711 Because Emacs normally only redraws screen areas when the underlying
6712 buffer contents change, you may need to call `redraw-display' after
6713 changing this variable for it to take effect. */);
6714 Vface_remapping_alist
= Qnil
;
6716 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6717 doc
: /* Alist of fonts vs the rescaling factors.
6718 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6719 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6720 RESCALE-RATIO is a floating point number to specify how much larger
6721 \(or smaller) font we should use. For instance, if a face requests
6722 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6723 Vface_font_rescale_alist
= Qnil
;
6725 #ifdef HAVE_WINDOW_SYSTEM
6726 defsubr (&Sbitmap_spec_p
);
6727 defsubr (&Sx_list_fonts
);
6728 defsubr (&Sinternal_face_x_get_resource
);
6729 defsubr (&Sx_family_fonts
);