1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2011 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
30 2. Font foundary name.
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 correspoinding specs in this attribute is set to nil.
71 15. A face name or list of face names from which to inherit attributes.
73 16. A specified average font width, which is invisible from Lisp,
74 and is used to ensure that a font specified on the command line,
75 for example, can be matched exactly.
77 17. A fontset name. This is another special attribute.
79 A fontset is a mappings from characters to font-specs, and the
80 specs overwrite the font-spec in the 14th attribute.
83 Faces are frame-local by nature because Emacs allows to define the
84 same named face (face names are symbols) differently for different
85 frames. Each frame has an alist of face definitions for all named
86 faces. The value of a named face in such an alist is a Lisp vector
87 with the symbol `face' in slot 0, and a slot for each of the face
88 attributes mentioned above.
90 There is also a global face alist `Vface_new_frame_defaults'. Face
91 definitions from this list are used to initialize faces of newly
94 A face doesn't have to specify all attributes. Those not specified
95 have a value of `unspecified'. Faces specifying all attributes but
96 the 14th are called `fully-specified'.
101 The display style of a given character in the text is determined by
102 combining several faces. This process is called `face merging'.
103 Any aspect of the display style that isn't specified by overlays or
104 text properties is taken from the `default' face. Since it is made
105 sure that the default face is always fully-specified, face merging
106 always results in a fully-specified face.
111 After all face attributes for a character have been determined by
112 merging faces of that character, that face is `realized'. The
113 realization process maps face attributes to what is physically
114 available on the system where Emacs runs. The result is a
115 `realized face' in form of a struct face which is stored in the
116 face cache of the frame on which it was realized.
118 Face realization is done in the context of the character to display
119 because different fonts may be used for different characters. In
120 other words, for characters that have different font
121 specifications, different realized faces are needed to display
124 Font specification is done by fontsets. See the comment in
125 fontset.c for the details. In the current implementation, all ASCII
126 characters share the same font in a fontset.
128 Faces are at first realized for ASCII characters, and, at that
129 time, assigned a specific realized fontset. Hereafter, we call
130 such a face as `ASCII face'. When a face for a multibyte character
131 is realized, it inherits (thus shares) a fontset of an ASCII face
132 that has the same attributes other than font-related ones.
134 Thus, all realized faces have a realized fontset.
139 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
140 font as ASCII characters. That is because it is expected that
141 unibyte text users specify a font that is suitable both for ASCII
142 and raw 8-bit characters.
147 Font selection tries to find the best available matching font for a
148 given (character, face) combination.
150 If the face specifies a fontset name, that fontset determines a
151 pattern for fonts of the given character. If the face specifies a
152 font name or the other font-related attributes, a fontset is
153 realized from the default fontset. In that case, that
154 specification determines a pattern for ASCII characters and the
155 default fontset determines a pattern for multibyte characters.
157 Available fonts on the system on which Emacs runs are then matched
158 against the font pattern. The result of font selection is the best
159 match for the given face attributes in this font list.
161 Font selection can be influenced by the user.
163 1. The user can specify the relative importance he gives the face
164 attributes width, height, weight, and slant by setting
165 face-font-selection-order (faces.el) to a list of face attribute
166 names. The default is '(:width :height :weight :slant), and means
167 that font selection first tries to find a good match for the font
168 width specified by a face, then---within fonts with that
169 width---tries to find a best match for the specified font height,
172 2. Setting face-font-family-alternatives allows the user to
173 specify alternative font families to try if a family specified by a
176 3. Setting face-font-registry-alternatives allows the user to
177 specify all alternative font registries to try for a face
178 specifying a registry.
180 4. Setting face-ignored-fonts allows the user to ignore specific
184 Character composition.
186 Usually, the realization process is already finished when Emacs
187 actually reflects the desired glyph matrix on the screen. However,
188 on displaying a composition (sequence of characters to be composed
189 on the screen), a suitable font for the components of the
190 composition is selected and realized while drawing them on the
191 screen, i.e. the realization process is delayed but in principle
195 Initialization of basic faces.
197 The faces `default', `modeline' are considered `basic faces'.
198 When redisplay happens the first time for a newly created frame,
199 basic faces are realized for CHARSET_ASCII. Frame parameters are
200 used to fill in unspecified attributes of the default face. */
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h> /* This needs to be before termchar.h */
210 #include "character.h"
212 #include "keyboard.h"
214 #include "termhooks.h"
216 #ifdef HAVE_X_WINDOWS
220 #include <Xm/XmStrDefs.h>
221 #endif /* USE_MOTIF */
222 #endif /* HAVE_X_WINDOWS */
231 /* Redefine X specifics to W32 equivalents to avoid cluttering the
232 code with #ifdef blocks. */
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
252 #include "dispextern.h"
253 #include "blockinput.h"
255 #include "intervals.h"
256 #include "termchar.h"
259 #ifdef HAVE_WINDOW_SYSTEM
261 #endif /* HAVE_WINDOW_SYSTEM */
263 #ifdef HAVE_X_WINDOWS
265 /* Compensate for a bug in Xos.h on some systems, on which it requires
266 time.h. On some such systems, Xos.h tries to redefine struct
267 timeval and struct timezone if USG is #defined while it is
270 #ifdef XOS_NEEDS_TIME_H
276 #else /* not XOS_NEEDS_TIME_H */
278 #endif /* not XOS_NEEDS_TIME_H */
280 #endif /* HAVE_X_WINDOWS */
284 /* Number of pt per inch (from the TeXbook). */
286 #define PT_PER_INCH 72.27
288 /* Non-zero if face attribute ATTR is unspecified. */
290 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
292 /* Non-zero if face attribute ATTR is `ignore-defface'. */
294 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)
296 /* Value is the number of elements of VECTOR. */
298 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
300 /* Size of hash table of realized faces in face caches (should be a
303 #define FACE_CACHE_BUCKETS_SIZE 1001
305 /* Keyword symbols used for face attribute names. */
307 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
308 static Lisp_Object QCunderline
;
309 static Lisp_Object QCinverse_video
, QCstipple
;
310 Lisp_Object QCforeground
, QCbackground
;
312 static Lisp_Object QCfont
, QCbold
, QCitalic
;
313 static Lisp_Object QCreverse_video
;
314 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
315 static Lisp_Object QCfontset
;
317 /* Symbols used for attribute values. */
320 static Lisp_Object Qbold
, Qultra_light
, Qextra_light
, Qlight
;
321 static Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
322 static Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
323 static Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
324 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
325 static Lisp_Object Qultra_expanded
;
326 static Lisp_Object Qreleased_button
, Qpressed_button
;
327 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
328 static Lisp_Object Qunspecified
;
329 static Lisp_Object Qignore_defface
;
331 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
333 /* The name of the function to call when the background of the frame
334 has changed, frame_set_background_mode. */
336 Lisp_Object Qframe_set_background_mode
;
338 /* Names of basic faces. */
340 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
341 static Lisp_Object Qregion
;
342 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
343 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
344 Lisp_Object Qmode_line_inactive
;
345 static Lisp_Object Qvertical_border
;
347 /* The symbol `face-alias'. A symbols having that property is an
348 alias for another face. Value of the property is the name of
351 static Lisp_Object Qface_alias
;
353 /* Alist of alternative font families. Each element is of the form
354 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
355 try FAMILY1, then FAMILY2, ... */
357 Lisp_Object Vface_alternative_font_family_alist
;
359 /* Alist of alternative font registries. Each element is of the form
360 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
361 loaded, try REGISTRY1, then REGISTRY2, ... */
363 Lisp_Object Vface_alternative_font_registry_alist
;
365 /* Allowed scalable fonts. A value of nil means don't allow any
366 scalable fonts. A value of t means allow the use of any scalable
367 font. Otherwise, value must be a list of regular expressions. A
368 font may be scaled if its name matches a regular expression in the
371 static Lisp_Object Qscalable_fonts_allowed
;
373 #define DEFAULT_FONT_LIST_LIMIT 100
375 /* The symbols `foreground-color' and `background-color' which can be
376 used as part of a `face' property. This is for compatibility with
379 Lisp_Object Qforeground_color
, Qbackground_color
;
381 /* The symbols `face' and `mouse-face' used as text properties. */
385 /* Property for basic faces which other faces cannot inherit. */
387 static Lisp_Object Qface_no_inherit
;
389 /* Error symbol for wrong_type_argument in load_pixmap. */
391 static Lisp_Object Qbitmap_spec_p
;
393 /* The next ID to assign to Lisp faces. */
395 static int next_lface_id
;
397 /* A vector mapping Lisp face Id's to face names. */
399 static Lisp_Object
*lface_id_to_name
;
400 static int lface_id_to_name_size
;
402 /* TTY color-related functions (defined in tty-colors.el). */
404 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
406 /* The name of the function used to compute colors on TTYs. */
408 static Lisp_Object Qtty_color_alist
;
410 /* Counter for calls to clear_face_cache. If this counter reaches
411 CLEAR_FONT_TABLE_COUNT, and a frame has more than
412 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
414 static int clear_font_table_count
;
415 #define CLEAR_FONT_TABLE_COUNT 100
416 #define CLEAR_FONT_TABLE_NFONTS 10
418 /* Non-zero means face attributes have been changed since the last
419 redisplay. Used in redisplay_internal. */
421 int face_change_count
;
423 /* Non-zero means don't display bold text if a face's foreground
424 and background colors are the inverse of the default colors of the
425 display. This is a kluge to suppress `bold black' foreground text
426 which is hard to read on an LCD monitor. */
428 int tty_suppress_bold_inverse_default_colors_p
;
430 /* A list of the form `((x . y))' used to avoid consing in
431 Finternal_set_lisp_face_attribute. */
433 static Lisp_Object Vparam_value_alist
;
435 /* The total number of colors currently allocated. */
438 static int ncolors_allocated
;
439 static int npixmaps_allocated
;
443 /* Non-zero means the definition of the `menu' face for new frames has
446 int menu_face_changed_default
;
449 /* Function prototypes. */
452 struct named_merge_point
;
454 static void map_tty_color (struct frame
*, struct face
*,
455 enum lface_attribute_index
, int *);
456 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
457 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
458 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
459 int, struct named_merge_point
*);
460 static int load_pixmap (struct frame
*, Lisp_Object
, unsigned *, unsigned *);
461 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
462 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
463 static void free_face_colors (struct frame
*, struct face
*);
464 static int face_color_gray_p (struct frame
*, const char *);
465 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
467 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
469 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
470 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
471 static int realize_basic_faces (struct frame
*);
472 static int realize_default_face (struct frame
*);
473 static void realize_named_face (struct frame
*, Lisp_Object
, int);
474 static int lface_fully_specified_p (Lisp_Object
*);
475 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
476 static unsigned hash_string_case_insensitive (Lisp_Object
);
477 static unsigned lface_hash (Lisp_Object
*);
478 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
479 static struct face_cache
*make_face_cache (struct frame
*);
480 static void clear_face_gcs (struct face_cache
*);
481 static void free_face_cache (struct face_cache
*);
482 static int face_fontset (Lisp_Object
*);
483 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
484 struct named_merge_point
*);
485 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
486 int, struct named_merge_point
*);
487 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
489 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
490 static struct face
*make_realized_face (Lisp_Object
*);
491 static void cache_face (struct face_cache
*, struct face
*, unsigned);
492 static void uncache_face (struct face_cache
*, struct face
*);
494 #ifdef HAVE_WINDOW_SYSTEM
496 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
497 static void x_free_gc (struct frame
*, GC
);
500 static void x_update_menu_appearance (struct frame
*);
502 extern void free_frame_menubar (struct frame
*);
503 #endif /* USE_X_TOOLKIT */
505 #endif /* HAVE_WINDOW_SYSTEM */
508 /***********************************************************************
510 ***********************************************************************/
512 #ifdef HAVE_X_WINDOWS
514 #ifdef DEBUG_X_COLORS
516 /* The following is a poor mans infrastructure for debugging X color
517 allocation problems on displays with PseudoColor-8. Some X servers
518 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
519 color reference counts completely so that they don't signal an
520 error when a color is freed whose reference count is already 0.
521 Other X servers do. To help me debug this, the following code
522 implements a simple reference counting schema of its own, for a
523 single display/screen. --gerd. */
525 /* Reference counts for pixel colors. */
527 int color_count
[256];
529 /* Register color PIXEL as allocated. */
532 register_color (pixel
)
535 xassert (pixel
< 256);
536 ++color_count
[pixel
];
540 /* Register color PIXEL as deallocated. */
543 unregister_color (pixel
)
546 xassert (pixel
< 256);
547 if (color_count
[pixel
] > 0)
548 --color_count
[pixel
];
554 /* Register N colors from PIXELS as deallocated. */
557 unregister_colors (pixels
, n
)
558 unsigned long *pixels
;
562 for (i
= 0; i
< n
; ++i
)
563 unregister_color (pixels
[i
]);
567 DEFUE ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
568 doc
: /* Dump currently allocated colors to stderr. */)
573 fputc ('\n', stderr
);
575 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
578 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
581 fputc ('\n', stderr
);
583 fputc ('\t', stderr
);
587 fputc ('\n', stderr
);
591 #endif /* DEBUG_X_COLORS */
594 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
595 color values. Interrupt input must be blocked when this function
599 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
601 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
603 /* If display has an immutable color map, freeing colors is not
604 necessary and some servers don't allow it. So don't do it. */
605 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
607 #ifdef DEBUG_X_COLORS
608 unregister_colors (pixels
, npixels
);
610 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
, long unsigned int *pixels
, int npixels
)
623 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
624 int class = dpyinfo
->visual
->class;
626 /* If display has an immutable color map, freeing colors is not
627 necessary and some servers don't allow it. So don't do it. */
628 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
630 #ifdef DEBUG_X_COLORS
631 unregister_colors (pixels
, npixels
);
633 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
638 /* Create and return a GC for use on frame F. GC values and mask
639 are given by XGCV and MASK. */
642 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
646 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
653 /* Free GC which was used on frame F. */
656 x_free_gc (struct frame
*f
, GC gc
)
658 eassert (interrupt_input_blocked
);
659 IF_DEBUG (xassert (--ngcs
>= 0));
660 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
663 #endif /* HAVE_X_WINDOWS */
666 /* W32 emulation of GCs */
669 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
673 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
680 /* Free GC which was used on frame F. */
683 x_free_gc (struct frame
*f
, GC gc
)
685 IF_DEBUG (xassert (--ngcs
>= 0));
689 #endif /* WINDOWSNT */
692 /* NS emulation of GCs */
695 x_create_gc (struct frame
*f
,
699 GC gc
= xmalloc (sizeof (*gc
));
701 memcpy (gc
, xgcv
, sizeof (XGCValues
));
706 x_free_gc (struct frame
*f
, GC gc
)
712 /* Like strcasecmp/stricmp. Used to compare parts of font names which
716 xstrcasecmp (const char *s1
, const char *s2
)
720 unsigned char b1
= *s1
;
721 unsigned char b2
= *s2
;
722 unsigned char c1
= tolower (b1
);
723 unsigned char c2
= tolower (b2
);
725 return c1
< c2
? -1 : 1;
730 return *s2
== 0 ? 0 : -1;
735 /* If FRAME is nil, return a pointer to the selected frame.
736 Otherwise, check that FRAME is a live frame, and return a pointer
737 to it. NPARAM is the parameter number of FRAME, for
738 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
739 Lisp function definitions. */
741 static INLINE
struct frame
*
742 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
745 frame
= selected_frame
;
747 CHECK_LIVE_FRAME (frame
);
748 return XFRAME (frame
);
752 /***********************************************************************
754 ***********************************************************************/
756 /* Initialize face cache and basic faces for frame F. */
759 init_frame_faces (struct frame
*f
)
761 /* Make a face cache, if F doesn't have one. */
762 if (FRAME_FACE_CACHE (f
) == NULL
)
763 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
765 #ifdef HAVE_WINDOW_SYSTEM
766 /* Make the image cache. */
767 if (FRAME_WINDOW_P (f
))
769 /* We initialize the image cache when creating the first frame
770 on a terminal, and not during terminal creation. This way,
771 `x-open-connection' on a tty won't create an image cache. */
772 if (FRAME_IMAGE_CACHE (f
) == NULL
)
773 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
774 ++FRAME_IMAGE_CACHE (f
)->refcount
;
776 #endif /* HAVE_WINDOW_SYSTEM */
778 /* Realize basic faces. Must have enough information in frame
779 parameters to realize basic faces at this point. */
780 #ifdef HAVE_X_WINDOWS
781 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
784 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
787 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
789 if (!realize_basic_faces (f
))
794 /* Free face cache of frame F. Called from delete_frame. */
797 free_frame_faces (struct frame
*f
)
799 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
803 free_face_cache (face_cache
);
804 FRAME_FACE_CACHE (f
) = NULL
;
807 #ifdef HAVE_WINDOW_SYSTEM
808 if (FRAME_WINDOW_P (f
))
810 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
813 --image_cache
->refcount
;
814 if (image_cache
->refcount
== 0)
815 free_image_cache (f
);
818 #endif /* HAVE_WINDOW_SYSTEM */
822 /* Clear face caches, and recompute basic faces for frame F. Call
823 this after changing frame parameters on which those faces depend,
824 or when realized faces have been freed due to changing attributes
828 recompute_basic_faces (struct frame
*f
)
830 if (FRAME_FACE_CACHE (f
))
832 clear_face_cache (0);
833 if (!realize_basic_faces (f
))
839 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
840 try to free unused fonts, too. */
843 clear_face_cache (int clear_fonts_p
)
845 #ifdef HAVE_WINDOW_SYSTEM
846 Lisp_Object tail
, frame
;
849 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
852 /* Not yet implemented. */
853 clear_font_cache (frame
);
856 /* From time to time see if we can unload some fonts. This also
857 frees all realized faces on all frames. Fonts needed by
858 faces will be loaded again when faces are realized again. */
859 clear_font_table_count
= 0;
861 FOR_EACH_FRAME (tail
, frame
)
863 struct frame
*f
= XFRAME (frame
);
864 if (FRAME_WINDOW_P (f
)
865 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
866 free_all_realized_faces (frame
);
871 /* Clear GCs of realized faces. */
872 FOR_EACH_FRAME (tail
, frame
)
874 struct frame
*f
= XFRAME (frame
);
875 if (FRAME_WINDOW_P (f
))
876 clear_face_gcs (FRAME_FACE_CACHE (f
));
878 clear_image_caches (Qnil
);
880 #endif /* HAVE_WINDOW_SYSTEM */
884 DEFUE ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
885 doc
: /* Clear face caches on all frames.
886 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
887 (Lisp_Object thoroughly
)
889 clear_face_cache (!NILP (thoroughly
));
891 ++windows_or_buffers_changed
;
896 /***********************************************************************
898 ***********************************************************************/
900 #ifdef HAVE_WINDOW_SYSTEM
902 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
903 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
904 A bitmap specification is either a string, a file name, or a list
905 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
906 HEIGHT is its height, and DATA is a string containing the bits of
907 the pixmap. Bits are stored row by row, each row occupies
908 \(WIDTH + 7)/8 bytes. */)
913 if (STRINGP (object
))
914 /* If OBJECT is a string, it's a file name. */
916 else if (CONSP (object
))
918 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
919 HEIGHT must be integers > 0, and DATA must be string large
920 enough to hold a bitmap of the specified size. */
921 Lisp_Object width
, height
, data
;
923 height
= width
= data
= Qnil
;
927 width
= XCAR (object
);
928 object
= XCDR (object
);
931 height
= XCAR (object
);
932 object
= XCDR (object
);
934 data
= XCAR (object
);
938 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
940 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
942 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
947 return pixmap_p
? Qt
: Qnil
;
951 /* Load a bitmap according to NAME (which is either a file name or a
952 pixmap spec) for use on frame F. Value is the bitmap_id (see
953 xfns.c). If NAME is nil, return with a bitmap id of zero. If
954 bitmap cannot be loaded, display a message saying so, and return
955 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
956 if these pointers are not null. */
959 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
, unsigned int *h_ptr
)
966 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
971 /* Decode a bitmap spec into a bitmap. */
976 w
= XINT (Fcar (name
));
977 h
= XINT (Fcar (Fcdr (name
)));
978 bits
= Fcar (Fcdr (Fcdr (name
)));
980 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
985 /* It must be a string -- a file name. */
986 bitmap_id
= x_create_bitmap_from_file (f
, name
);
992 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
1003 ++npixmaps_allocated
;
1006 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1009 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1015 #endif /* HAVE_WINDOW_SYSTEM */
1019 /***********************************************************************
1021 ***********************************************************************/
1023 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1024 RGB_LIST should contain (at least) 3 lisp integers.
1025 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1028 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1030 #define PARSE_RGB_LIST_FIELD(field) \
1031 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1033 color->field = XINT (XCAR (rgb_list)); \
1034 rgb_list = XCDR (rgb_list); \
1039 PARSE_RGB_LIST_FIELD (red
);
1040 PARSE_RGB_LIST_FIELD (green
);
1041 PARSE_RGB_LIST_FIELD (blue
);
1047 /* Lookup on frame F the color described by the lisp string COLOR.
1048 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1049 non-zero, then the `standard' definition of the same color is
1053 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
, XColor
*std_color
)
1055 Lisp_Object frame
, color_desc
;
1057 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1060 XSETFRAME (frame
, f
);
1062 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1063 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1067 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1070 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1072 rgb
= XCDR (XCDR (color_desc
));
1073 if (! parse_rgb_list (rgb
, tty_color
))
1076 /* Should we fill in STD_COLOR too? */
1079 /* Default STD_COLOR to the same as TTY_COLOR. */
1080 *std_color
= *tty_color
;
1082 /* Do a quick check to see if the returned descriptor is
1083 actually _exactly_ equal to COLOR, otherwise we have to
1084 lookup STD_COLOR separately. If it's impossible to lookup
1085 a standard color, we just give up and use TTY_COLOR. */
1086 if ((!STRINGP (XCAR (color_desc
))
1087 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1088 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1090 /* Look up STD_COLOR separately. */
1091 rgb
= call1 (Qtty_color_standard_values
, color
);
1092 if (! parse_rgb_list (rgb
, std_color
))
1099 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1100 /* We were called early during startup, and the colors are not
1101 yet set up in tty-defined-color-alist. Don't return a failure
1102 indication, since this produces the annoying "Unable to
1103 load color" messages in the *Messages* buffer. */
1106 /* tty-color-desc seems to have returned a bad value. */
1110 /* A version of defined_color for non-X frames. */
1113 tty_defined_color (struct frame
*f
, const char *color_name
,
1114 XColor
*color_def
, int alloc
)
1119 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1121 color_def
->blue
= 0;
1122 color_def
->green
= 0;
1125 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1127 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1129 if (strcmp (color_name
, "unspecified-fg") == 0)
1130 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1131 else if (strcmp (color_name
, "unspecified-bg") == 0)
1132 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1135 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1142 /* Decide if color named COLOR_NAME is valid for the display
1143 associated with the frame F; if so, return the rgb values in
1144 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1146 This does the right thing for any type of frame. */
1149 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
, int alloc
)
1151 if (!FRAME_WINDOW_P (f
))
1152 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1153 #ifdef HAVE_X_WINDOWS
1154 else if (FRAME_X_P (f
))
1155 return x_defined_color (f
, color_name
, color_def
, alloc
);
1158 else if (FRAME_W32_P (f
))
1159 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1162 else if (FRAME_NS_P (f
))
1163 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1170 /* Given the index IDX of a tty color on frame F, return its name, a
1174 tty_color_name (struct frame
*f
, int idx
)
1176 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1179 Lisp_Object coldesc
;
1181 XSETFRAME (frame
, f
);
1182 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1184 if (!NILP (coldesc
))
1185 return XCAR (coldesc
);
1188 /* We can have an MSDOG frame under -nw for a short window of
1189 opportunity before internal_terminal_init is called. DTRT. */
1190 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1191 return msdos_stdcolor_name (idx
);
1194 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1195 return build_string (unspecified_fg
);
1196 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1197 return build_string (unspecified_bg
);
1199 return Qunspecified
;
1203 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1206 The criterion implemented here is not a terribly sophisticated one. */
1209 face_color_gray_p (struct frame
*f
, const char *color_name
)
1214 if (defined_color (f
, color_name
, &color
, 0))
1215 gray_p
= (/* Any color sufficiently close to black counts as grey. */
1216 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1218 ((eabs (color
.red
- color
.green
)
1219 < max (color
.red
, color
.green
) / 20)
1220 && (eabs (color
.green
- color
.blue
)
1221 < max (color
.green
, color
.blue
) / 20)
1222 && (eabs (color
.blue
- color
.red
)
1223 < max (color
.blue
, color
.red
) / 20)));
1231 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1232 BACKGROUND_P non-zero means the color will be used as background
1236 face_color_supported_p (struct frame
*f
, const char *color_name
, int background_p
)
1241 XSETFRAME (frame
, f
);
1243 #ifdef HAVE_WINDOW_SYSTEM
1245 ? (!NILP (Fxw_display_color_p (frame
))
1246 || xstrcasecmp (color_name
, "black") == 0
1247 || xstrcasecmp (color_name
, "white") == 0
1249 && face_color_gray_p (f
, color_name
))
1250 || (!NILP (Fx_display_grayscale_p (frame
))
1251 && face_color_gray_p (f
, color_name
)))
1254 tty_defined_color (f
, color_name
, ¬_used
, 0);
1258 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1259 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1260 FRAME specifies the frame and thus the display for interpreting COLOR.
1261 If FRAME is nil or omitted, use the selected frame. */)
1262 (Lisp_Object color
, Lisp_Object frame
)
1266 CHECK_STRING (color
);
1268 frame
= selected_frame
;
1270 CHECK_FRAME (frame
);
1272 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1276 DEFUN ("color-supported-p", Fcolor_supported_p
,
1277 Scolor_supported_p
, 1, 3, 0,
1278 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1279 BACKGROUND-P non-nil means COLOR is used as a background.
1280 Otherwise, this function tells whether it can be used as a foreground.
1281 If FRAME is nil or omitted, use the selected frame.
1282 COLOR must be a valid color name. */)
1283 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1287 CHECK_STRING (color
);
1289 frame
= selected_frame
;
1291 CHECK_FRAME (frame
);
1293 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1299 /* Load color with name NAME for use by face FACE on frame F.
1300 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1301 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1302 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1303 pixel color. If color cannot be loaded, display a message, and
1304 return the foreground, background or underline color of F, but
1305 record that fact in flags of the face so that we don't try to free
1309 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
, enum lface_attribute_index target_index
)
1313 xassert (STRINGP (name
));
1314 xassert (target_index
== LFACE_FOREGROUND_INDEX
1315 || target_index
== LFACE_BACKGROUND_INDEX
1316 || target_index
== LFACE_UNDERLINE_INDEX
1317 || target_index
== LFACE_OVERLINE_INDEX
1318 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1319 || target_index
== LFACE_BOX_INDEX
);
1321 /* if the color map is full, defined_color will return a best match
1322 to the values in an existing cell. */
1323 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1325 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1327 switch (target_index
)
1329 case LFACE_FOREGROUND_INDEX
:
1330 face
->foreground_defaulted_p
= 1;
1331 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1334 case LFACE_BACKGROUND_INDEX
:
1335 face
->background_defaulted_p
= 1;
1336 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1339 case LFACE_UNDERLINE_INDEX
:
1340 face
->underline_defaulted_p
= 1;
1341 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1344 case LFACE_OVERLINE_INDEX
:
1345 face
->overline_color_defaulted_p
= 1;
1346 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1349 case LFACE_STRIKE_THROUGH_INDEX
:
1350 face
->strike_through_color_defaulted_p
= 1;
1351 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1354 case LFACE_BOX_INDEX
:
1355 face
->box_color_defaulted_p
= 1;
1356 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1365 ++ncolors_allocated
;
1372 #ifdef HAVE_WINDOW_SYSTEM
1374 /* Load colors for face FACE which is used on frame F. Colors are
1375 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1376 of ATTRS. If the background color specified is not supported on F,
1377 try to emulate gray colors with a stipple from Vface_default_stipple. */
1380 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1384 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1385 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1387 /* Swap colors if face is inverse-video. */
1388 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1396 /* Check for support for foreground, not for background because
1397 face_color_supported_p is smart enough to know that grays are
1398 "supported" as background because we are supposed to use stipple
1400 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1401 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1403 x_destroy_bitmap (f
, face
->stipple
);
1404 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1405 &face
->pixmap_w
, &face
->pixmap_h
);
1408 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1409 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1413 /* Free color PIXEL on frame F. */
1416 unload_color (struct frame
*f
, long unsigned int pixel
)
1418 #ifdef HAVE_X_WINDOWS
1422 x_free_colors (f
, &pixel
, 1);
1429 /* Free colors allocated for FACE. */
1432 free_face_colors (struct frame
*f
, struct face
*face
)
1434 /* PENDING(NS): need to do something here? */
1435 #ifdef HAVE_X_WINDOWS
1436 if (face
->colors_copied_bitwise_p
)
1441 if (!face
->foreground_defaulted_p
)
1443 x_free_colors (f
, &face
->foreground
, 1);
1444 IF_DEBUG (--ncolors_allocated
);
1447 if (!face
->background_defaulted_p
)
1449 x_free_colors (f
, &face
->background
, 1);
1450 IF_DEBUG (--ncolors_allocated
);
1453 if (face
->underline_p
1454 && !face
->underline_defaulted_p
)
1456 x_free_colors (f
, &face
->underline_color
, 1);
1457 IF_DEBUG (--ncolors_allocated
);
1460 if (face
->overline_p
1461 && !face
->overline_color_defaulted_p
)
1463 x_free_colors (f
, &face
->overline_color
, 1);
1464 IF_DEBUG (--ncolors_allocated
);
1467 if (face
->strike_through_p
1468 && !face
->strike_through_color_defaulted_p
)
1470 x_free_colors (f
, &face
->strike_through_color
, 1);
1471 IF_DEBUG (--ncolors_allocated
);
1474 if (face
->box
!= FACE_NO_BOX
1475 && !face
->box_color_defaulted_p
)
1477 x_free_colors (f
, &face
->box_color
, 1);
1478 IF_DEBUG (--ncolors_allocated
);
1482 #endif /* HAVE_X_WINDOWS */
1485 #endif /* HAVE_WINDOW_SYSTEM */
1489 /***********************************************************************
1491 ***********************************************************************/
1493 /* An enumerator for each field of an XLFD font name. */
1514 /* An enumerator for each possible slant value of a font. Taken from
1515 the XLFD specification. */
1523 XLFD_SLANT_REVERSE_ITALIC
,
1524 XLFD_SLANT_REVERSE_OBLIQUE
,
1528 /* Relative font weight according to XLFD documentation. */
1532 XLFD_WEIGHT_UNKNOWN
,
1533 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1534 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1535 XLFD_WEIGHT_LIGHT
, /* 30 */
1536 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1537 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1538 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1539 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1540 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1541 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1544 /* Relative proportionate width. */
1548 XLFD_SWIDTH_UNKNOWN
,
1549 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1550 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1551 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1552 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1553 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1554 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1555 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1556 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1557 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1560 /* Order by which font selection chooses fonts. The default values
1561 mean `first, find a best match for the font width, then for the
1562 font height, then for weight, then for slant.' This variable can be
1563 set via set-face-font-sort-order. */
1565 static int font_sort_order
[4];
1567 #ifdef HAVE_WINDOW_SYSTEM
1569 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1572 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1574 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1575 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1578 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1580 enum font_property_index idx
= font_props_for_sorting
[i
];
1581 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1584 if (idx
<= FONT_REGISTRY_INDEX
)
1587 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1589 result
= STRINGP (val2
) ? 1 : 0;
1593 if (INTEGERP (val1
))
1594 result
= INTEGERP (val2
) ? XINT (val1
) - XINT (val2
) : -1;
1596 result
= INTEGERP (val2
) ? 1 : 0;
1604 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1605 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1606 If FAMILY is omitted or nil, list all families.
1607 Otherwise, FAMILY must be a string, possibly containing wildcards
1609 If FRAME is omitted or nil, use the selected frame.
1610 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1611 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1612 FAMILY is the font family name. POINT-SIZE is the size of the
1613 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1614 width, weight and slant of the font. These symbols are the same as for
1615 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1616 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1617 giving the registry and encoding of the font.
1618 The result list is sorted according to the current setting of
1619 the face font sort order. */)
1620 (Lisp_Object family
, Lisp_Object frame
)
1622 Lisp_Object font_spec
, list
, *drivers
, vec
;
1623 int i
, nfonts
, ndrivers
;
1627 frame
= selected_frame
;
1628 CHECK_LIVE_FRAME (frame
);
1630 font_spec
= Ffont_spec (0, NULL
);
1633 CHECK_STRING (family
);
1634 font_parse_family_registry (family
, Qnil
, font_spec
);
1637 list
= font_list_entities (frame
, font_spec
);
1641 /* Sort the font entities. */
1642 for (i
= 0; i
< 4; i
++)
1643 switch (font_sort_order
[i
])
1646 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1647 case XLFD_POINT_SIZE
:
1648 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1650 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1652 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1654 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1655 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1656 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1657 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1659 ndrivers
= XINT (Flength (list
));
1660 drivers
= alloca (sizeof (Lisp_Object
) * ndrivers
);
1661 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1662 drivers
[i
] = XCAR (list
);
1663 vec
= Fvconcat (ndrivers
, drivers
);
1664 nfonts
= ASIZE (vec
);
1666 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1667 compare_fonts_by_sort_order
);
1670 for (i
= nfonts
- 1; i
>= 0; --i
)
1672 Lisp_Object font
= AREF (vec
, i
);
1673 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1675 Lisp_Object spacing
;
1677 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1678 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1679 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1680 XFRAME (frame
)->resy
);
1681 ASET (v
, 2, make_number (point
));
1682 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1683 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1684 spacing
= Ffont_get (font
, QCspacing
);
1685 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1686 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1687 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1689 result
= Fcons (v
, result
);
1695 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1696 doc
: /* Return a list of the names of available fonts matching PATTERN.
1697 If optional arguments FACE and FRAME are specified, return only fonts
1698 the same size as FACE on FRAME.
1700 PATTERN should be a string containing a font name in the XLFD,
1701 Fontconfig, or GTK format. A font name given in the XLFD format may
1702 contain wildcard characters:
1703 the * character matches any substring, and
1704 the ? character matches any single character.
1705 PATTERN is case-insensitive.
1707 The return value is a list of strings, suitable as arguments to
1710 Fonts Emacs can't use may or may not be excluded
1711 even if they match PATTERN and FACE.
1712 The optional fourth argument MAXIMUM sets a limit on how many
1713 fonts to match. The first MAXIMUM fonts are reported.
1714 The optional fifth argument WIDTH, if specified, is a number of columns
1715 occupied by a character of a font. In that case, return only fonts
1716 the WIDTH times as wide as FACE on FRAME. */)
1717 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
, Lisp_Object maximum
, Lisp_Object width
)
1720 int size
, avgwidth
IF_LINT (= 0);
1723 CHECK_STRING (pattern
);
1725 if (! NILP (maximum
))
1726 CHECK_NATNUM (maximum
);
1729 CHECK_NUMBER (width
);
1731 /* We can't simply call check_x_frame because this function may be
1732 called before any frame is created. */
1734 frame
= selected_frame
;
1735 f
= frame_or_selected_frame (frame
, 2);
1736 if (! FRAME_WINDOW_P (f
))
1738 /* Perhaps we have not yet created any frame. */
1744 /* Determine the width standard for comparison with the fonts we find. */
1750 /* This is of limited utility since it works with character
1751 widths. Keep it for compatibility. --gerd. */
1752 int face_id
= lookup_named_face (f
, face
, 0);
1753 struct face
*width_face
= (face_id
< 0
1755 : FACE_FROM_ID (f
, face_id
));
1757 if (width_face
&& width_face
->font
)
1759 size
= width_face
->font
->pixel_size
;
1760 avgwidth
= width_face
->font
->average_width
;
1764 size
= FRAME_FONT (f
)->pixel_size
;
1765 avgwidth
= FRAME_FONT (f
)->average_width
;
1768 avgwidth
*= XINT (width
);
1772 Lisp_Object font_spec
;
1773 Lisp_Object args
[2], tail
;
1775 font_spec
= font_spec_from_name (pattern
);
1776 if (!FONTP (font_spec
))
1777 signal_error ("Invalid font name", pattern
);
1781 Ffont_put (font_spec
, QCsize
, make_number (size
));
1782 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1784 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1785 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1787 Lisp_Object font_entity
;
1789 font_entity
= XCAR (tail
);
1790 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1791 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1792 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1794 /* This is a scalable font. For backward compatibility,
1795 we set the specified size. */
1796 font_entity
= copy_font_spec (font_entity
);
1797 ASET (font_entity
, FONT_SIZE_INDEX
,
1798 AREF (font_spec
, FONT_SIZE_INDEX
));
1800 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1803 /* We don't have to check fontsets. */
1805 args
[1] = list_fontsets (f
, pattern
, size
);
1806 return Fnconc (2, args
);
1810 #endif /* HAVE_WINDOW_SYSTEM */
1813 /***********************************************************************
1815 ***********************************************************************/
1817 /* Access face attributes of face LFACE, a Lisp vector. */
1819 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1820 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1821 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1822 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1823 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1824 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1825 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1826 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1827 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1828 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1829 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1830 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1831 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1832 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1833 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1834 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1835 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1838 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1839 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1841 #define LFACEP(LFACE) \
1843 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
1844 && EQ (AREF (LFACE, 0), Qface))
1850 /* Check consistency of Lisp face attribute vector ATTRS. */
1853 check_lface_attrs (attrs
)
1856 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1857 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1858 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1859 xassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1860 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1861 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1862 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1863 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1864 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1865 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1866 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1867 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1868 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1869 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1870 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1871 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1872 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1873 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1874 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1875 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1876 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1877 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1878 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1879 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
1880 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1881 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1882 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1883 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1884 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1885 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1886 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1887 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1888 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1889 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1890 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1891 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1892 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1893 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1894 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1895 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1896 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1897 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1898 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1899 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1900 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1901 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1902 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1903 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1904 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1905 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1906 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1907 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1908 #ifdef HAVE_WINDOW_SYSTEM
1909 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1910 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1911 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1912 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1913 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1914 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1915 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1916 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1917 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
1922 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1930 xassert (LFACEP (lface
));
1931 check_lface_attrs (XVECTOR (lface
)->contents
);
1935 #else /* GLYPH_DEBUG == 0 */
1937 #define check_lface_attrs(attrs) (void) 0
1938 #define check_lface(lface) (void) 0
1940 #endif /* GLYPH_DEBUG == 0 */
1944 /* Face-merge cycle checking. */
1946 enum named_merge_point_kind
1948 NAMED_MERGE_POINT_NORMAL
,
1949 NAMED_MERGE_POINT_REMAP
1952 /* A `named merge point' is simply a point during face-merging where we
1953 look up a face by name. We keep a stack of which named lookups we're
1954 currently processing so that we can easily detect cycles, using a
1955 linked- list of struct named_merge_point structures, typically
1956 allocated on the stack frame of the named lookup functions which are
1957 active (so no consing is required). */
1958 struct named_merge_point
1960 Lisp_Object face_name
;
1961 enum named_merge_point_kind named_merge_point_kind
;
1962 struct named_merge_point
*prev
;
1966 /* If a face merging cycle is detected for FACE_NAME, return 0,
1967 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1968 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1969 pointed to by NAMED_MERGE_POINTS, and return 1. */
1972 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1973 Lisp_Object face_name
,
1974 enum named_merge_point_kind named_merge_point_kind
,
1975 struct named_merge_point
**named_merge_points
)
1977 struct named_merge_point
*prev
;
1979 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1980 if (EQ (face_name
, prev
->face_name
))
1982 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1983 /* A cycle, so fail. */
1985 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1986 /* A remap `hides ' any previous normal merge points
1987 (because the remap means that it's actually different face),
1988 so as we know the current merge point must be normal, we
1989 can just assume it's OK. */
1993 new_named_merge_point
->face_name
= face_name
;
1994 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1995 new_named_merge_point
->prev
= *named_merge_points
;
1997 *named_merge_points
= new_named_merge_point
;
2004 #if 0 /* Seems to be unused. */
2006 internal_resolve_face_name (nargs
, args
)
2010 return Fget (args
[0], args
[1]);
2014 resolve_face_name_error (ignore
)
2021 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2022 to make it a symbol. If FACE_NAME is an alias for another face,
2023 return that face's name.
2025 Return default face in case of errors. */
2028 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2030 Lisp_Object orig_face
;
2031 Lisp_Object tortoise
, hare
;
2033 if (STRINGP (face_name
))
2034 face_name
= intern (SSDATA (face_name
));
2036 if (NILP (face_name
) || !SYMBOLP (face_name
))
2039 orig_face
= face_name
;
2040 tortoise
= hare
= face_name
;
2045 hare
= Fget (hare
, Qface_alias
);
2046 if (NILP (hare
) || !SYMBOLP (hare
))
2050 hare
= Fget (hare
, Qface_alias
);
2051 if (NILP (hare
) || !SYMBOLP (hare
))
2054 tortoise
= Fget (tortoise
, Qface_alias
);
2055 if (EQ (hare
, tortoise
))
2058 xsignal1 (Qcircular_list
, orig_face
);
2067 /* Return the face definition of FACE_NAME on frame F. F null means
2068 return the definition for new frames. FACE_NAME may be a string or
2069 a symbol (apparently Emacs 20.2 allowed strings as face names in
2070 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2071 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2072 is zero, value is nil if FACE_NAME is not a valid face name. */
2073 static INLINE Lisp_Object
2074 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2079 lface
= assq_no_quit (face_name
, f
->face_alist
);
2081 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2084 lface
= XCDR (lface
);
2086 signal_error ("Invalid face", face_name
);
2088 check_lface (lface
);
2093 /* Return the face definition of FACE_NAME on frame F. F null means
2094 return the definition for new frames. FACE_NAME may be a string or
2095 a symbol (apparently Emacs 20.2 allowed strings as face names in
2096 face text properties; Ediff uses that). If FACE_NAME is an alias
2097 for another face, return that face's definition. If SIGNAL_P is
2098 non-zero, signal an error if FACE_NAME is not a valid face name.
2099 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2101 static INLINE Lisp_Object
2102 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2104 face_name
= resolve_face_name (face_name
, signal_p
);
2105 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2109 /* Get face attributes of face FACE_NAME from frame-local faces on
2110 frame F. Store the resulting attributes in ATTRS which must point
2111 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2112 is non-zero, signal an error if FACE_NAME does not name a face.
2113 Otherwise, value is zero if FACE_NAME is not a face. */
2116 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*attrs
, int signal_p
)
2120 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2123 memcpy (attrs
, XVECTOR (lface
)->contents
,
2124 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2126 return !NILP (lface
);
2129 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2130 F. Store the resulting attributes in ATTRS which must point to a
2131 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2132 alias for another face, use that face's definition. If SIGNAL_P is
2133 non-zero, signal an error if FACE_NAME does not name a face.
2134 Otherwise, value is zero if FACE_NAME is not a face. */
2137 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*attrs
, int signal_p
, struct named_merge_point
*named_merge_points
)
2139 Lisp_Object face_remapping
;
2141 face_name
= resolve_face_name (face_name
, signal_p
);
2143 /* See if SYMBOL has been remapped to some other face (usually this
2144 is done buffer-locally). */
2145 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2146 if (CONSP (face_remapping
))
2148 struct named_merge_point named_merge_point
;
2150 if (push_named_merge_point (&named_merge_point
,
2151 face_name
, NAMED_MERGE_POINT_REMAP
,
2152 &named_merge_points
))
2156 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2157 attrs
[i
] = Qunspecified
;
2159 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2160 signal_p
, named_merge_points
);
2164 /* Default case, no remapping. */
2165 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2169 /* Non-zero if all attributes in face attribute vector ATTRS are
2170 specified, i.e. are non-nil. */
2173 lface_fully_specified_p (Lisp_Object
*attrs
)
2177 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2178 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2179 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2182 return i
== LFACE_VECTOR_SIZE
;
2185 #ifdef HAVE_WINDOW_SYSTEM
2187 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2188 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2189 exception is `font' attribute. It is set to FONT_OBJECT regardless
2193 set_lface_from_font (struct frame
*f
, Lisp_Object lface
, Lisp_Object font_object
, int force_p
)
2196 struct font
*font
= XFONT_OBJECT (font_object
);
2198 /* Set attributes only if unspecified, otherwise face defaults for
2199 new frames would never take effect. If the font doesn't have a
2200 specific property, set a normal value for that. */
2202 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2204 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2206 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2209 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2211 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2213 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2216 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2218 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2221 LFACE_HEIGHT (lface
) = make_number (pt
);
2224 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2226 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2227 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2229 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2231 val
= FONT_SLANT_FOR_FACE (font_object
);
2232 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2234 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2236 val
= FONT_WIDTH_FOR_FACE (font_object
);
2237 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2240 LFACE_FONT (lface
) = font_object
;
2244 #endif /* HAVE_WINDOW_SYSTEM */
2247 /* Merges the face height FROM with the face height TO, and returns the
2248 merged height. If FROM is an invalid height, then INVALID is
2249 returned instead. FROM and TO may be either absolute face heights or
2250 `relative' heights; the returned value is always an absolute height
2251 unless both FROM and TO are relative. */
2254 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2256 Lisp_Object result
= invalid
;
2258 if (INTEGERP (from
))
2259 /* FROM is absolute, just use it as is. */
2261 else if (FLOATP (from
))
2262 /* FROM is a scale, use it to adjust TO. */
2265 /* relative X absolute => absolute */
2266 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
2267 else if (FLOATP (to
))
2268 /* relative X relative => relative */
2269 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2270 else if (UNSPECIFIEDP (to
))
2273 else if (FUNCTIONP (from
))
2274 /* FROM is a function, which use to adjust TO. */
2276 /* Call function with current height as argument.
2277 From is the new height. */
2278 Lisp_Object args
[2];
2282 result
= safe_call (2, args
);
2284 /* Ensure that if TO was absolute, so is the result. */
2285 if (INTEGERP (to
) && !INTEGERP (result
))
2293 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2294 store the resulting attributes in TO, which must be already be
2295 completely specified and contain only absolute attributes. Every
2296 specified attribute of FROM overrides the corresponding attribute of
2297 TO; relative attributes in FROM are merged with the absolute value in
2298 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2299 loops in face inheritance/remapping; it should be 0 when called from
2303 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
, struct named_merge_point
*named_merge_points
)
2307 /* If FROM inherits from some other faces, merge their attributes into
2308 TO before merging FROM's direct attributes. Note that an :inherit
2309 attribute of `unspecified' is the same as one of nil; we never
2310 merge :inherit attributes, so nil is more correct, but lots of
2311 other code uses `unspecified' as a generic value for face attributes. */
2312 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2313 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2314 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2316 i
= LFACE_FONT_INDEX
;
2317 if (!UNSPECIFIEDP (from
[i
]))
2319 if (!UNSPECIFIEDP (to
[i
]))
2320 to
[i
] = merge_font_spec (from
[i
], to
[i
]);
2322 to
[i
] = copy_font_spec (from
[i
]);
2323 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2324 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2325 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2326 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2327 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2328 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2329 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2330 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2331 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2332 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2333 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2336 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2337 if (!UNSPECIFIEDP (from
[i
]))
2339 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2341 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2342 font_clear_prop (to
, FONT_SIZE_INDEX
);
2344 else if (i
!= LFACE_FONT_INDEX
2345 && ! EQ (to
[i
], from
[i
]))
2348 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2349 font_clear_prop (to
,
2350 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2351 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2352 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2353 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2354 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2355 : FONT_SLANT_INDEX
));
2359 /* TO is always an absolute face, which should inherit from nothing.
2360 We blindly copy the :inherit attribute above and fix it up here. */
2361 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2364 /* Merge the named face FACE_NAME on frame F, into the vector of face
2365 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2366 inheritance. Returns true if FACE_NAME is a valid face name and
2367 merging succeeded. */
2370 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
, struct named_merge_point
*named_merge_points
)
2372 struct named_merge_point named_merge_point
;
2374 if (push_named_merge_point (&named_merge_point
,
2375 face_name
, NAMED_MERGE_POINT_NORMAL
,
2376 &named_merge_points
))
2378 struct gcpro gcpro1
;
2379 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2380 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2384 GCPRO1 (named_merge_point
.face_name
);
2385 merge_face_vectors (f
, from
, to
, named_merge_points
);
2396 /* Merge face attributes from the lisp `face reference' FACE_REF on
2397 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2398 problems with FACE_REF cause an error message to be shown. Return
2399 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2400 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2401 list structure; it may be 0 for most callers.
2403 FACE_REF may be a single face specification or a list of such
2404 specifications. Each face specification can be:
2406 1. A symbol or string naming a Lisp face.
2408 2. A property list of the form (KEYWORD VALUE ...) where each
2409 KEYWORD is a face attribute name, and value is an appropriate value
2412 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2413 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2414 for compatibility with 20.2.
2416 Face specifications earlier in lists take precedence over later
2420 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
, int err_msgs
, struct named_merge_point
*named_merge_points
)
2422 int ok
= 1; /* Succeed without an error? */
2424 if (CONSP (face_ref
))
2426 Lisp_Object first
= XCAR (face_ref
);
2428 if (EQ (first
, Qforeground_color
)
2429 || EQ (first
, Qbackground_color
))
2431 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2432 . COLOR). COLOR must be a string. */
2433 Lisp_Object color_name
= XCDR (face_ref
);
2434 Lisp_Object color
= first
;
2436 if (STRINGP (color_name
))
2438 if (EQ (color
, Qforeground_color
))
2439 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2441 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2446 add_to_log ("Invalid face color", color_name
, Qnil
);
2450 else if (SYMBOLP (first
)
2451 && *SDATA (SYMBOL_NAME (first
)) == ':')
2453 /* Assume this is the property list form. */
2454 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2456 Lisp_Object keyword
= XCAR (face_ref
);
2457 Lisp_Object value
= XCAR (XCDR (face_ref
));
2460 /* Specifying `unspecified' is a no-op. */
2461 if (EQ (value
, Qunspecified
))
2463 else if (EQ (keyword
, QCfamily
))
2465 if (STRINGP (value
))
2467 to
[LFACE_FAMILY_INDEX
] = value
;
2468 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2473 else if (EQ (keyword
, QCfoundry
))
2475 if (STRINGP (value
))
2477 to
[LFACE_FOUNDRY_INDEX
] = value
;
2478 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2483 else if (EQ (keyword
, QCheight
))
2485 Lisp_Object new_height
=
2486 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2488 if (! NILP (new_height
))
2490 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2491 font_clear_prop (to
, FONT_SIZE_INDEX
);
2496 else if (EQ (keyword
, QCweight
))
2498 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2500 to
[LFACE_WEIGHT_INDEX
] = value
;
2501 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2506 else if (EQ (keyword
, QCslant
))
2508 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2510 to
[LFACE_SLANT_INDEX
] = value
;
2511 font_clear_prop (to
, FONT_SLANT_INDEX
);
2516 else if (EQ (keyword
, QCunderline
))
2521 to
[LFACE_UNDERLINE_INDEX
] = value
;
2525 else if (EQ (keyword
, QCoverline
))
2530 to
[LFACE_OVERLINE_INDEX
] = value
;
2534 else if (EQ (keyword
, QCstrike_through
))
2539 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2543 else if (EQ (keyword
, QCbox
))
2546 value
= make_number (1);
2547 if (INTEGERP (value
)
2551 to
[LFACE_BOX_INDEX
] = value
;
2555 else if (EQ (keyword
, QCinverse_video
)
2556 || EQ (keyword
, QCreverse_video
))
2558 if (EQ (value
, Qt
) || NILP (value
))
2559 to
[LFACE_INVERSE_INDEX
] = value
;
2563 else if (EQ (keyword
, QCforeground
))
2565 if (STRINGP (value
))
2566 to
[LFACE_FOREGROUND_INDEX
] = value
;
2570 else if (EQ (keyword
, QCbackground
))
2572 if (STRINGP (value
))
2573 to
[LFACE_BACKGROUND_INDEX
] = value
;
2577 else if (EQ (keyword
, QCstipple
))
2579 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
2580 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2581 if (!NILP (pixmap_p
))
2582 to
[LFACE_STIPPLE_INDEX
] = value
;
2587 else if (EQ (keyword
, QCwidth
))
2589 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2591 to
[LFACE_SWIDTH_INDEX
] = value
;
2592 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2597 else if (EQ (keyword
, QCinherit
))
2599 /* This is not really very useful; it's just like a
2600 normal face reference. */
2601 if (! merge_face_ref (f
, value
, to
,
2602 err_msgs
, named_merge_points
))
2610 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2614 face_ref
= XCDR (XCDR (face_ref
));
2619 /* This is a list of face refs. Those at the beginning of the
2620 list take precedence over what follows, so we have to merge
2621 from the end backwards. */
2622 Lisp_Object next
= XCDR (face_ref
);
2625 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2627 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2633 /* FACE_REF ought to be a face name. */
2634 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2635 if (!ok
&& err_msgs
)
2636 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2643 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2644 Sinternal_make_lisp_face
, 1, 2, 0,
2645 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2646 If FACE was not known as a face before, create a new one.
2647 If optional argument FRAME is specified, make a frame-local face
2648 for that frame. Otherwise operate on the global face definition.
2649 Value is a vector of face attributes. */)
2650 (Lisp_Object face
, Lisp_Object frame
)
2652 Lisp_Object global_lface
, lface
;
2656 CHECK_SYMBOL (face
);
2657 global_lface
= lface_from_face_name (NULL
, face
, 0);
2661 CHECK_LIVE_FRAME (frame
);
2663 lface
= lface_from_face_name (f
, face
, 0);
2666 f
= NULL
, lface
= Qnil
;
2668 /* Add a global definition if there is none. */
2669 if (NILP (global_lface
))
2671 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2673 ASET (global_lface
, 0, Qface
);
2674 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2675 Vface_new_frame_defaults
);
2677 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2678 face id to Lisp face is given by the vector lface_id_to_name.
2679 The mapping from Lisp face to Lisp face id is given by the
2680 property `face' of the Lisp face name. */
2681 if (next_lface_id
== lface_id_to_name_size
)
2683 int new_size
= max (50, 2 * lface_id_to_name_size
);
2684 int sz
= new_size
* sizeof *lface_id_to_name
;
2685 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
2686 lface_id_to_name_size
= new_size
;
2689 lface_id_to_name
[next_lface_id
] = face
;
2690 Fput (face
, Qface
, make_number (next_lface_id
));
2694 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2695 ASET (global_lface
, i
, Qunspecified
);
2697 /* Add a frame-local definition. */
2702 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2704 ASET (lface
, 0, Qface
);
2705 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2708 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2709 ASET (lface
, i
, Qunspecified
);
2712 lface
= global_lface
;
2714 /* Changing a named face means that all realized faces depending on
2715 that face are invalid. Since we cannot tell which realized faces
2716 depend on the face, make sure they are all removed. This is done
2717 by incrementing face_change_count. The next call to
2718 init_iterator will then free realized faces. */
2719 if (NILP (Fget (face
, Qface_no_inherit
)))
2721 ++face_change_count
;
2722 ++windows_or_buffers_changed
;
2725 xassert (LFACEP (lface
));
2726 check_lface (lface
);
2731 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2732 Sinternal_lisp_face_p
, 1, 2, 0,
2733 doc
: /* Return non-nil if FACE names a face.
2734 FACE should be a symbol or string.
2735 If optional second argument FRAME is non-nil, check for the
2736 existence of a frame-local face with name FACE on that frame.
2737 Otherwise check for the existence of a global face. */)
2738 (Lisp_Object face
, Lisp_Object frame
)
2742 face
= resolve_face_name (face
, 1);
2746 CHECK_LIVE_FRAME (frame
);
2747 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2750 lface
= lface_from_face_name (NULL
, face
, 0);
2756 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2757 Sinternal_copy_lisp_face
, 4, 4, 0,
2758 doc
: /* Copy face FROM to TO.
2759 If FRAME is t, copy the global face definition of FROM.
2760 Otherwise, copy the frame-local definition of FROM on FRAME.
2761 If NEW-FRAME is a frame, copy that data into the frame-local
2762 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2763 FRAME controls where the data is copied to.
2765 The value is TO. */)
2766 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2768 Lisp_Object lface
, copy
;
2770 CHECK_SYMBOL (from
);
2775 /* Copy global definition of FROM. We don't make copies of
2776 strings etc. because 20.2 didn't do it either. */
2777 lface
= lface_from_face_name (NULL
, from
, 1);
2778 copy
= Finternal_make_lisp_face (to
, Qnil
);
2782 /* Copy frame-local definition of FROM. */
2783 if (NILP (new_frame
))
2785 CHECK_LIVE_FRAME (frame
);
2786 CHECK_LIVE_FRAME (new_frame
);
2787 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2788 copy
= Finternal_make_lisp_face (to
, new_frame
);
2791 memcpy (XVECTOR (copy
)->contents
, XVECTOR (lface
)->contents
,
2792 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2794 /* Changing a named face means that all realized faces depending on
2795 that face are invalid. Since we cannot tell which realized faces
2796 depend on the face, make sure they are all removed. This is done
2797 by incrementing face_change_count. The next call to
2798 init_iterator will then free realized faces. */
2799 if (NILP (Fget (to
, Qface_no_inherit
)))
2801 ++face_change_count
;
2802 ++windows_or_buffers_changed
;
2809 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2810 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2811 doc
: /* Set attribute ATTR of FACE to VALUE.
2812 FRAME being a frame means change the face on that frame.
2813 FRAME nil means change the face of the selected frame.
2814 FRAME t means change the default for new frames.
2815 FRAME 0 means change the face on all frames, and change the default
2817 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2820 Lisp_Object old_value
= Qnil
;
2821 /* Set one of enum font_property_index (> 0) if ATTR is one of
2822 font-related attributes other than QCfont and QCfontset. */
2823 enum font_property_index prop_index
= 0;
2825 CHECK_SYMBOL (face
);
2826 CHECK_SYMBOL (attr
);
2828 face
= resolve_face_name (face
, 1);
2830 /* If FRAME is 0, change face on all frames, and change the
2831 default for new frames. */
2832 if (INTEGERP (frame
) && XINT (frame
) == 0)
2835 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2836 FOR_EACH_FRAME (tail
, frame
)
2837 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2841 /* Set lface to the Lisp attribute vector of FACE. */
2844 lface
= lface_from_face_name (NULL
, face
, 1);
2846 /* When updating face-new-frame-defaults, we put :ignore-defface
2847 where the caller wants `unspecified'. This forces the frame
2848 defaults to ignore the defface value. Otherwise, the defface
2849 will take effect, which is generally not what is intended.
2850 The value of that attribute will be inherited from some other
2851 face during face merging. See internal_merge_in_global_face. */
2852 if (UNSPECIFIEDP (value
))
2853 value
= Qignore_defface
;
2858 frame
= selected_frame
;
2860 CHECK_LIVE_FRAME (frame
);
2861 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2863 /* If a frame-local face doesn't exist yet, create one. */
2865 lface
= Finternal_make_lisp_face (face
, frame
);
2868 if (EQ (attr
, QCfamily
))
2870 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2872 CHECK_STRING (value
);
2873 if (SCHARS (value
) == 0)
2874 signal_error ("Invalid face family", value
);
2876 old_value
= LFACE_FAMILY (lface
);
2877 LFACE_FAMILY (lface
) = value
;
2878 prop_index
= FONT_FAMILY_INDEX
;
2880 else if (EQ (attr
, QCfoundry
))
2882 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2884 CHECK_STRING (value
);
2885 if (SCHARS (value
) == 0)
2886 signal_error ("Invalid face foundry", value
);
2888 old_value
= LFACE_FOUNDRY (lface
);
2889 LFACE_FOUNDRY (lface
) = value
;
2890 prop_index
= FONT_FOUNDRY_INDEX
;
2892 else if (EQ (attr
, QCheight
))
2894 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2896 if (EQ (face
, Qdefault
))
2898 /* The default face must have an absolute size. */
2899 if (!INTEGERP (value
) || XINT (value
) <= 0)
2900 signal_error ("Default face height not absolute and positive", value
);
2904 /* For non-default faces, do a test merge with a random
2905 height to see if VALUE's ok. */
2906 Lisp_Object test
= merge_face_heights (value
,
2909 if (!INTEGERP (test
) || XINT (test
) <= 0)
2910 signal_error ("Face height does not produce a positive integer", value
);
2914 old_value
= LFACE_HEIGHT (lface
);
2915 LFACE_HEIGHT (lface
) = value
;
2916 prop_index
= FONT_SIZE_INDEX
;
2918 else if (EQ (attr
, QCweight
))
2920 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2922 CHECK_SYMBOL (value
);
2923 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2924 signal_error ("Invalid face weight", value
);
2926 old_value
= LFACE_WEIGHT (lface
);
2927 LFACE_WEIGHT (lface
) = value
;
2928 prop_index
= FONT_WEIGHT_INDEX
;
2930 else if (EQ (attr
, QCslant
))
2932 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2934 CHECK_SYMBOL (value
);
2935 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2936 signal_error ("Invalid face slant", value
);
2938 old_value
= LFACE_SLANT (lface
);
2939 LFACE_SLANT (lface
) = value
;
2940 prop_index
= FONT_SLANT_INDEX
;
2942 else if (EQ (attr
, QCunderline
))
2944 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2945 if ((SYMBOLP (value
)
2947 && !EQ (value
, Qnil
))
2948 /* Underline color. */
2950 && SCHARS (value
) == 0))
2951 signal_error ("Invalid face underline", value
);
2953 old_value
= LFACE_UNDERLINE (lface
);
2954 LFACE_UNDERLINE (lface
) = value
;
2956 else if (EQ (attr
, QCoverline
))
2958 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2959 if ((SYMBOLP (value
)
2961 && !EQ (value
, Qnil
))
2962 /* Overline color. */
2964 && SCHARS (value
) == 0))
2965 signal_error ("Invalid face overline", value
);
2967 old_value
= LFACE_OVERLINE (lface
);
2968 LFACE_OVERLINE (lface
) = value
;
2970 else if (EQ (attr
, QCstrike_through
))
2972 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2973 if ((SYMBOLP (value
)
2975 && !EQ (value
, Qnil
))
2976 /* Strike-through color. */
2978 && SCHARS (value
) == 0))
2979 signal_error ("Invalid face strike-through", value
);
2981 old_value
= LFACE_STRIKE_THROUGH (lface
);
2982 LFACE_STRIKE_THROUGH (lface
) = value
;
2984 else if (EQ (attr
, QCbox
))
2988 /* Allow t meaning a simple box of width 1 in foreground color
2991 value
= make_number (1);
2993 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2995 else if (NILP (value
))
2997 else if (INTEGERP (value
))
2998 valid_p
= XINT (value
) != 0;
2999 else if (STRINGP (value
))
3000 valid_p
= SCHARS (value
) > 0;
3001 else if (CONSP (value
))
3017 if (EQ (k
, QCline_width
))
3019 if (!INTEGERP (v
) || XINT (v
) == 0)
3022 else if (EQ (k
, QCcolor
))
3024 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3027 else if (EQ (k
, QCstyle
))
3029 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3036 valid_p
= NILP (tem
);
3042 signal_error ("Invalid face box", value
);
3044 old_value
= LFACE_BOX (lface
);
3045 LFACE_BOX (lface
) = value
;
3047 else if (EQ (attr
, QCinverse_video
)
3048 || EQ (attr
, QCreverse_video
))
3050 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3052 CHECK_SYMBOL (value
);
3053 if (!EQ (value
, Qt
) && !NILP (value
))
3054 signal_error ("Invalid inverse-video face attribute value", value
);
3056 old_value
= LFACE_INVERSE (lface
);
3057 LFACE_INVERSE (lface
) = value
;
3059 else if (EQ (attr
, QCforeground
))
3061 /* Compatibility with 20.x. */
3063 value
= Qunspecified
;
3064 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3066 /* Don't check for valid color names here because it depends
3067 on the frame (display) whether the color will be valid
3068 when the face is realized. */
3069 CHECK_STRING (value
);
3070 if (SCHARS (value
) == 0)
3071 signal_error ("Empty foreground color value", value
);
3073 old_value
= LFACE_FOREGROUND (lface
);
3074 LFACE_FOREGROUND (lface
) = value
;
3076 else if (EQ (attr
, QCbackground
))
3078 /* Compatibility with 20.x. */
3080 value
= Qunspecified
;
3081 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3083 /* Don't check for valid color names here because it depends
3084 on the frame (display) whether the color will be valid
3085 when the face is realized. */
3086 CHECK_STRING (value
);
3087 if (SCHARS (value
) == 0)
3088 signal_error ("Empty background color value", value
);
3090 old_value
= LFACE_BACKGROUND (lface
);
3091 LFACE_BACKGROUND (lface
) = value
;
3093 else if (EQ (attr
, QCstipple
))
3095 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
3096 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3098 && NILP (Fbitmap_spec_p (value
)))
3099 signal_error ("Invalid stipple attribute", value
);
3100 old_value
= LFACE_STIPPLE (lface
);
3101 LFACE_STIPPLE (lface
) = value
;
3102 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3104 else if (EQ (attr
, QCwidth
))
3106 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3108 CHECK_SYMBOL (value
);
3109 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3110 signal_error ("Invalid face width", value
);
3112 old_value
= LFACE_SWIDTH (lface
);
3113 LFACE_SWIDTH (lface
) = value
;
3114 prop_index
= FONT_WIDTH_INDEX
;
3116 else if (EQ (attr
, QCfont
))
3118 #ifdef HAVE_WINDOW_SYSTEM
3119 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3121 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3125 old_value
= LFACE_FONT (lface
);
3126 if (! FONTP (value
))
3128 if (STRINGP (value
))
3130 Lisp_Object name
= value
;
3131 int fontset
= fs_query_fontset (name
, 0);
3134 name
= fontset_ascii (fontset
);
3135 value
= font_spec_from_name (name
);
3137 signal_error ("Invalid font name", name
);
3140 signal_error ("Invalid font or font-spec", value
);
3143 f
= XFRAME (selected_frame
);
3146 if (! FONT_OBJECT_P (value
))
3148 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3149 Lisp_Object font_object
;
3151 font_object
= font_load_for_lface (f
, attrs
, value
);
3152 if (NILP (font_object
))
3153 signal_error ("Font not available", value
);
3154 value
= font_object
;
3156 set_lface_from_font (f
, lface
, value
, 1);
3159 LFACE_FONT (lface
) = value
;
3161 #endif /* HAVE_WINDOW_SYSTEM */
3163 else if (EQ (attr
, QCfontset
))
3165 #ifdef HAVE_WINDOW_SYSTEM
3166 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3170 old_value
= LFACE_FONTSET (lface
);
3171 tmp
= Fquery_fontset (value
, Qnil
);
3173 signal_error ("Invalid fontset name", value
);
3174 LFACE_FONTSET (lface
) = value
= tmp
;
3176 #endif /* HAVE_WINDOW_SYSTEM */
3178 else if (EQ (attr
, QCinherit
))
3181 if (SYMBOLP (value
))
3184 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3185 if (!SYMBOLP (XCAR (tail
)))
3188 LFACE_INHERIT (lface
) = value
;
3190 signal_error ("Invalid face inheritance", value
);
3192 else if (EQ (attr
, QCbold
))
3194 old_value
= LFACE_WEIGHT (lface
);
3195 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3196 prop_index
= FONT_WEIGHT_INDEX
;
3198 else if (EQ (attr
, QCitalic
))
3201 old_value
= LFACE_SLANT (lface
);
3202 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3203 prop_index
= FONT_SLANT_INDEX
;
3206 signal_error ("Invalid face attribute name", attr
);
3210 /* If a font-related attribute other than QCfont and QCfontset
3211 is specified, and if the original QCfont attribute has a font
3212 (font-spec or font-object), set the corresponding property in
3213 the font to nil so that the font selector doesn't think that
3214 the attribute is mandatory. Also, clear the average
3216 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3219 /* Changing a named face means that all realized faces depending on
3220 that face are invalid. Since we cannot tell which realized faces
3221 depend on the face, make sure they are all removed. This is done
3222 by incrementing face_change_count. The next call to
3223 init_iterator will then free realized faces. */
3225 && NILP (Fget (face
, Qface_no_inherit
))
3226 && NILP (Fequal (old_value
, value
)))
3228 ++face_change_count
;
3229 ++windows_or_buffers_changed
;
3232 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3233 && NILP (Fequal (old_value
, value
)))
3239 if (EQ (face
, Qdefault
))
3241 #ifdef HAVE_WINDOW_SYSTEM
3242 /* Changed font-related attributes of the `default' face are
3243 reflected in changed `font' frame parameters. */
3245 && (prop_index
|| EQ (attr
, QCfont
))
3246 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3247 set_font_frame_param (frame
, lface
);
3249 #endif /* HAVE_WINDOW_SYSTEM */
3251 if (EQ (attr
, QCforeground
))
3252 param
= Qforeground_color
;
3253 else if (EQ (attr
, QCbackground
))
3254 param
= Qbackground_color
;
3256 #ifdef HAVE_WINDOW_SYSTEM
3258 else if (EQ (face
, Qscroll_bar
))
3260 /* Changing the colors of `scroll-bar' sets frame parameters
3261 `scroll-bar-foreground' and `scroll-bar-background'. */
3262 if (EQ (attr
, QCforeground
))
3263 param
= Qscroll_bar_foreground
;
3264 else if (EQ (attr
, QCbackground
))
3265 param
= Qscroll_bar_background
;
3267 #endif /* not WINDOWSNT */
3268 else if (EQ (face
, Qborder
))
3270 /* Changing background color of `border' sets frame parameter
3272 if (EQ (attr
, QCbackground
))
3273 param
= Qborder_color
;
3275 else if (EQ (face
, Qcursor
))
3277 /* Changing background color of `cursor' sets frame parameter
3279 if (EQ (attr
, QCbackground
))
3280 param
= Qcursor_color
;
3282 else if (EQ (face
, Qmouse
))
3284 /* Changing background color of `mouse' sets frame parameter
3286 if (EQ (attr
, QCbackground
))
3287 param
= Qmouse_color
;
3289 #endif /* HAVE_WINDOW_SYSTEM */
3290 else if (EQ (face
, Qmenu
))
3292 /* Indicate that we have to update the menu bar when
3293 realizing faces on FRAME. FRAME t change the
3294 default for new frames. We do this by setting
3295 setting the flag in new face caches */
3298 struct frame
*f
= XFRAME (frame
);
3299 if (FRAME_FACE_CACHE (f
) == NULL
)
3300 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3301 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3304 menu_face_changed_default
= 1;
3310 /* Update `default-frame-alist', which is used for new frames. */
3312 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3315 /* Update the current frame's parameters. */
3318 cons
= XCAR (Vparam_value_alist
);
3319 XSETCAR (cons
, param
);
3320 XSETCDR (cons
, value
);
3321 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3330 /* Update the corresponding face when frame parameter PARAM on frame F
3331 has been assigned the value NEW_VALUE. */
3334 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
, Lisp_Object new_value
)
3336 Lisp_Object face
= Qnil
;
3339 /* If there are no faces yet, give up. This is the case when called
3340 from Fx_create_frame, and we do the necessary things later in
3341 face-set-after-frame-defaults. */
3342 if (NILP (f
->face_alist
))
3345 if (EQ (param
, Qforeground_color
))
3348 lface
= lface_from_face_name (f
, face
, 1);
3349 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3350 ? new_value
: Qunspecified
);
3351 realize_basic_faces (f
);
3353 else if (EQ (param
, Qbackground_color
))
3357 /* Changing the background color might change the background
3358 mode, so that we have to load new defface specs.
3359 Call frame-update-face-colors to do that. */
3360 XSETFRAME (frame
, f
);
3361 call1 (Qframe_set_background_mode
, frame
);
3364 lface
= lface_from_face_name (f
, face
, 1);
3365 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3366 ? new_value
: Qunspecified
);
3367 realize_basic_faces (f
);
3369 #ifdef HAVE_WINDOW_SYSTEM
3370 else if (EQ (param
, Qborder_color
))
3373 lface
= lface_from_face_name (f
, face
, 1);
3374 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3375 ? new_value
: Qunspecified
);
3377 else if (EQ (param
, Qcursor_color
))
3380 lface
= lface_from_face_name (f
, face
, 1);
3381 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3382 ? new_value
: Qunspecified
);
3384 else if (EQ (param
, Qmouse_color
))
3387 lface
= lface_from_face_name (f
, face
, 1);
3388 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3389 ? new_value
: Qunspecified
);
3393 /* Changing a named face means that all realized faces depending on
3394 that face are invalid. Since we cannot tell which realized faces
3395 depend on the face, make sure they are all removed. This is done
3396 by incrementing face_change_count. The next call to
3397 init_iterator will then free realized faces. */
3399 && NILP (Fget (face
, Qface_no_inherit
)))
3401 ++face_change_count
;
3402 ++windows_or_buffers_changed
;
3407 #ifdef HAVE_WINDOW_SYSTEM
3409 /* Set the `font' frame parameter of FRAME determined from the
3410 font-object set in `default' face attributes LFACE. */
3413 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3415 struct frame
*f
= XFRAME (frame
);
3418 if (FRAME_WINDOW_P (f
)
3419 /* Don't do anything if the font is `unspecified'. This can
3420 happen during frame creation. */
3421 && (font
= LFACE_FONT (lface
),
3422 ! UNSPECIFIEDP (font
)))
3424 if (FONT_SPEC_P (font
))
3426 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3429 LFACE_FONT (lface
) = font
;
3431 f
->default_face_done_p
= 0;
3432 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3437 /* Get the value of X resource RESOURCE, class CLASS for the display
3438 of frame FRAME. This is here because ordinary `x-get-resource'
3439 doesn't take a frame argument. */
3441 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3442 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3443 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3445 Lisp_Object value
= Qnil
;
3446 CHECK_STRING (resource
);
3447 CHECK_STRING (class);
3448 CHECK_LIVE_FRAME (frame
);
3450 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3451 resource
, class, Qnil
, Qnil
);
3457 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3458 If VALUE is "on" or "true", return t. If VALUE is "off" or
3459 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3460 error; if SIGNAL_P is zero, return 0. */
3463 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3465 Lisp_Object result
= make_number (0);
3467 xassert (STRINGP (value
));
3469 if (xstrcasecmp (SSDATA (value
), "on") == 0
3470 || xstrcasecmp (SSDATA (value
), "true") == 0)
3472 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3473 || xstrcasecmp (SSDATA (value
), "false") == 0)
3475 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3476 result
= Qunspecified
;
3478 signal_error ("Invalid face attribute value from X resource", value
);
3484 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3485 Finternal_set_lisp_face_attribute_from_resource
,
3486 Sinternal_set_lisp_face_attribute_from_resource
,
3487 3, 4, 0, doc
: /* */)
3488 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3490 CHECK_SYMBOL (face
);
3491 CHECK_SYMBOL (attr
);
3492 CHECK_STRING (value
);
3494 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3495 value
= Qunspecified
;
3496 else if (EQ (attr
, QCheight
))
3498 value
= Fstring_to_number (value
, make_number (10));
3499 if (XINT (value
) <= 0)
3500 signal_error ("Invalid face height from X resource", value
);
3502 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3503 value
= face_boolean_x_resource_value (value
, 1);
3504 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3505 value
= intern (SSDATA (value
));
3506 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3507 value
= face_boolean_x_resource_value (value
, 1);
3508 else if (EQ (attr
, QCunderline
)
3509 || EQ (attr
, QCoverline
)
3510 || EQ (attr
, QCstrike_through
))
3512 Lisp_Object boolean_value
;
3514 /* If the result of face_boolean_x_resource_value is t or nil,
3515 VALUE does NOT specify a color. */
3516 boolean_value
= face_boolean_x_resource_value (value
, 0);
3517 if (SYMBOLP (boolean_value
))
3518 value
= boolean_value
;
3520 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3521 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3523 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3526 #endif /* HAVE_WINDOW_SYSTEM */
3529 /***********************************************************************
3531 ***********************************************************************/
3533 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3535 /* Make menus on frame F appear as specified by the `menu' face. */
3538 x_update_menu_appearance (struct frame
*f
)
3540 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3544 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3548 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3549 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3550 const char *myname
= SSDATA (Vx_resource_name
);
3553 const char *popup_path
= "popup_menu";
3555 const char *popup_path
= "menu.popup";
3558 if (STRINGP (LFACE_FOREGROUND (lface
)))
3560 sprintf (line
, "%s.%s*foreground: %s",
3562 SDATA (LFACE_FOREGROUND (lface
)));
3563 XrmPutLineResource (&rdb
, line
);
3564 sprintf (line
, "%s.pane.menubar*foreground: %s",
3565 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3566 XrmPutLineResource (&rdb
, line
);
3570 if (STRINGP (LFACE_BACKGROUND (lface
)))
3572 sprintf (line
, "%s.%s*background: %s",
3574 SDATA (LFACE_BACKGROUND (lface
)));
3575 XrmPutLineResource (&rdb
, line
);
3576 sprintf (line
, "%s.pane.menubar*background: %s",
3577 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3578 XrmPutLineResource (&rdb
, line
);
3583 /* On Solaris 5.8, it's been reported that the `menu' face
3584 can be unspecified here, during startup. Why this
3585 happens remains unknown. -- cyd */
3586 && FONTP (LFACE_FONT (lface
))
3587 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3588 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3589 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3590 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3591 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3592 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3594 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3596 const char *suffix
= "List";
3599 #if defined HAVE_X_I18N
3601 const char *suffix
= "Set";
3603 const char *suffix
= "";
3610 #if defined HAVE_X_I18N
3611 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3613 char *fontsetname
= SSDATA (xlfd
);
3615 sprintf (line
, "%s.pane.menubar*font%s: %s",
3616 myname
, suffix
, fontsetname
);
3617 XrmPutLineResource (&rdb
, line
);
3618 sprintf (line
, "%s.%s*font%s: %s",
3619 myname
, popup_path
, suffix
, fontsetname
);
3620 XrmPutLineResource (&rdb
, line
);
3622 if (fontsetname
!= SSDATA (xlfd
))
3623 xfree (fontsetname
);
3627 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3628 free_frame_menubar (f
);
3632 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3635 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3636 Sface_attribute_relative_p
,
3638 doc
: /* Check whether a face attribute value is relative.
3639 Specifically, this function returns t if the attribute ATTRIBUTE
3640 with the value VALUE is relative.
3642 A relative value is one that doesn't entirely override whatever is
3643 inherited from another face. For most possible attributes,
3644 the only relative value that users see is `unspecified'.
3645 However, for :height, floating point values are also relative. */)
3646 (Lisp_Object attribute
, Lisp_Object value
)
3648 if (EQ (value
, Qunspecified
) || (EQ (value
, Qignore_defface
)))
3650 else if (EQ (attribute
, QCheight
))
3651 return INTEGERP (value
) ? Qnil
: Qt
;
3656 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3658 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3659 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3660 the result will be absolute, otherwise it will be relative. */)
3661 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3663 if (EQ (value1
, Qunspecified
) || EQ (value1
, Qignore_defface
))
3665 else if (EQ (attribute
, QCheight
))
3666 return merge_face_heights (value1
, value2
, value1
);
3672 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3673 Sinternal_get_lisp_face_attribute
,
3675 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3676 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3677 face attribute name, signal an error.
3678 If the optional argument FRAME is given, report on face SYMBOL in that
3679 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3680 frames). If FRAME is omitted or nil, use the selected frame. */)
3681 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3683 Lisp_Object lface
, value
= Qnil
;
3685 CHECK_SYMBOL (symbol
);
3686 CHECK_SYMBOL (keyword
);
3689 lface
= lface_from_face_name (NULL
, symbol
, 1);
3693 frame
= selected_frame
;
3694 CHECK_LIVE_FRAME (frame
);
3695 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3698 if (EQ (keyword
, QCfamily
))
3699 value
= LFACE_FAMILY (lface
);
3700 else if (EQ (keyword
, QCfoundry
))
3701 value
= LFACE_FOUNDRY (lface
);
3702 else if (EQ (keyword
, QCheight
))
3703 value
= LFACE_HEIGHT (lface
);
3704 else if (EQ (keyword
, QCweight
))
3705 value
= LFACE_WEIGHT (lface
);
3706 else if (EQ (keyword
, QCslant
))
3707 value
= LFACE_SLANT (lface
);
3708 else if (EQ (keyword
, QCunderline
))
3709 value
= LFACE_UNDERLINE (lface
);
3710 else if (EQ (keyword
, QCoverline
))
3711 value
= LFACE_OVERLINE (lface
);
3712 else if (EQ (keyword
, QCstrike_through
))
3713 value
= LFACE_STRIKE_THROUGH (lface
);
3714 else if (EQ (keyword
, QCbox
))
3715 value
= LFACE_BOX (lface
);
3716 else if (EQ (keyword
, QCinverse_video
)
3717 || EQ (keyword
, QCreverse_video
))
3718 value
= LFACE_INVERSE (lface
);
3719 else if (EQ (keyword
, QCforeground
))
3720 value
= LFACE_FOREGROUND (lface
);
3721 else if (EQ (keyword
, QCbackground
))
3722 value
= LFACE_BACKGROUND (lface
);
3723 else if (EQ (keyword
, QCstipple
))
3724 value
= LFACE_STIPPLE (lface
);
3725 else if (EQ (keyword
, QCwidth
))
3726 value
= LFACE_SWIDTH (lface
);
3727 else if (EQ (keyword
, QCinherit
))
3728 value
= LFACE_INHERIT (lface
);
3729 else if (EQ (keyword
, QCfont
))
3730 value
= LFACE_FONT (lface
);
3731 else if (EQ (keyword
, QCfontset
))
3732 value
= LFACE_FONTSET (lface
);
3734 signal_error ("Invalid face attribute name", keyword
);
3736 if (IGNORE_DEFFACE_P (value
))
3737 return Qunspecified
;
3743 DEFUN ("internal-lisp-face-attribute-values",
3744 Finternal_lisp_face_attribute_values
,
3745 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3746 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3747 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3750 Lisp_Object result
= Qnil
;
3752 CHECK_SYMBOL (attr
);
3754 if (EQ (attr
, QCunderline
))
3755 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3756 else if (EQ (attr
, QCoverline
))
3757 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3758 else if (EQ (attr
, QCstrike_through
))
3759 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3760 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3761 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3767 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3768 Sinternal_merge_in_global_face
, 2, 2, 0,
3769 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3770 Default face attributes override any local face attributes. */)
3771 (Lisp_Object face
, Lisp_Object frame
)
3774 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3775 struct frame
*f
= XFRAME (frame
);
3777 CHECK_LIVE_FRAME (frame
);
3778 global_lface
= lface_from_face_name (NULL
, face
, 1);
3779 local_lface
= lface_from_face_name (f
, face
, 0);
3780 if (NILP (local_lface
))
3781 local_lface
= Finternal_make_lisp_face (face
, frame
);
3783 /* Make every specified global attribute override the local one.
3784 BEWARE!! This is only used from `face-set-after-frame-default' where
3785 the local frame is defined from default specs in `face-defface-spec'
3786 and those should be overridden by global settings. Hence the strange
3787 "global before local" priority. */
3788 lvec
= XVECTOR (local_lface
)->contents
;
3789 gvec
= XVECTOR (global_lface
)->contents
;
3790 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3791 if (IGNORE_DEFFACE_P (gvec
[i
]))
3792 lvec
[i
] = Qunspecified
;
3793 else if (! UNSPECIFIEDP (gvec
[i
]))
3796 /* If the default face was changed, update the face cache and the
3797 `font' frame parameter. */
3798 if (EQ (face
, Qdefault
))
3800 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3801 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3802 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3804 /* This can be NULL (e.g., in batch mode). */
3807 /* Ensure that the face vector is fully specified by merging
3808 the previously-cached vector. */
3809 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3810 merge_face_vectors (f
, lvec
, attrs
, 0);
3811 memcpy (lvec
, attrs
, sizeof attrs
);
3812 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3814 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3815 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3816 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3817 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3818 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3819 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3820 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3823 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3824 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3834 /* The following function is implemented for compatibility with 20.2.
3835 The function is used in x-resolve-fonts when it is asked to
3836 return fonts with the same size as the font of a face. This is
3837 done in fontset.el. */
3839 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3840 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3841 The font name is, by default, for ASCII characters.
3842 If the optional argument FRAME is given, report on face FACE in that frame.
3843 If FRAME is t, report on the defaults for face FACE (for new frames).
3844 The font default for a face is either nil, or a list
3845 of the form (bold), (italic) or (bold italic).
3846 If FRAME is omitted or nil, use the selected frame. And, in this case,
3847 if the optional third argument CHARACTER is given,
3848 return the font name used for CHARACTER. */)
3849 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3853 Lisp_Object result
= Qnil
;
3854 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3856 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3857 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3858 result
= Fcons (Qbold
, result
);
3860 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3861 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3862 result
= Fcons (Qitalic
, result
);
3868 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3869 int face_id
= lookup_named_face (f
, face
, 1);
3870 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3874 #ifdef HAVE_WINDOW_SYSTEM
3875 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3877 CHECK_CHARACTER (character
);
3878 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3879 fface
= FACE_FROM_ID (f
, face_id
);
3882 ? fface
->font
->props
[FONT_NAME_INDEX
]
3884 #else /* !HAVE_WINDOW_SYSTEM */
3885 return build_string (FRAME_MSDOS_P (f
)
3887 : FRAME_W32_P (f
) ? "w32term"
3894 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3895 all attributes are `equal'. Tries to be fast because this function
3896 is called quite often. */
3899 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3901 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3902 and the other is specified. */
3903 if (XTYPE (v1
) != XTYPE (v2
))
3912 if (SBYTES (v1
) != SBYTES (v2
))
3915 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3922 return !NILP (Fequal (v1
, v2
));
3927 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3928 all attributes are `equal'. Tries to be fast because this function
3929 is called quite often. */
3932 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3936 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3937 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3943 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3944 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3945 doc
: /* True if FACE1 and FACE2 are equal.
3946 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3947 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3948 If FRAME is omitted or nil, use the selected frame. */)
3949 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3953 Lisp_Object lface1
, lface2
;
3958 /* Don't use check_x_frame here because this function is called
3959 before X frames exist. At that time, if FRAME is nil,
3960 selected_frame will be used which is the frame dumped with
3961 Emacs. That frame is not an X frame. */
3962 f
= frame_or_selected_frame (frame
, 2);
3964 lface1
= lface_from_face_name (f
, face1
, 1);
3965 lface2
= lface_from_face_name (f
, face2
, 1);
3966 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
3967 XVECTOR (lface2
)->contents
);
3968 return equal_p
? Qt
: Qnil
;
3972 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
3973 Sinternal_lisp_face_empty_p
, 1, 2, 0,
3974 doc
: /* True if FACE has no attribute specified.
3975 If the optional argument FRAME is given, report on face FACE in that frame.
3976 If FRAME is t, report on the defaults for face FACE (for new frames).
3977 If FRAME is omitted or nil, use the selected frame. */)
3978 (Lisp_Object face
, Lisp_Object frame
)
3985 frame
= selected_frame
;
3986 CHECK_LIVE_FRAME (frame
);
3990 lface
= lface_from_face_name (NULL
, face
, 1);
3992 lface
= lface_from_face_name (f
, face
, 1);
3994 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3995 if (!UNSPECIFIEDP (AREF (lface
, i
)))
3998 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4002 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4004 doc
: /* Return an alist of frame-local faces defined on FRAME.
4005 For internal use only. */)
4008 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4009 return f
->face_alist
;
4013 /* Return a hash code for Lisp string STRING with case ignored. Used
4014 below in computing a hash value for a Lisp face. */
4016 static INLINE
unsigned
4017 hash_string_case_insensitive (Lisp_Object string
)
4019 const unsigned char *s
;
4021 xassert (STRINGP (string
));
4022 for (s
= SDATA (string
); *s
; ++s
)
4023 hash
= (hash
<< 1) ^ tolower (*s
);
4028 /* Return a hash code for face attribute vector V. */
4030 static INLINE
unsigned
4031 lface_hash (Lisp_Object
*v
)
4033 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4034 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4035 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4036 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4037 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4038 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4039 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4040 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4044 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4045 considering charsets/registries). They do if they specify the same
4046 family, point size, weight, width, slant, and font. Both
4047 LFACE1 and LFACE2 must be fully-specified. */
4050 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4052 xassert (lface_fully_specified_p (lface1
)
4053 && lface_fully_specified_p (lface2
));
4054 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4055 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4056 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4057 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4058 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4059 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4060 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4061 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4062 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4063 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4064 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4065 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4066 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4067 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4073 /***********************************************************************
4075 ***********************************************************************/
4077 /* Allocate and return a new realized face for Lisp face attribute
4080 static struct face
*
4081 make_realized_face (Lisp_Object
*attr
)
4083 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4084 memset (face
, 0, sizeof *face
);
4085 face
->ascii_face
= face
;
4086 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4091 /* Free realized face FACE, including its X resources. FACE may
4095 free_realized_face (struct frame
*f
, struct face
*face
)
4099 #ifdef HAVE_WINDOW_SYSTEM
4100 if (FRAME_WINDOW_P (f
))
4102 /* Free fontset of FACE if it is ASCII face. */
4103 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4104 free_face_fontset (f
, face
);
4109 font_done_for_face (f
, face
);
4110 x_free_gc (f
, face
->gc
);
4115 free_face_colors (f
, face
);
4116 x_destroy_bitmap (f
, face
->stipple
);
4118 #endif /* HAVE_WINDOW_SYSTEM */
4125 /* Prepare face FACE for subsequent display on frame F. This
4126 allocated GCs if they haven't been allocated yet or have been freed
4127 by clearing the face cache. */
4130 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4132 #ifdef HAVE_WINDOW_SYSTEM
4133 xassert (FRAME_WINDOW_P (f
));
4138 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4140 xgcv
.foreground
= face
->foreground
;
4141 xgcv
.background
= face
->background
;
4142 #ifdef HAVE_X_WINDOWS
4143 xgcv
.graphics_exposures
= False
;
4147 #ifdef HAVE_X_WINDOWS
4150 xgcv
.fill_style
= FillOpaqueStippled
;
4151 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4152 mask
|= GCFillStyle
| GCStipple
;
4155 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4157 font_prepare_for_face (f
, face
);
4160 #endif /* HAVE_WINDOW_SYSTEM */
4164 /* Returns the `distance' between the colors X and Y. */
4167 color_distance (XColor
*x
, XColor
*y
)
4169 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
4170 Quoting from that paper:
4172 This formula has results that are very close to L*u*v* (with the
4173 modified lightness curve) and, more importantly, it is a more even
4174 algorithm: it does not have a range of colours where it suddenly
4175 gives far from optimal results.
4177 See <http://www.compuphase.com/cmetric.htm> for more info. */
4179 long r
= (x
->red
- y
->red
) >> 8;
4180 long g
= (x
->green
- y
->green
) >> 8;
4181 long b
= (x
->blue
- y
->blue
) >> 8;
4182 long r_mean
= (x
->red
+ y
->red
) >> 9;
4185 (((512 + r_mean
) * r
* r
) >> 8)
4187 + (((767 - r_mean
) * b
* b
) >> 8);
4191 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4192 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4193 COLOR1 and COLOR2 may be either strings containing the color name,
4194 or lists of the form (RED GREEN BLUE).
4195 If FRAME is unspecified or nil, the current frame is used. */)
4196 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4199 XColor cdef1
, cdef2
;
4202 frame
= selected_frame
;
4203 CHECK_LIVE_FRAME (frame
);
4206 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4207 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4208 signal_error ("Invalid color", color1
);
4209 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4210 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4211 signal_error ("Invalid color", color2
);
4213 return make_number (color_distance (&cdef1
, &cdef2
));
4217 /***********************************************************************
4219 ***********************************************************************/
4221 /* Return a new face cache for frame F. */
4223 static struct face_cache
*
4224 make_face_cache (struct frame
*f
)
4226 struct face_cache
*c
;
4229 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4230 memset (c
, 0, sizeof *c
);
4231 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4232 c
->buckets
= (struct face
**) xmalloc (size
);
4233 memset (c
->buckets
, 0, size
);
4235 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4237 c
->menu_face_changed_p
= menu_face_changed_default
;
4242 /* Clear out all graphics contexts for all realized faces, except for
4243 the basic faces. This should be done from time to time just to avoid
4244 keeping too many graphics contexts that are no longer needed. */
4247 clear_face_gcs (struct face_cache
*c
)
4249 if (c
&& FRAME_WINDOW_P (c
->f
))
4251 #ifdef HAVE_WINDOW_SYSTEM
4253 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4255 struct face
*face
= c
->faces_by_id
[i
];
4256 if (face
&& face
->gc
)
4260 font_done_for_face (c
->f
, face
);
4261 x_free_gc (c
->f
, face
->gc
);
4266 #endif /* HAVE_WINDOW_SYSTEM */
4271 /* Free all realized faces in face cache C, including basic faces.
4272 C may be null. If faces are freed, make sure the frame's current
4273 matrix is marked invalid, so that a display caused by an expose
4274 event doesn't try to use faces we destroyed. */
4277 free_realized_faces (struct face_cache
*c
)
4282 struct frame
*f
= c
->f
;
4284 /* We must block input here because we can't process X events
4285 safely while only some faces are freed, or when the frame's
4286 current matrix still references freed faces. */
4289 for (i
= 0; i
< c
->used
; ++i
)
4291 free_realized_face (f
, c
->faces_by_id
[i
]);
4292 c
->faces_by_id
[i
] = NULL
;
4296 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4297 memset (c
->buckets
, 0, size
);
4299 /* Must do a thorough redisplay the next time. Mark current
4300 matrices as invalid because they will reference faces freed
4301 above. This function is also called when a frame is
4302 destroyed. In this case, the root window of F is nil. */
4303 if (WINDOWP (f
->root_window
))
4305 clear_current_matrices (f
);
4306 ++windows_or_buffers_changed
;
4314 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4315 This is done after attributes of a named face have been changed,
4316 because we can't tell which realized faces depend on that face. */
4319 free_all_realized_faces (Lisp_Object frame
)
4324 FOR_EACH_FRAME (rest
, frame
)
4325 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4328 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4332 /* Free face cache C and faces in it, including their X resources. */
4335 free_face_cache (struct face_cache
*c
)
4339 free_realized_faces (c
);
4341 xfree (c
->faces_by_id
);
4347 /* Cache realized face FACE in face cache C. HASH is the hash value
4348 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4349 FACE), insert the new face to the beginning of the collision list
4350 of the face hash table of C. Otherwise, add the new face to the
4351 end of the collision list. This way, lookup_face can quickly find
4352 that a requested face is not cached. */
4355 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4357 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4361 if (face
->ascii_face
!= face
)
4363 struct face
*last
= c
->buckets
[i
];
4374 c
->buckets
[i
] = face
;
4375 face
->prev
= face
->next
= NULL
;
4381 face
->next
= c
->buckets
[i
];
4383 face
->next
->prev
= face
;
4384 c
->buckets
[i
] = face
;
4387 /* Find a free slot in C->faces_by_id and use the index of the free
4388 slot as FACE->id. */
4389 for (i
= 0; i
< c
->used
; ++i
)
4390 if (c
->faces_by_id
[i
] == NULL
)
4394 /* Maybe enlarge C->faces_by_id. */
4397 if (c
->used
== c
->size
)
4400 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
4401 if (new_size
== c
->size
)
4402 abort (); /* Alternatives? ++kfs */
4403 sz
= new_size
* sizeof *c
->faces_by_id
;
4404 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4411 /* Check that FACE got a unique id. */
4416 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4417 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4423 #endif /* GLYPH_DEBUG */
4425 c
->faces_by_id
[i
] = face
;
4429 /* Remove face FACE from cache C. */
4432 uncache_face (struct face_cache
*c
, struct face
*face
)
4434 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4437 face
->prev
->next
= face
->next
;
4439 c
->buckets
[i
] = face
->next
;
4442 face
->next
->prev
= face
->prev
;
4444 c
->faces_by_id
[face
->id
] = NULL
;
4445 if (face
->id
== c
->used
)
4450 /* Look up a realized face with face attributes ATTR in the face cache
4451 of frame F. The face will be used to display ASCII characters.
4452 Value is the ID of the face found. If no suitable face is found,
4453 realize a new one. */
4456 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4458 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4463 xassert (cache
!= NULL
);
4464 check_lface_attrs (attr
);
4466 /* Look up ATTR in the face cache. */
4467 hash
= lface_hash (attr
);
4468 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4470 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4472 if (face
->ascii_face
!= face
)
4474 /* There's no more ASCII face. */
4478 if (face
->hash
== hash
4479 && lface_equal_p (face
->lface
, attr
))
4483 /* If not found, realize a new face. */
4485 face
= realize_face (cache
, attr
, -1);
4488 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4489 #endif /* GLYPH_DEBUG */
4494 #ifdef HAVE_WINDOW_SYSTEM
4495 /* Look up a realized face that has the same attributes as BASE_FACE
4496 except for the font in the face cache of frame F. If FONT-OBJECT
4497 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4498 the face has no font. Value is the ID of the face found. If no
4499 suitable face is found, realize a new one. */
4502 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4504 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4509 xassert (cache
!= NULL
);
4510 base_face
= base_face
->ascii_face
;
4511 hash
= lface_hash (base_face
->lface
);
4512 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4514 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4516 if (face
->ascii_face
== face
)
4518 if (face
->ascii_face
== base_face
4519 && face
->font
== (NILP (font_object
) ? NULL
4520 : XFONT_OBJECT (font_object
))
4521 && lface_equal_p (face
->lface
, base_face
->lface
))
4525 /* If not found, realize a new face. */
4526 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4529 #endif /* HAVE_WINDOW_SYSTEM */
4531 /* Return the face id of the realized face for named face SYMBOL on
4532 frame F suitable for displaying ASCII characters. Value is -1 if
4533 the face couldn't be determined, which might happen if the default
4534 face isn't realized and cannot be realized. */
4537 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4539 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4540 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4541 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4543 if (default_face
== NULL
)
4545 if (!realize_basic_faces (f
))
4547 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4548 if (default_face
== NULL
)
4549 abort (); /* realize_basic_faces must have set it up */
4552 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4555 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4556 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4558 return lookup_face (f
, attrs
);
4562 /* Return the display face-id of the basic face who's canonical face-id
4563 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4564 basic face has bee remapped via Vface_remapping_alist. This function is
4565 conservative: if something goes wrong, it will simply return FACE_ID
4566 rather than signal an error. */
4569 lookup_basic_face (struct frame
*f
, int face_id
)
4571 Lisp_Object name
, mapping
;
4572 int remapped_face_id
;
4574 if (NILP (Vface_remapping_alist
))
4575 return face_id
; /* Nothing to do. */
4579 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4580 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4581 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4582 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4583 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4584 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4585 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4586 case BORDER_FACE_ID
: name
= Qborder
; break;
4587 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4588 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4589 case MENU_FACE_ID
: name
= Qmenu
; break;
4592 abort (); /* the caller is supposed to pass us a basic face id */
4595 /* Do a quick scan through Vface_remapping_alist, and return immediately
4596 if there is no remapping for face NAME. This is just an optimization
4597 for the very common no-remapping case. */
4598 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4600 return face_id
; /* Give up. */
4602 /* If there is a remapping entry, lookup the face using NAME, which will
4603 handle the remapping too. */
4604 remapped_face_id
= lookup_named_face (f
, name
, 0);
4605 if (remapped_face_id
< 0)
4606 return face_id
; /* Give up. */
4608 return remapped_face_id
;
4612 /* Return the ID of the realized ASCII face of Lisp face with ID
4613 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4616 ascii_face_of_lisp_face (struct frame
*f
, int lface_id
)
4620 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4622 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4623 face_id
= lookup_named_face (f
, face_name
, 1);
4632 /* Return a face for charset ASCII that is like the face with id
4633 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4634 STEPS < 0 means larger. Value is the id of the face. */
4637 smaller_face (struct frame
*f
, int face_id
, int steps
)
4639 #ifdef HAVE_WINDOW_SYSTEM
4641 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4642 int pt
, last_pt
, last_height
;
4645 struct face
*new_face
;
4647 /* If not called for an X frame, just return the original face. */
4648 if (FRAME_TERMCAP_P (f
))
4651 /* Try in increments of 1/2 pt. */
4652 delta
= steps
< 0 ? 5 : -5;
4653 steps
= eabs (steps
);
4655 face
= FACE_FROM_ID (f
, face_id
);
4656 memcpy (attrs
, face
->lface
, sizeof attrs
);
4657 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4658 new_face_id
= face_id
;
4659 last_height
= FONT_HEIGHT (face
->font
);
4663 /* Give up if we cannot find a font within 10pt. */
4664 && eabs (last_pt
- pt
) < 100)
4666 /* Look up a face for a slightly smaller/larger font. */
4668 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4669 new_face_id
= lookup_face (f
, attrs
);
4670 new_face
= FACE_FROM_ID (f
, new_face_id
);
4672 /* If height changes, count that as one step. */
4673 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4674 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4677 last_height
= FONT_HEIGHT (new_face
->font
);
4684 #else /* not HAVE_WINDOW_SYSTEM */
4688 #endif /* not HAVE_WINDOW_SYSTEM */
4692 /* Return a face for charset ASCII that is like the face with id
4693 FACE_ID on frame F, but has height HEIGHT. */
4696 face_with_height (struct frame
*f
, int face_id
, int height
)
4698 #ifdef HAVE_WINDOW_SYSTEM
4700 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4702 if (FRAME_TERMCAP_P (f
)
4706 face
= FACE_FROM_ID (f
, face_id
);
4707 memcpy (attrs
, face
->lface
, sizeof attrs
);
4708 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4709 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4710 face_id
= lookup_face (f
, attrs
);
4711 #endif /* HAVE_WINDOW_SYSTEM */
4717 /* Return the face id of the realized face for named face SYMBOL on
4718 frame F suitable for displaying ASCII characters, and use
4719 attributes of the face FACE_ID for attributes that aren't
4720 completely specified by SYMBOL. This is like lookup_named_face,
4721 except that the default attributes come from FACE_ID, not from the
4722 default face. FACE_ID is assumed to be already realized. */
4725 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
, int signal_p
)
4727 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4728 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4729 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4734 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4737 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4738 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4739 return lookup_face (f
, attrs
);
4742 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4743 Sface_attributes_as_vector
, 1, 1, 0,
4744 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4748 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4750 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4757 /***********************************************************************
4758 Face capability testing
4759 ***********************************************************************/
4762 /* If the distance (as returned by color_distance) between two colors is
4763 less than this, then they are considered the same, for determining
4764 whether a color is supported or not. The range of values is 0-65535. */
4766 #define TTY_SAME_COLOR_THRESHOLD 10000
4768 #ifdef HAVE_WINDOW_SYSTEM
4770 /* Return non-zero if all the face attributes in ATTRS are supported
4771 on the window-system frame F.
4773 The definition of `supported' is somewhat heuristic, but basically means
4774 that a face containing all the attributes in ATTRS, when merged with the
4775 default face for display, can be represented in a way that's
4777 \(1) different in appearance than the default face, and
4778 \(2) `close in spirit' to what the attributes specify, if not exact. */
4781 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
, struct face
*def_face
)
4783 Lisp_Object
*def_attrs
= def_face
->lface
;
4785 /* Check that other specified attributes are different that the default
4787 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4788 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4789 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4790 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4791 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4792 def_attrs
[LFACE_INVERSE_INDEX
]))
4793 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4794 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4795 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4796 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4797 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4798 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4799 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4800 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4801 def_attrs
[LFACE_STIPPLE_INDEX
]))
4802 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4803 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4804 def_attrs
[LFACE_OVERLINE_INDEX
]))
4805 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4806 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4807 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4808 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4809 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4810 def_attrs
[LFACE_BOX_INDEX
])))
4813 /* Check font-related attributes, as those are the most commonly
4814 "unsupported" on a window-system (because of missing fonts). */
4815 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4816 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4817 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4818 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4819 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4820 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4824 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4827 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4829 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4831 face_id
= lookup_face (f
, merged_attrs
);
4832 face
= FACE_FROM_ID (f
, face_id
);
4835 error ("Cannot make face");
4837 /* If the font is the same, or no font is found, then not
4839 if (face
->font
== def_face
->font
4842 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4843 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4847 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4848 || face
->font
->driver
->case_sensitive
)
4850 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4851 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4852 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4853 s2
, make_number (0), Qnil
, Qt
), Qt
))
4859 /* Everything checks out, this face is supported. */
4863 #endif /* HAVE_WINDOW_SYSTEM */
4865 /* Return non-zero if all the face attributes in ATTRS are supported
4868 The definition of `supported' is somewhat heuristic, but basically means
4869 that a face containing all the attributes in ATTRS, when merged
4870 with the default face for display, can be represented in a way that's
4872 \(1) different in appearance than the default face, and
4873 \(2) `close in spirit' to what the attributes specify, if not exact.
4875 Point (2) implies that a `:weight black' attribute will be satisfied
4876 by any terminal that can display bold, and a `:foreground "yellow"' as
4877 long as the terminal can display a yellowish color, but `:slant italic'
4878 will _not_ be satisfied by the tty display code's automatic
4879 substitution of a `dim' face for italic. */
4882 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
, struct face
*def_face
)
4885 Lisp_Object val
, fg
, bg
;
4886 XColor fg_tty_color
, fg_std_color
;
4887 XColor bg_tty_color
, bg_std_color
;
4888 unsigned test_caps
= 0;
4889 Lisp_Object
*def_attrs
= def_face
->lface
;
4892 /* First check some easy-to-check stuff; ttys support none of the
4893 following attributes, so we can just return false if any are requested
4894 (even if `nominal' values are specified, we should still return false,
4895 as that will be the same value that the default face uses). We
4896 consider :slant unsupportable on ttys, even though the face code
4897 actually `fakes' them using a dim attribute if possible. This is
4898 because the faked result is too different from what the face
4900 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4901 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4902 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4903 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4904 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4905 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4906 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4907 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4908 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
4912 /* Test for terminal `capabilities' (non-color character attributes). */
4914 /* font weight (bold/dim) */
4915 val
= attrs
[LFACE_WEIGHT_INDEX
];
4916 if (!UNSPECIFIEDP (val
)
4917 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4919 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4923 if (def_weight
> 100)
4924 return 0; /* same as default */
4925 test_caps
= TTY_CAP_BOLD
;
4927 else if (weight
< 100)
4929 if (def_weight
< 100)
4930 return 0; /* same as default */
4931 test_caps
= TTY_CAP_DIM
;
4933 else if (def_weight
== 100)
4934 return 0; /* same as default */
4938 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4939 if (!UNSPECIFIEDP (val
))
4942 return 0; /* ttys can't use colored underlines */
4943 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4944 return 0; /* same as default */
4946 test_caps
|= TTY_CAP_UNDERLINE
;
4950 val
= attrs
[LFACE_INVERSE_INDEX
];
4951 if (!UNSPECIFIEDP (val
))
4953 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4954 return 0; /* same as default */
4956 test_caps
|= TTY_CAP_INVERSE
;
4960 /* Color testing. */
4962 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4963 we use them when calling `tty_capable_p' below, even if the face
4964 specifies no colors. */
4965 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4966 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4968 /* Check if foreground color is close enough. */
4969 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4972 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4974 if (face_attr_equal_p (fg
, def_fg
))
4975 return 0; /* same as default */
4976 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4977 return 0; /* not a valid color */
4978 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4979 > TTY_SAME_COLOR_THRESHOLD
)
4980 return 0; /* displayed color is too different */
4982 /* Make sure the color is really different than the default. */
4984 XColor def_fg_color
;
4985 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
4986 && (color_distance (&fg_tty_color
, &def_fg_color
)
4987 <= TTY_SAME_COLOR_THRESHOLD
))
4992 /* Check if background color is close enough. */
4993 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
4996 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
4998 if (face_attr_equal_p (bg
, def_bg
))
4999 return 0; /* same as default */
5000 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5001 return 0; /* not a valid color */
5002 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5003 > TTY_SAME_COLOR_THRESHOLD
)
5004 return 0; /* displayed color is too different */
5006 /* Make sure the color is really different than the default. */
5008 XColor def_bg_color
;
5009 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5010 && (color_distance (&bg_tty_color
, &def_bg_color
)
5011 <= TTY_SAME_COLOR_THRESHOLD
))
5016 /* If both foreground and background are requested, see if the
5017 distance between them is OK. We just check to see if the distance
5018 between the tty's foreground and background is close enough to the
5019 distance between the standard foreground and background. */
5020 if (STRINGP (fg
) && STRINGP (bg
))
5023 = (color_distance (&fg_std_color
, &bg_std_color
)
5024 - color_distance (&fg_tty_color
, &bg_tty_color
));
5025 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5026 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5031 /* See if the capabilities we selected above are supported, with the
5033 if (test_caps
!= 0 &&
5034 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5038 /* Hmmm, everything checks out, this terminal must support this face. */
5043 DEFUN ("display-supports-face-attributes-p",
5044 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5046 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5047 The optional argument DISPLAY can be a display name, a frame, or
5048 nil (meaning the selected frame's display).
5050 The definition of `supported' is somewhat heuristic, but basically means
5051 that a face containing all the attributes in ATTRIBUTES, when merged
5052 with the default face for display, can be represented in a way that's
5054 \(1) different in appearance than the default face, and
5055 \(2) `close in spirit' to what the attributes specify, if not exact.
5057 Point (2) implies that a `:weight black' attribute will be satisfied by
5058 any display that can display bold, and a `:foreground \"yellow\"' as long
5059 as it can display a yellowish color, but `:slant italic' will _not_ be
5060 satisfied by the tty display code's automatic substitution of a `dim'
5061 face for italic. */)
5062 (Lisp_Object attributes
, Lisp_Object display
)
5064 int supports
= 0, i
;
5067 struct face
*def_face
;
5068 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5070 if (noninteractive
|| !initialized
)
5071 /* We may not be able to access low-level face information in batch
5072 mode, or before being dumped, and this function is not going to
5073 be very useful in those cases anyway, so just give up. */
5077 frame
= selected_frame
;
5078 else if (FRAMEP (display
))
5082 /* Find any frame on DISPLAY. */
5083 Lisp_Object fl_tail
;
5086 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5088 frame
= XCAR (fl_tail
);
5089 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5090 XFRAME (frame
)->param_alist
)),
5096 CHECK_LIVE_FRAME (frame
);
5099 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5100 attrs
[i
] = Qunspecified
;
5101 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5103 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5104 if (def_face
== NULL
)
5106 if (! realize_basic_faces (f
))
5107 error ("Cannot realize default face");
5108 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5109 if (def_face
== NULL
)
5110 abort (); /* realize_basic_faces must have set it up */
5113 /* Dispatch to the appropriate handler. */
5114 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5115 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5116 #ifdef HAVE_WINDOW_SYSTEM
5118 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5121 return supports
? Qt
: Qnil
;
5125 /***********************************************************************
5127 ***********************************************************************/
5129 DEFUN ("internal-set-font-selection-order",
5130 Finternal_set_font_selection_order
,
5131 Sinternal_set_font_selection_order
, 1, 1, 0,
5132 doc
: /* Set font selection order for face font selection to ORDER.
5133 ORDER must be a list of length 4 containing the symbols `:width',
5134 `:height', `:weight', and `:slant'. Face attributes appearing
5135 first in ORDER are matched first, e.g. if `:height' appears before
5136 `:weight' in ORDER, font selection first tries to find a font with
5137 a suitable height, and then tries to match the font weight.
5143 int indices
[DIM (font_sort_order
)];
5146 memset (indices
, 0, sizeof indices
);
5150 CONSP (list
) && i
< DIM (indices
);
5151 list
= XCDR (list
), ++i
)
5153 Lisp_Object attr
= XCAR (list
);
5156 if (EQ (attr
, QCwidth
))
5158 else if (EQ (attr
, QCheight
))
5159 xlfd
= XLFD_POINT_SIZE
;
5160 else if (EQ (attr
, QCweight
))
5162 else if (EQ (attr
, QCslant
))
5167 if (indices
[i
] != 0)
5172 if (!NILP (list
) || i
!= DIM (indices
))
5173 signal_error ("Invalid font sort order", order
);
5174 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5175 if (indices
[i
] == 0)
5176 signal_error ("Invalid font sort order", order
);
5178 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5180 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5181 free_all_realized_faces (Qnil
);
5184 font_update_sort_order (font_sort_order
);
5190 DEFUN ("internal-set-alternative-font-family-alist",
5191 Finternal_set_alternative_font_family_alist
,
5192 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5193 doc
: /* Define alternative font families to try in face font selection.
5194 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5195 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5196 be found. Value is ALIST. */)
5199 Lisp_Object entry
, tail
, tail2
;
5202 alist
= Fcopy_sequence (alist
);
5203 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5205 entry
= XCAR (tail
);
5207 entry
= Fcopy_sequence (entry
);
5208 XSETCAR (tail
, entry
);
5209 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5210 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5213 Vface_alternative_font_family_alist
= alist
;
5214 free_all_realized_faces (Qnil
);
5219 DEFUN ("internal-set-alternative-font-registry-alist",
5220 Finternal_set_alternative_font_registry_alist
,
5221 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5222 doc
: /* Define alternative font registries to try in face font selection.
5223 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5224 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5225 be found. Value is ALIST. */)
5228 Lisp_Object entry
, tail
, tail2
;
5231 alist
= Fcopy_sequence (alist
);
5232 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5234 entry
= XCAR (tail
);
5236 entry
= Fcopy_sequence (entry
);
5237 XSETCAR (tail
, entry
);
5238 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5239 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5241 Vface_alternative_font_registry_alist
= alist
;
5242 free_all_realized_faces (Qnil
);
5247 #ifdef HAVE_WINDOW_SYSTEM
5249 /* Return the fontset id of the base fontset name or alias name given
5250 by the fontset attribute of ATTRS. Value is -1 if the fontset
5251 attribute of ATTRS doesn't name a fontset. */
5254 face_fontset (Lisp_Object
*attrs
)
5258 name
= attrs
[LFACE_FONTSET_INDEX
];
5259 if (!STRINGP (name
))
5261 return fs_query_fontset (name
, 0);
5264 #endif /* HAVE_WINDOW_SYSTEM */
5268 /***********************************************************************
5270 ***********************************************************************/
5272 /* Realize basic faces on frame F. Value is zero if frame parameters
5273 of F don't contain enough information needed to realize the default
5277 realize_basic_faces (struct frame
*f
)
5280 int count
= SPECPDL_INDEX ();
5282 /* Block input here so that we won't be surprised by an X expose
5283 event, for instance, without having the faces set up. */
5285 specbind (Qscalable_fonts_allowed
, Qt
);
5287 if (realize_default_face (f
))
5289 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5290 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5291 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5292 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5293 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5294 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5295 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5296 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5297 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5298 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5299 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5301 /* Reflect changes in the `menu' face in menu bars. */
5302 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5304 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5305 #ifdef USE_X_TOOLKIT
5306 if (FRAME_WINDOW_P (f
))
5307 x_update_menu_appearance (f
);
5314 unbind_to (count
, Qnil
);
5320 /* Realize the default face on frame F. If the face is not fully
5321 specified, make it fully-specified. Attributes of the default face
5322 that are not explicitly specified are taken from frame parameters. */
5325 realize_default_face (struct frame
*f
)
5327 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5329 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5332 /* If the `default' face is not yet known, create it. */
5333 lface
= lface_from_face_name (f
, Qdefault
, 0);
5337 XSETFRAME (frame
, f
);
5338 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5341 #ifdef HAVE_WINDOW_SYSTEM
5342 if (FRAME_WINDOW_P (f
))
5344 Lisp_Object font_object
;
5346 XSETFONT (font_object
, FRAME_FONT (f
));
5347 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5348 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5349 f
->default_face_done_p
= 1;
5351 #endif /* HAVE_WINDOW_SYSTEM */
5353 if (!FRAME_WINDOW_P (f
))
5355 LFACE_FAMILY (lface
) = build_string ("default");
5356 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5357 LFACE_SWIDTH (lface
) = Qnormal
;
5358 LFACE_HEIGHT (lface
) = make_number (1);
5359 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5360 LFACE_WEIGHT (lface
) = Qnormal
;
5361 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5362 LFACE_SLANT (lface
) = Qnormal
;
5363 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5364 LFACE_FONTSET (lface
) = Qnil
;
5367 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5368 LFACE_UNDERLINE (lface
) = Qnil
;
5370 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5371 LFACE_OVERLINE (lface
) = Qnil
;
5373 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5374 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5376 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5377 LFACE_BOX (lface
) = Qnil
;
5379 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5380 LFACE_INVERSE (lface
) = Qnil
;
5382 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5384 /* This function is called so early that colors are not yet
5385 set in the frame parameter list. */
5386 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5388 if (CONSP (color
) && STRINGP (XCDR (color
)))
5389 LFACE_FOREGROUND (lface
) = XCDR (color
);
5390 else if (FRAME_WINDOW_P (f
))
5392 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5393 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5398 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5400 /* This function is called so early that colors are not yet
5401 set in the frame parameter list. */
5402 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5403 if (CONSP (color
) && STRINGP (XCDR (color
)))
5404 LFACE_BACKGROUND (lface
) = XCDR (color
);
5405 else if (FRAME_WINDOW_P (f
))
5407 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5408 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5413 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5414 LFACE_STIPPLE (lface
) = Qnil
;
5416 /* Realize the face; it must be fully-specified now. */
5417 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5418 check_lface (lface
);
5419 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5420 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5422 #ifdef HAVE_WINDOW_SYSTEM
5423 #ifdef HAVE_X_WINDOWS
5424 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5426 /* This can happen when making a frame on a display that does
5427 not support the default font. */
5431 /* Otherwise, the font specified for the frame was not
5432 acceptable as a font for the default face (perhaps because
5433 auto-scaled fonts are rejected), so we must adjust the frame
5435 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5437 #endif /* HAVE_X_WINDOWS */
5438 #endif /* HAVE_WINDOW_SYSTEM */
5443 /* Realize basic faces other than the default face in face cache C.
5444 SYMBOL is the face name, ID is the face id the realized face must
5445 have. The default face must have been realized already. */
5448 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5450 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5451 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5452 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5453 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5455 /* The default face must exist and be fully specified. */
5456 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5457 check_lface_attrs (attrs
);
5458 xassert (lface_fully_specified_p (attrs
));
5460 /* If SYMBOL isn't know as a face, create it. */
5464 XSETFRAME (frame
, f
);
5465 lface
= Finternal_make_lisp_face (symbol
, frame
);
5468 /* Merge SYMBOL's face with the default face. */
5469 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5470 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5472 /* Realize the face. */
5473 realize_face (c
, attrs
, id
);
5477 /* Realize the fully-specified face with attributes ATTRS in face
5478 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5479 non-negative, it is an ID of face to remove before caching the new
5480 face. Value is a pointer to the newly created realized face. */
5482 static struct face
*
5483 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5487 /* LFACE must be fully specified. */
5488 xassert (cache
!= NULL
);
5489 check_lface_attrs (attrs
);
5491 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5493 /* Remove the former face. */
5494 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5495 uncache_face (cache
, former_face
);
5496 free_realized_face (cache
->f
, former_face
);
5497 SET_FRAME_GARBAGED (cache
->f
);
5500 if (FRAME_WINDOW_P (cache
->f
))
5501 face
= realize_x_face (cache
, attrs
);
5502 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5503 face
= realize_tty_face (cache
, attrs
);
5504 else if (FRAME_INITIAL_P (cache
->f
))
5506 /* Create a dummy face. */
5507 face
= make_realized_face (attrs
);
5512 /* Insert the new face. */
5513 cache_face (cache
, face
, lface_hash (attrs
));
5518 #ifdef HAVE_WINDOW_SYSTEM
5519 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5520 same attributes as BASE_FACE except for the font on frame F.
5521 FONT-OBJECT may be nil, in which case, realized a face of
5524 static struct face
*
5525 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
5527 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5530 face
= (struct face
*) xmalloc (sizeof *face
);
5535 = (! NILP (font_object
)
5536 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5537 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5539 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5540 face
->colors_copied_bitwise_p
= 1;
5541 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5544 cache_face (cache
, face
, face
->hash
);
5548 #endif /* HAVE_WINDOW_SYSTEM */
5551 /* Realize the fully-specified face with attributes ATTRS in face
5552 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5553 the new face doesn't share font with the default face, a fontname
5554 is allocated from the heap and set in `font_name' of the new face,
5555 but it is not yet loaded here. Value is a pointer to the newly
5556 created realized face. */
5558 static struct face
*
5559 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5561 struct face
*face
= NULL
;
5562 #ifdef HAVE_WINDOW_SYSTEM
5563 struct face
*default_face
;
5565 Lisp_Object stipple
, overline
, strike_through
, box
;
5567 xassert (FRAME_WINDOW_P (cache
->f
));
5569 /* Allocate a new realized face. */
5570 face
= make_realized_face (attrs
);
5571 face
->ascii_face
= face
;
5575 /* Determine the font to use. Most of the time, the font will be
5576 the same as the font of the default face, so try that first. */
5577 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5579 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5581 face
->font
= default_face
->font
;
5583 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5587 /* If the face attribute ATTRS specifies a fontset, use it as
5588 the base of a new realized fontset. Otherwise, use the same
5589 base fontset as of the default face. The base determines
5590 registry and encoding of a font. It may also determine
5591 foundry and family. The other fields of font name pattern
5592 are constructed from ATTRS. */
5593 int fontset
= face_fontset (attrs
);
5595 /* If we are realizing the default face, ATTRS should specify a
5596 fontset. In other words, if FONTSET is -1, we are not
5597 realizing the default face, thus the default face should have
5598 already been realized. */
5602 fontset
= default_face
->fontset
;
5606 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5607 attrs
[LFACE_FONT_INDEX
]
5608 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5609 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5611 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5612 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5622 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5623 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5624 face
->overstrike
= 1;
5626 /* Load colors, and set remaining attributes. */
5628 load_face_colors (f
, face
, attrs
);
5631 box
= attrs
[LFACE_BOX_INDEX
];
5634 /* A simple box of line width 1 drawn in color given by
5636 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5638 face
->box
= FACE_SIMPLE_BOX
;
5639 face
->box_line_width
= 1;
5641 else if (INTEGERP (box
))
5643 /* Simple box of specified line width in foreground color of the
5645 xassert (XINT (box
) != 0);
5646 face
->box
= FACE_SIMPLE_BOX
;
5647 face
->box_line_width
= XINT (box
);
5648 face
->box_color
= face
->foreground
;
5649 face
->box_color_defaulted_p
= 1;
5651 else if (CONSP (box
))
5653 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5654 being one of `raised' or `sunken'. */
5655 face
->box
= FACE_SIMPLE_BOX
;
5656 face
->box_color
= face
->foreground
;
5657 face
->box_color_defaulted_p
= 1;
5658 face
->box_line_width
= 1;
5662 Lisp_Object keyword
, value
;
5664 keyword
= XCAR (box
);
5672 if (EQ (keyword
, QCline_width
))
5674 if (INTEGERP (value
) && XINT (value
) != 0)
5675 face
->box_line_width
= XINT (value
);
5677 else if (EQ (keyword
, QCcolor
))
5679 if (STRINGP (value
))
5681 face
->box_color
= load_color (f
, face
, value
,
5683 face
->use_box_color_for_shadows_p
= 1;
5686 else if (EQ (keyword
, QCstyle
))
5688 if (EQ (value
, Qreleased_button
))
5689 face
->box
= FACE_RAISED_BOX
;
5690 else if (EQ (value
, Qpressed_button
))
5691 face
->box
= FACE_SUNKEN_BOX
;
5696 /* Text underline, overline, strike-through. */
5698 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5700 /* Use default color (same as foreground color). */
5701 face
->underline_p
= 1;
5702 face
->underline_defaulted_p
= 1;
5703 face
->underline_color
= 0;
5705 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5707 /* Use specified color. */
5708 face
->underline_p
= 1;
5709 face
->underline_defaulted_p
= 0;
5710 face
->underline_color
5711 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5712 LFACE_UNDERLINE_INDEX
);
5714 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5716 face
->underline_p
= 0;
5717 face
->underline_defaulted_p
= 0;
5718 face
->underline_color
= 0;
5721 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5722 if (STRINGP (overline
))
5724 face
->overline_color
5725 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5726 LFACE_OVERLINE_INDEX
);
5727 face
->overline_p
= 1;
5729 else if (EQ (overline
, Qt
))
5731 face
->overline_color
= face
->foreground
;
5732 face
->overline_color_defaulted_p
= 1;
5733 face
->overline_p
= 1;
5736 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5737 if (STRINGP (strike_through
))
5739 face
->strike_through_color
5740 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5741 LFACE_STRIKE_THROUGH_INDEX
);
5742 face
->strike_through_p
= 1;
5744 else if (EQ (strike_through
, Qt
))
5746 face
->strike_through_color
= face
->foreground
;
5747 face
->strike_through_color_defaulted_p
= 1;
5748 face
->strike_through_p
= 1;
5751 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5752 if (!NILP (stipple
))
5753 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5754 #endif /* HAVE_WINDOW_SYSTEM */
5760 /* Map a specified color of face FACE on frame F to a tty color index.
5761 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5762 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5763 default foreground/background colors. */
5766 map_tty_color (struct frame
*f
, struct face
*face
, enum lface_attribute_index idx
, int *defaulted
)
5768 Lisp_Object frame
, color
, def
;
5769 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5770 unsigned long default_pixel
=
5771 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5772 unsigned long pixel
= default_pixel
;
5774 unsigned long default_other_pixel
=
5775 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5778 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5780 XSETFRAME (frame
, f
);
5781 color
= face
->lface
[idx
];
5785 && CONSP (Vtty_defined_color_alist
)
5786 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5789 /* Associations in tty-defined-color-alist are of the form
5790 (NAME INDEX R G B). We need the INDEX part. */
5791 pixel
= XINT (XCAR (XCDR (def
)));
5794 if (pixel
== default_pixel
&& STRINGP (color
))
5796 pixel
= load_color (f
, face
, color
, idx
);
5799 /* If the foreground of the default face is the default color,
5800 use the foreground color defined by the frame. */
5801 if (FRAME_MSDOS_P (f
))
5803 if (pixel
== default_pixel
5804 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5807 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5809 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5810 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5813 else if (pixel
== default_other_pixel
)
5816 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5818 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5819 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5827 face
->foreground
= pixel
;
5829 face
->background
= pixel
;
5833 /* Realize the fully-specified face with attributes ATTRS in face
5834 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5835 Value is a pointer to the newly created realized face. */
5837 static struct face
*
5838 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5842 int face_colors_defaulted
= 0;
5843 struct frame
*f
= cache
->f
;
5845 /* Frame must be a termcap frame. */
5846 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5848 /* Allocate a new realized face. */
5849 face
= make_realized_face (attrs
);
5851 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5854 /* Map face attributes to TTY appearances. We map slant to
5855 dimmed text because we want italic text to appear differently
5856 and because dimmed text is probably used infrequently. */
5857 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5858 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5860 face
->tty_bold_p
= 1;
5861 if (weight
< 100 || slant
!= 100)
5862 face
->tty_dim_p
= 1;
5863 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5864 face
->tty_underline_p
= 1;
5865 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5866 face
->tty_reverse_p
= 1;
5868 /* Map color names to color indices. */
5869 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5870 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5872 /* Swap colors if face is inverse-video. If the colors are taken
5873 from the frame colors, they are already inverted, since the
5874 frame-creation function calls x-handle-reverse-video. */
5875 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5877 unsigned long tem
= face
->foreground
;
5878 face
->foreground
= face
->background
;
5879 face
->background
= tem
;
5882 if (tty_suppress_bold_inverse_default_colors_p
5884 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5885 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5886 face
->tty_bold_p
= 0;
5892 DEFUN ("tty-suppress-bold-inverse-default-colors",
5893 Ftty_suppress_bold_inverse_default_colors
,
5894 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5895 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5896 SUPPRESS non-nil means suppress it.
5897 This affects bold faces on TTYs whose foreground is the default background
5898 color of the display and whose background is the default foreground color.
5899 For such faces, the bold face attribute is ignored if this variable
5901 (Lisp_Object suppress
)
5903 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5904 ++face_change_count
;
5910 /***********************************************************************
5912 ***********************************************************************/
5914 /* Return the ID of the face to use to display character CH with face
5915 property PROP on frame F in current_buffer. */
5918 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5922 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5927 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5928 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5932 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5933 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5934 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
5935 merge_face_ref (f
, prop
, attrs
, 1, 0);
5936 face_id
= lookup_face (f
, attrs
);
5942 /* Return the face ID associated with buffer position POS for
5943 displaying ASCII characters. Return in *ENDPTR the position at
5944 which a different face is needed, as far as text properties and
5945 overlays are concerned. W is a window displaying current_buffer.
5947 REGION_BEG, REGION_END delimit the region, so it can be
5950 LIMIT is a position not to scan beyond. That is to limit the time
5951 this function can take.
5953 If MOUSE is non-zero, use the character's mouse-face, not its face.
5955 BASE_FACE_ID, if non-negative, specifies a base face id to use
5956 instead of DEFAULT_FACE_ID.
5958 The face returned is suitable for displaying ASCII characters. */
5961 face_at_buffer_position (struct window
*w
, EMACS_INT pos
,
5962 EMACS_INT region_beg
, EMACS_INT region_end
,
5963 EMACS_INT
*endptr
, EMACS_INT limit
,
5964 int mouse
, int base_face_id
)
5966 struct frame
*f
= XFRAME (w
->frame
);
5967 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5968 Lisp_Object prop
, position
;
5970 Lisp_Object
*overlay_vec
;
5973 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
5974 Lisp_Object limit1
, end
;
5975 struct face
*default_face
;
5977 /* W must display the current buffer. We could write this function
5978 to use the frame and buffer of W, but right now it doesn't. */
5979 /* xassert (XBUFFER (w->buffer) == current_buffer); */
5981 XSETFRAME (frame
, f
);
5982 XSETFASTINT (position
, pos
);
5985 if (pos
< region_beg
&& region_beg
< endpos
)
5986 endpos
= region_beg
;
5988 /* Get the `face' or `mouse_face' text property at POS, and
5989 determine the next position at which the property changes. */
5990 prop
= Fget_text_property (position
, propname
, w
->buffer
);
5991 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
5992 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
5994 endpos
= XINT (end
);
5996 /* Look at properties from overlays. */
5998 EMACS_INT next_overlay
;
6000 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6001 if (next_overlay
< endpos
)
6002 endpos
= next_overlay
;
6007 default_face
= FACE_FROM_ID (f
, base_face_id
>= 0 ? base_face_id
6008 : NILP (Vface_remapping_alist
) ? DEFAULT_FACE_ID
6009 : lookup_basic_face (f
, DEFAULT_FACE_ID
));
6011 /* Optimize common cases where we can use the default face. */
6014 && !(pos
>= region_beg
&& pos
< region_end
))
6015 return default_face
->id
;
6017 /* Begin with attributes from the default face. */
6018 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6020 /* Merge in attributes specified via text properties. */
6022 merge_face_ref (f
, prop
, attrs
, 1, 0);
6024 /* Now merge the overlay data. */
6025 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6026 for (i
= 0; i
< noverlays
; i
++)
6031 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6033 merge_face_ref (f
, prop
, attrs
, 1, 0);
6035 oend
= OVERLAY_END (overlay_vec
[i
]);
6036 oendpos
= OVERLAY_POSITION (oend
);
6037 if (oendpos
< endpos
)
6041 /* If in the region, merge in the region face. */
6042 if (pos
>= region_beg
&& pos
< region_end
)
6044 merge_named_face (f
, Qregion
, attrs
, 0);
6046 if (region_end
< endpos
)
6047 endpos
= region_end
;
6052 /* Look up a realized face with the given face attributes,
6053 or realize a new one for ASCII characters. */
6054 return lookup_face (f
, attrs
);
6057 /* Return the face ID at buffer position POS for displaying ASCII
6058 characters associated with overlay strings for overlay OVERLAY.
6060 Like face_at_buffer_position except for OVERLAY. Currently it
6061 simply disregards the `face' properties of all overlays. */
6064 face_for_overlay_string (struct window
*w
, EMACS_INT pos
,
6065 EMACS_INT region_beg
, EMACS_INT region_end
,
6066 EMACS_INT
*endptr
, EMACS_INT limit
,
6067 int mouse
, Lisp_Object overlay
)
6069 struct frame
*f
= XFRAME (w
->frame
);
6070 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6071 Lisp_Object prop
, position
;
6074 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6075 Lisp_Object limit1
, end
;
6076 struct face
*default_face
;
6078 /* W must display the current buffer. We could write this function
6079 to use the frame and buffer of W, but right now it doesn't. */
6080 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6082 XSETFRAME (frame
, f
);
6083 XSETFASTINT (position
, pos
);
6086 if (pos
< region_beg
&& region_beg
< endpos
)
6087 endpos
= region_beg
;
6089 /* Get the `face' or `mouse_face' text property at POS, and
6090 determine the next position at which the property changes. */
6091 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6092 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6093 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6095 endpos
= XINT (end
);
6099 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6101 /* Optimize common cases where we can use the default face. */
6103 && !(pos
>= region_beg
&& pos
< region_end
))
6104 return DEFAULT_FACE_ID
;
6106 /* Begin with attributes from the default face. */
6107 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6109 /* Merge in attributes specified via text properties. */
6111 merge_face_ref (f
, prop
, attrs
, 1, 0);
6113 /* If in the region, merge in the region face. */
6114 if (pos
>= region_beg
&& pos
< region_end
)
6116 merge_named_face (f
, Qregion
, attrs
, 0);
6118 if (region_end
< endpos
)
6119 endpos
= region_end
;
6124 /* Look up a realized face with the given face attributes,
6125 or realize a new one for ASCII characters. */
6126 return lookup_face (f
, attrs
);
6130 /* Compute the face at character position POS in Lisp string STRING on
6131 window W, for ASCII characters.
6133 If STRING is an overlay string, it comes from position BUFPOS in
6134 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6135 not an overlay string. W must display the current buffer.
6136 REGION_BEG and REGION_END give the start and end positions of the
6137 region; both are -1 if no region is visible.
6139 BASE_FACE_ID is the id of a face to merge with. For strings coming
6140 from overlays or the `display' property it is the face at BUFPOS.
6142 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6144 Set *ENDPTR to the next position where to check for faces in
6145 STRING; -1 if the face is constant from POS to the end of the
6148 Value is the id of the face to use. The face returned is suitable
6149 for displaying ASCII characters. */
6152 face_at_string_position (struct window
*w
, Lisp_Object string
,
6153 EMACS_INT pos
, EMACS_INT bufpos
,
6154 EMACS_INT region_beg
, EMACS_INT region_end
,
6155 EMACS_INT
*endptr
, enum face_id base_face_id
,
6158 Lisp_Object prop
, position
, end
, limit
;
6159 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6160 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6161 struct face
*base_face
;
6162 int multibyte_p
= STRING_MULTIBYTE (string
);
6163 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6165 /* Get the value of the face property at the current position within
6166 STRING. Value is nil if there is no face property. */
6167 XSETFASTINT (position
, pos
);
6168 prop
= Fget_text_property (position
, prop_name
, string
);
6170 /* Get the next position at which to check for faces. Value of end
6171 is nil if face is constant all the way to the end of the string.
6172 Otherwise it is a string position where to check faces next.
6173 Limit is the maximum position up to which to check for property
6174 changes in Fnext_single_property_change. Strings are usually
6175 short, so set the limit to the end of the string. */
6176 XSETFASTINT (limit
, SCHARS (string
));
6177 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6179 *endptr
= XFASTINT (end
);
6183 base_face
= FACE_FROM_ID (f
, base_face_id
);
6184 xassert (base_face
);
6186 /* Optimize the default case that there is no face property and we
6187 are not in the region. */
6189 && (base_face_id
!= DEFAULT_FACE_ID
6190 /* BUFPOS <= 0 means STRING is not an overlay string, so
6191 that the region doesn't have to be taken into account. */
6193 || bufpos
< region_beg
6194 || bufpos
>= region_end
)
6196 /* We can't realize faces for different charsets differently
6197 if we don't have fonts, so we can stop here if not working
6198 on a window-system frame. */
6199 || !FRAME_WINDOW_P (f
)
6200 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6201 return base_face
->id
;
6203 /* Begin with attributes from the base face. */
6204 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6206 /* Merge in attributes specified via text properties. */
6208 merge_face_ref (f
, prop
, attrs
, 1, 0);
6210 /* If in the region, merge in the region face. */
6212 && bufpos
>= region_beg
6213 && bufpos
< region_end
)
6214 merge_named_face (f
, Qregion
, attrs
, 0);
6216 /* Look up a realized face with the given face attributes,
6217 or realize a new one for ASCII characters. */
6218 return lookup_face (f
, attrs
);
6222 /* Merge a face into a realized face.
6224 F is frame where faces are (to be) realized.
6226 FACE_NAME is named face to merge.
6228 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6230 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6232 BASE_FACE_ID is realized face to merge into.
6238 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
, int base_face_id
)
6240 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6241 struct face
*base_face
;
6243 base_face
= FACE_FROM_ID (f
, base_face_id
);
6245 return base_face_id
;
6247 if (EQ (face_name
, Qt
))
6249 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6250 return base_face_id
;
6251 face_name
= lface_id_to_name
[face_id
];
6252 /* When called during make-frame, lookup_derived_face may fail
6253 if the faces are uninitialized. Don't signal an error. */
6254 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6255 return (face_id
>= 0 ? face_id
: base_face_id
);
6258 /* Begin with attributes from the base face. */
6259 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6261 if (!NILP (face_name
))
6263 if (!merge_named_face (f
, face_name
, attrs
, 0))
6264 return base_face_id
;
6270 return base_face_id
;
6271 face
= FACE_FROM_ID (f
, face_id
);
6273 return base_face_id
;
6274 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6277 /* Look up a realized face with the given face attributes,
6278 or realize a new one for ASCII characters. */
6279 return lookup_face (f
, attrs
);
6284 #ifndef HAVE_X_WINDOWS
6285 DEFUN ("x-load-color-file", Fx_load_color_file
,
6286 Sx_load_color_file
, 1, 1, 0,
6287 doc
: /* Create an alist of color entries from an external file.
6289 The file should define one named RGB color per line like so:
6291 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6292 (Lisp_Object filename
)
6295 Lisp_Object cmap
= Qnil
;
6296 Lisp_Object abspath
;
6298 CHECK_STRING (filename
);
6299 abspath
= Fexpand_file_name (filename
, Qnil
);
6301 fp
= fopen (SDATA (abspath
), "rt");
6305 int red
, green
, blue
;
6310 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6311 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6313 char *name
= buf
+ num
;
6314 num
= strlen (name
) - 1;
6315 if (num
>= 0 && name
[num
] == '\n')
6317 cmap
= Fcons (Fcons (build_string (name
),
6319 make_number (RGB (red
, green
, blue
))),
6321 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6336 /***********************************************************************
6338 ***********************************************************************/
6342 /* Print the contents of the realized face FACE to stderr. */
6345 dump_realized_face (face
)
6348 fprintf (stderr
, "ID: %d\n", face
->id
);
6349 #ifdef HAVE_X_WINDOWS
6350 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6352 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6354 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6355 fprintf (stderr
, "background: 0x%lx (%s)\n",
6357 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6359 fprintf (stderr
, "font_name: %s (%s)\n",
6360 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6361 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6362 #ifdef HAVE_X_WINDOWS
6363 fprintf (stderr
, "font = %p\n", face
->font
);
6365 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6366 fprintf (stderr
, "underline: %d (%s)\n",
6368 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6369 fprintf (stderr
, "hash: %d\n", face
->hash
);
6373 DEFUE ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6380 fprintf (stderr
, "font selection order: ");
6381 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6382 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6383 fprintf (stderr
, "\n");
6385 fprintf (stderr
, "alternative fonts: ");
6386 debug_print (Vface_alternative_font_family_alist
);
6387 fprintf (stderr
, "\n");
6389 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6390 Fdump_face (make_number (i
));
6396 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6398 error ("Not a valid face");
6399 dump_realized_face (face
);
6406 DEFUE ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6407 0, 0, 0, doc
: /* */)
6410 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6411 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6412 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6416 #endif /* GLYPH_DEBUG != 0 */
6420 /***********************************************************************
6422 ***********************************************************************/
6425 syms_of_xfaces (void)
6427 Qface
= intern_c_string ("face");
6429 Qface_no_inherit
= intern_c_string ("face-no-inherit");
6430 staticpro (&Qface_no_inherit
);
6431 Qbitmap_spec_p
= intern_c_string ("bitmap-spec-p");
6432 staticpro (&Qbitmap_spec_p
);
6433 Qframe_set_background_mode
= intern_c_string ("frame-set-background-mode");
6434 staticpro (&Qframe_set_background_mode
);
6436 /* Lisp face attribute keywords. */
6437 QCfamily
= intern_c_string (":family");
6438 staticpro (&QCfamily
);
6439 QCheight
= intern_c_string (":height");
6440 staticpro (&QCheight
);
6441 QCweight
= intern_c_string (":weight");
6442 staticpro (&QCweight
);
6443 QCslant
= intern_c_string (":slant");
6444 staticpro (&QCslant
);
6445 QCunderline
= intern_c_string (":underline");
6446 staticpro (&QCunderline
);
6447 QCinverse_video
= intern_c_string (":inverse-video");
6448 staticpro (&QCinverse_video
);
6449 QCreverse_video
= intern_c_string (":reverse-video");
6450 staticpro (&QCreverse_video
);
6451 QCforeground
= intern_c_string (":foreground");
6452 staticpro (&QCforeground
);
6453 QCbackground
= intern_c_string (":background");
6454 staticpro (&QCbackground
);
6455 QCstipple
= intern_c_string (":stipple");
6456 staticpro (&QCstipple
);
6457 QCwidth
= intern_c_string (":width");
6458 staticpro (&QCwidth
);
6459 QCfont
= intern_c_string (":font");
6460 staticpro (&QCfont
);
6461 QCfontset
= intern_c_string (":fontset");
6462 staticpro (&QCfontset
);
6463 QCbold
= intern_c_string (":bold");
6464 staticpro (&QCbold
);
6465 QCitalic
= intern_c_string (":italic");
6466 staticpro (&QCitalic
);
6467 QCoverline
= intern_c_string (":overline");
6468 staticpro (&QCoverline
);
6469 QCstrike_through
= intern_c_string (":strike-through");
6470 staticpro (&QCstrike_through
);
6471 QCbox
= intern_c_string (":box");
6473 QCinherit
= intern_c_string (":inherit");
6474 staticpro (&QCinherit
);
6476 /* Symbols used for Lisp face attribute values. */
6477 QCcolor
= intern_c_string (":color");
6478 staticpro (&QCcolor
);
6479 QCline_width
= intern_c_string (":line-width");
6480 staticpro (&QCline_width
);
6481 QCstyle
= intern_c_string (":style");
6482 staticpro (&QCstyle
);
6483 Qreleased_button
= intern_c_string ("released-button");
6484 staticpro (&Qreleased_button
);
6485 Qpressed_button
= intern_c_string ("pressed-button");
6486 staticpro (&Qpressed_button
);
6487 Qnormal
= intern_c_string ("normal");
6488 staticpro (&Qnormal
);
6489 Qultra_light
= intern_c_string ("ultra-light");
6490 staticpro (&Qultra_light
);
6491 Qextra_light
= intern_c_string ("extra-light");
6492 staticpro (&Qextra_light
);
6493 Qlight
= intern_c_string ("light");
6494 staticpro (&Qlight
);
6495 Qsemi_light
= intern_c_string ("semi-light");
6496 staticpro (&Qsemi_light
);
6497 Qsemi_bold
= intern_c_string ("semi-bold");
6498 staticpro (&Qsemi_bold
);
6499 Qbold
= intern_c_string ("bold");
6501 Qextra_bold
= intern_c_string ("extra-bold");
6502 staticpro (&Qextra_bold
);
6503 Qultra_bold
= intern_c_string ("ultra-bold");
6504 staticpro (&Qultra_bold
);
6505 Qoblique
= intern_c_string ("oblique");
6506 staticpro (&Qoblique
);
6507 Qitalic
= intern_c_string ("italic");
6508 staticpro (&Qitalic
);
6509 Qreverse_oblique
= intern_c_string ("reverse-oblique");
6510 staticpro (&Qreverse_oblique
);
6511 Qreverse_italic
= intern_c_string ("reverse-italic");
6512 staticpro (&Qreverse_italic
);
6513 Qultra_condensed
= intern_c_string ("ultra-condensed");
6514 staticpro (&Qultra_condensed
);
6515 Qextra_condensed
= intern_c_string ("extra-condensed");
6516 staticpro (&Qextra_condensed
);
6517 Qcondensed
= intern_c_string ("condensed");
6518 staticpro (&Qcondensed
);
6519 Qsemi_condensed
= intern_c_string ("semi-condensed");
6520 staticpro (&Qsemi_condensed
);
6521 Qsemi_expanded
= intern_c_string ("semi-expanded");
6522 staticpro (&Qsemi_expanded
);
6523 Qexpanded
= intern_c_string ("expanded");
6524 staticpro (&Qexpanded
);
6525 Qextra_expanded
= intern_c_string ("extra-expanded");
6526 staticpro (&Qextra_expanded
);
6527 Qultra_expanded
= intern_c_string ("ultra-expanded");
6528 staticpro (&Qultra_expanded
);
6529 Qbackground_color
= intern_c_string ("background-color");
6530 staticpro (&Qbackground_color
);
6531 Qforeground_color
= intern_c_string ("foreground-color");
6532 staticpro (&Qforeground_color
);
6533 Qunspecified
= intern_c_string ("unspecified");
6534 staticpro (&Qunspecified
);
6535 Qignore_defface
= intern_c_string (":ignore-defface");
6536 staticpro (&Qignore_defface
);
6538 Qface_alias
= intern_c_string ("face-alias");
6539 staticpro (&Qface_alias
);
6540 Qdefault
= intern_c_string ("default");
6541 staticpro (&Qdefault
);
6542 Qtool_bar
= intern_c_string ("tool-bar");
6543 staticpro (&Qtool_bar
);
6544 Qregion
= intern_c_string ("region");
6545 staticpro (&Qregion
);
6546 Qfringe
= intern_c_string ("fringe");
6547 staticpro (&Qfringe
);
6548 Qheader_line
= intern_c_string ("header-line");
6549 staticpro (&Qheader_line
);
6550 Qscroll_bar
= intern_c_string ("scroll-bar");
6551 staticpro (&Qscroll_bar
);
6552 Qmenu
= intern_c_string ("menu");
6554 Qcursor
= intern_c_string ("cursor");
6555 staticpro (&Qcursor
);
6556 Qborder
= intern_c_string ("border");
6557 staticpro (&Qborder
);
6558 Qmouse
= intern_c_string ("mouse");
6559 staticpro (&Qmouse
);
6560 Qmode_line_inactive
= intern_c_string ("mode-line-inactive");
6561 staticpro (&Qmode_line_inactive
);
6562 Qvertical_border
= intern_c_string ("vertical-border");
6563 staticpro (&Qvertical_border
);
6564 Qtty_color_desc
= intern_c_string ("tty-color-desc");
6565 staticpro (&Qtty_color_desc
);
6566 Qtty_color_standard_values
= intern_c_string ("tty-color-standard-values");
6567 staticpro (&Qtty_color_standard_values
);
6568 Qtty_color_by_index
= intern_c_string ("tty-color-by-index");
6569 staticpro (&Qtty_color_by_index
);
6570 Qtty_color_alist
= intern_c_string ("tty-color-alist");
6571 staticpro (&Qtty_color_alist
);
6572 Qscalable_fonts_allowed
= intern_c_string ("scalable-fonts-allowed");
6573 staticpro (&Qscalable_fonts_allowed
);
6575 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6576 staticpro (&Vparam_value_alist
);
6577 Vface_alternative_font_family_alist
= Qnil
;
6578 staticpro (&Vface_alternative_font_family_alist
);
6579 Vface_alternative_font_registry_alist
= Qnil
;
6580 staticpro (&Vface_alternative_font_registry_alist
);
6582 defsubr (&Sinternal_make_lisp_face
);
6583 defsubr (&Sinternal_lisp_face_p
);
6584 defsubr (&Sinternal_set_lisp_face_attribute
);
6585 #ifdef HAVE_WINDOW_SYSTEM
6586 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6588 defsubr (&Scolor_gray_p
);
6589 defsubr (&Scolor_supported_p
);
6590 #ifndef HAVE_X_WINDOWS
6591 defsubr (&Sx_load_color_file
);
6593 defsubr (&Sface_attribute_relative_p
);
6594 defsubr (&Smerge_face_attribute
);
6595 defsubr (&Sinternal_get_lisp_face_attribute
);
6596 defsubr (&Sinternal_lisp_face_attribute_values
);
6597 defsubr (&Sinternal_lisp_face_equal_p
);
6598 defsubr (&Sinternal_lisp_face_empty_p
);
6599 defsubr (&Sinternal_copy_lisp_face
);
6600 defsubr (&Sinternal_merge_in_global_face
);
6601 defsubr (&Sface_font
);
6602 defsubr (&Sframe_face_alist
);
6603 defsubr (&Sdisplay_supports_face_attributes_p
);
6604 defsubr (&Scolor_distance
);
6605 defsubr (&Sinternal_set_font_selection_order
);
6606 defsubr (&Sinternal_set_alternative_font_family_alist
);
6607 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6608 defsubr (&Sface_attributes_as_vector
);
6610 defsubr (&Sdump_face
);
6611 defsubr (&Sshow_face_resources
);
6612 #endif /* GLYPH_DEBUG */
6613 defsubr (&Sclear_face_cache
);
6614 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6616 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6617 defsubr (&Sdump_colors
);
6620 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6621 doc
: /* *Limit for font matching.
6622 If an integer > 0, font matching functions won't load more than
6623 that number of fonts when searching for a matching font. */);
6624 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6626 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6627 doc
: /* List of global face definitions (for internal use only.) */);
6628 Vface_new_frame_defaults
= Qnil
;
6630 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6631 doc
: /* *Default stipple pattern used on monochrome displays.
6632 This stipple pattern is used on monochrome displays
6633 instead of shades of gray for a face background color.
6634 See `set-face-stipple' for possible values for this variable. */);
6635 Vface_default_stipple
= make_pure_c_string ("gray3");
6637 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6638 doc
: /* An alist of defined terminal colors and their RGB values.
6639 See the docstring of `tty-color-alist' for the details. */);
6640 Vtty_defined_color_alist
= Qnil
;
6642 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6643 doc
: /* Allowed scalable fonts.
6644 A value of nil means don't allow any scalable fonts.
6645 A value of t means allow any scalable font.
6646 Otherwise, value must be a list of regular expressions. A font may be
6647 scaled if its name matches a regular expression in the list.
6648 Note that if value is nil, a scalable font might still be used, if no
6649 other font of the appropriate family and registry is available. */);
6650 Vscalable_fonts_allowed
= Qnil
;
6652 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6653 doc
: /* List of ignored fonts.
6654 Each element is a regular expression that matches names of fonts to
6656 Vface_ignored_fonts
= Qnil
;
6658 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6659 doc
: /* Alist of face remappings.
6660 Each element is of the form:
6662 (FACE REPLACEMENT...),
6664 which causes display of the face FACE to use REPLACEMENT... instead.
6665 REPLACEMENT... is interpreted the same way as the value of a `face'
6666 text property: it may be (1) A face name, (2) A list of face names,
6667 (3) A property-list of face attribute/value pairs, or (4) A list of
6668 face names or lists containing face attribute/value pairs.
6670 Multiple entries in REPLACEMENT... are merged together to form the final
6671 result, with faces or attributes earlier in the list taking precedence
6672 over those that are later.
6674 Face-name remapping cycles are suppressed; recursive references use the
6675 underlying face instead of the remapped face. So a remapping of the form:
6677 (FACE EXTRA-FACE... FACE)
6681 (FACE (FACE-ATTR VAL ...) FACE)
6683 will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6684 existing definition of FACE. Note that for the default face, this isn't
6685 necessary, as every face inherits from the default face.
6687 Making this variable buffer-local is a good way to allow buffer-specific
6688 face definitions. For instance, the mode my-mode could define a face
6689 `my-mode-default', and then in the mode setup function, do:
6691 (set (make-local-variable 'face-remapping-alist)
6692 '((default my-mode-default)))).
6694 Because Emacs normally only redraws screen areas when the underlying
6695 buffer contents change, you may need to call `redraw-display' after
6696 changing this variable for it to take effect. */);
6697 Vface_remapping_alist
= Qnil
;
6699 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6700 doc
: /* Alist of fonts vs the rescaling factors.
6701 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6702 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6703 RESCALE-RATIO is a floating point number to specify how much larger
6704 \(or smaller) font we should use. For instance, if a face requests
6705 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6706 Vface_font_rescale_alist
= Qnil
;
6708 #ifdef HAVE_WINDOW_SYSTEM
6709 defsubr (&Sbitmap_spec_p
);
6710 defsubr (&Sx_list_fonts
);
6711 defsubr (&Sinternal_face_x_get_resource
);
6712 defsubr (&Sx_family_fonts
);