1 /* xfaces.c -- "Face" primitives.
3 Copyright (C) 1993-1994, 1998-2012 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
24 When using Emacs with X, the display style of characters can be
25 changed by defining `faces'. Each face can specify the following
32 3. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 4. Font height in 1/10pt.
37 5. Font weight, e.g. `bold'.
39 6. Font slant, e.g. `italic'.
45 9. Whether or not characters should be underlined, and in what color.
47 10. Whether or not characters should be displayed in inverse video.
49 11. A background stipple, a bitmap.
51 12. Whether or not characters should be overlined, and in what color.
53 13. Whether or not characters should be strike-through, and in what
56 14. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 15. Font-spec, or nil. This is a special attribute.
61 A font-spec is a collection of font attributes (specs).
63 When this attribute is specified, the face uses a font matching
64 with the specs as is except for what overwritten by the specs in
65 the fontset (see below). In addition, the other font-related
66 attributes (1st thru 5th) are updated from the spec.
68 On the other hand, if one of the other font-related attributes are
69 specified, the corresponding specs in this attribute is set to nil.
71 15. A face name or list of face names from which to inherit attributes.
73 16. A specified average font width, which is invisible from Lisp,
74 and is used to ensure that a font specified on the command line,
75 for example, can be matched exactly.
77 17. A fontset name. This is another special attribute.
79 A fontset is a mappings from characters to font-specs, and the
80 specs overwrite the font-spec in the 14th attribute.
83 Faces are frame-local by nature because Emacs allows to define the
84 same named face (face names are symbols) differently for different
85 frames. Each frame has an alist of face definitions for all named
86 faces. The value of a named face in such an alist is a Lisp vector
87 with the symbol `face' in slot 0, and a slot for each of the face
88 attributes mentioned above.
90 There is also a global face alist `Vface_new_frame_defaults'. Face
91 definitions from this list are used to initialize faces of newly
94 A face doesn't have to specify all attributes. Those not specified
95 have a value of `unspecified'. Faces specifying all attributes but
96 the 14th are called `fully-specified'.
101 The display style of a given character in the text is determined by
102 combining several faces. This process is called `face merging'.
103 Any aspect of the display style that isn't specified by overlays or
104 text properties is taken from the `default' face. Since it is made
105 sure that the default face is always fully-specified, face merging
106 always results in a fully-specified face.
111 After all face attributes for a character have been determined by
112 merging faces of that character, that face is `realized'. The
113 realization process maps face attributes to what is physically
114 available on the system where Emacs runs. The result is a
115 `realized face' in form of a struct face which is stored in the
116 face cache of the frame on which it was realized.
118 Face realization is done in the context of the character to display
119 because different fonts may be used for different characters. In
120 other words, for characters that have different font
121 specifications, different realized faces are needed to display
124 Font specification is done by fontsets. See the comment in
125 fontset.c for the details. In the current implementation, all ASCII
126 characters share the same font in a fontset.
128 Faces are at first realized for ASCII characters, and, at that
129 time, assigned a specific realized fontset. Hereafter, we call
130 such a face as `ASCII face'. When a face for a multibyte character
131 is realized, it inherits (thus shares) a fontset of an ASCII face
132 that has the same attributes other than font-related ones.
134 Thus, all realized faces have a realized fontset.
139 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
140 font as ASCII characters. That is because it is expected that
141 unibyte text users specify a font that is suitable both for ASCII
142 and raw 8-bit characters.
147 Font selection tries to find the best available matching font for a
148 given (character, face) combination.
150 If the face specifies a fontset name, that fontset determines a
151 pattern for fonts of the given character. If the face specifies a
152 font name or the other font-related attributes, a fontset is
153 realized from the default fontset. In that case, that
154 specification determines a pattern for ASCII characters and the
155 default fontset determines a pattern for multibyte characters.
157 Available fonts on the system on which Emacs runs are then matched
158 against the font pattern. The result of font selection is the best
159 match for the given face attributes in this font list.
161 Font selection can be influenced by the user.
163 1. The user can specify the relative importance he gives the face
164 attributes width, height, weight, and slant by setting
165 face-font-selection-order (faces.el) to a list of face attribute
166 names. The default is '(:width :height :weight :slant), and means
167 that font selection first tries to find a good match for the font
168 width specified by a face, then---within fonts with that
169 width---tries to find a best match for the specified font height,
172 2. Setting face-font-family-alternatives allows the user to
173 specify alternative font families to try if a family specified by a
176 3. Setting face-font-registry-alternatives allows the user to
177 specify all alternative font registries to try for a face
178 specifying a registry.
180 4. Setting face-ignored-fonts allows the user to ignore specific
184 Character composition.
186 Usually, the realization process is already finished when Emacs
187 actually reflects the desired glyph matrix on the screen. However,
188 on displaying a composition (sequence of characters to be composed
189 on the screen), a suitable font for the components of the
190 composition is selected and realized while drawing them on the
191 screen, i.e. the realization process is delayed but in principle
195 Initialization of basic faces.
197 The faces `default', `modeline' are considered `basic faces'.
198 When redisplay happens the first time for a newly created frame,
199 basic faces are realized for CHARSET_ASCII. Frame parameters are
200 used to fill in unspecified attributes of the default face. */
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h> /* This needs to be before termchar.h */
210 #include "character.h"
212 #include "keyboard.h"
214 #include "termhooks.h"
216 #ifdef HAVE_X_WINDOWS
220 #include <Xm/XmStrDefs.h>
221 #endif /* USE_MOTIF */
222 #endif /* HAVE_X_WINDOWS */
231 /* Redefine X specifics to W32 equivalents to avoid cluttering the
232 code with #ifdef blocks. */
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
252 #include "dispextern.h"
253 #include "blockinput.h"
255 #include "intervals.h"
256 #include "termchar.h"
259 #ifdef HAVE_WINDOW_SYSTEM
261 #endif /* HAVE_WINDOW_SYSTEM */
263 #ifdef HAVE_X_WINDOWS
265 /* Compensate for a bug in Xos.h on some systems, on which it requires
266 time.h. On some such systems, Xos.h tries to redefine struct
267 timeval and struct timezone if USG is #defined while it is
270 #ifdef XOS_NEEDS_TIME_H
276 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
278 #else /* not XOS_NEEDS_TIME_H */
280 #endif /* not XOS_NEEDS_TIME_H */
282 #endif /* HAVE_X_WINDOWS */
286 /* Number of pt per inch (from the TeXbook). */
288 #define PT_PER_INCH 72.27
290 /* Non-zero if face attribute ATTR is unspecified. */
292 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
294 /* Non-zero if face attribute ATTR is `ignore-defface'. */
296 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
298 /* Value is the number of elements of VECTOR. */
300 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
302 /* Size of hash table of realized faces in face caches (should be a
305 #define FACE_CACHE_BUCKETS_SIZE 1001
307 /* Keyword symbols used for face attribute names. */
309 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
310 static Lisp_Object QCunderline
;
311 static Lisp_Object QCinverse_video
, QCstipple
;
312 Lisp_Object QCforeground
, QCbackground
;
314 static Lisp_Object QCfont
, QCbold
, QCitalic
;
315 static Lisp_Object QCreverse_video
;
316 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
317 static Lisp_Object QCfontset
;
319 /* Symbols used for attribute values. */
323 static Lisp_Object Qline
, Qwave
;
324 static Lisp_Object Qultra_light
, Qextra_light
, Qlight
;
325 static Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
326 static Lisp_Object Qoblique
, Qreverse_oblique
, Qreverse_italic
;
328 static Lisp_Object Qultra_condensed
, Qextra_condensed
;
329 Lisp_Object Qcondensed
;
330 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qextra_expanded
;
331 Lisp_Object Qexpanded
;
332 static Lisp_Object Qultra_expanded
;
333 static Lisp_Object Qreleased_button
, Qpressed_button
;
334 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
335 Lisp_Object Qunspecified
; /* used in dosfns.c */
336 static Lisp_Object QCignore_defface
;
338 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
340 /* The name of the function to call when the background of the frame
341 has changed, frame_set_background_mode. */
343 static Lisp_Object Qframe_set_background_mode
;
345 /* Names of basic faces. */
347 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
348 static Lisp_Object Qregion
;
349 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
350 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
351 Lisp_Object Qmode_line_inactive
;
352 static Lisp_Object Qvertical_border
;
354 /* The symbol `face-alias'. A symbols having that property is an
355 alias for another face. Value of the property is the name of
358 static Lisp_Object Qface_alias
;
360 /* Alist of alternative font families. Each element is of the form
361 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
362 try FAMILY1, then FAMILY2, ... */
364 Lisp_Object Vface_alternative_font_family_alist
;
366 /* Alist of alternative font registries. Each element is of the form
367 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
368 loaded, try REGISTRY1, then REGISTRY2, ... */
370 Lisp_Object Vface_alternative_font_registry_alist
;
372 /* Allowed scalable fonts. A value of nil means don't allow any
373 scalable fonts. A value of t means allow the use of any scalable
374 font. Otherwise, value must be a list of regular expressions. A
375 font may be scaled if its name matches a regular expression in the
378 static Lisp_Object Qscalable_fonts_allowed
;
380 #define DEFAULT_FONT_LIST_LIMIT 100
382 /* The symbols `foreground-color' and `background-color' which can be
383 used as part of a `face' property. This is for compatibility with
386 Lisp_Object Qforeground_color
, Qbackground_color
;
388 /* The symbols `face' and `mouse-face' used as text properties. */
392 /* Property for basic faces which other faces cannot inherit. */
394 static Lisp_Object Qface_no_inherit
;
396 /* Error symbol for wrong_type_argument in load_pixmap. */
398 static Lisp_Object Qbitmap_spec_p
;
400 /* The next ID to assign to Lisp faces. */
402 static int next_lface_id
;
404 /* A vector mapping Lisp face Id's to face names. */
406 static Lisp_Object
*lface_id_to_name
;
407 static ptrdiff_t lface_id_to_name_size
;
409 /* TTY color-related functions (defined in tty-colors.el). */
411 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
413 /* The name of the function used to compute colors on TTYs. */
415 static Lisp_Object Qtty_color_alist
;
417 /* Counter for calls to clear_face_cache. If this counter reaches
418 CLEAR_FONT_TABLE_COUNT, and a frame has more than
419 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
421 static int clear_font_table_count
;
422 #define CLEAR_FONT_TABLE_COUNT 100
423 #define CLEAR_FONT_TABLE_NFONTS 10
425 /* Non-zero means face attributes have been changed since the last
426 redisplay. Used in redisplay_internal. */
428 int face_change_count
;
430 /* Non-zero means don't display bold text if a face's foreground
431 and background colors are the inverse of the default colors of the
432 display. This is a kluge to suppress `bold black' foreground text
433 which is hard to read on an LCD monitor. */
435 static int tty_suppress_bold_inverse_default_colors_p
;
437 /* A list of the form `((x . y))' used to avoid consing in
438 Finternal_set_lisp_face_attribute. */
440 static Lisp_Object Vparam_value_alist
;
442 /* The total number of colors currently allocated. */
445 static int ncolors_allocated
;
446 static int npixmaps_allocated
;
450 /* Non-zero means the definition of the `menu' face for new frames has
453 static int menu_face_changed_default
;
456 /* Function prototypes. */
459 struct named_merge_point
;
461 static void map_tty_color (struct frame
*, struct face
*,
462 enum lface_attribute_index
, int *);
463 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
464 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
465 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
466 int, struct named_merge_point
*);
467 static ptrdiff_t load_pixmap (struct frame
*, Lisp_Object
,
468 unsigned *, unsigned *);
469 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
470 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
471 static void free_face_colors (struct frame
*, struct face
*);
472 static int face_color_gray_p (struct frame
*, const char *);
473 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
475 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
477 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
478 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
479 static int realize_basic_faces (struct frame
*);
480 static int realize_default_face (struct frame
*);
481 static void realize_named_face (struct frame
*, Lisp_Object
, int);
482 static int lface_fully_specified_p (Lisp_Object
*);
483 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
484 static unsigned hash_string_case_insensitive (Lisp_Object
);
485 static unsigned lface_hash (Lisp_Object
*);
486 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
487 static struct face_cache
*make_face_cache (struct frame
*);
488 static void clear_face_gcs (struct face_cache
*);
489 static void free_face_cache (struct face_cache
*);
490 static int face_fontset (Lisp_Object
*);
491 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
492 struct named_merge_point
*);
493 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
494 int, struct named_merge_point
*);
495 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
497 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
498 static struct face
*make_realized_face (Lisp_Object
*);
499 static void cache_face (struct face_cache
*, struct face
*, unsigned);
500 static void uncache_face (struct face_cache
*, struct face
*);
502 #ifdef HAVE_WINDOW_SYSTEM
504 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
505 static void x_free_gc (struct frame
*, GC
);
508 static void x_update_menu_appearance (struct frame
*);
510 extern void free_frame_menubar (struct frame
*);
511 #endif /* USE_X_TOOLKIT */
513 #endif /* HAVE_WINDOW_SYSTEM */
516 /***********************************************************************
518 ***********************************************************************/
520 #ifdef HAVE_X_WINDOWS
522 #ifdef DEBUG_X_COLORS
524 /* The following is a poor mans infrastructure for debugging X color
525 allocation problems on displays with PseudoColor-8. Some X servers
526 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
527 color reference counts completely so that they don't signal an
528 error when a color is freed whose reference count is already 0.
529 Other X servers do. To help me debug this, the following code
530 implements a simple reference counting schema of its own, for a
531 single display/screen. --gerd. */
533 /* Reference counts for pixel colors. */
535 int color_count
[256];
537 /* Register color PIXEL as allocated. */
540 register_color (unsigned long pixel
)
542 eassert (pixel
< 256);
543 ++color_count
[pixel
];
547 /* Register color PIXEL as deallocated. */
550 unregister_color (unsigned long pixel
)
552 eassert (pixel
< 256);
553 if (color_count
[pixel
] > 0)
554 --color_count
[pixel
];
560 /* Register N colors from PIXELS as deallocated. */
563 unregister_colors (unsigned long *pixels
, int n
)
566 for (i
= 0; i
< n
; ++i
)
567 unregister_color (pixels
[i
]);
571 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
572 doc
: /* Dump currently allocated colors to stderr. */)
577 fputc ('\n', stderr
);
579 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
582 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
585 fputc ('\n', stderr
);
587 fputc ('\t', stderr
);
591 fputc ('\n', stderr
);
595 #endif /* DEBUG_X_COLORS */
598 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
599 color values. Interrupt input must be blocked when this function
603 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
605 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
607 /* If display has an immutable color map, freeing colors is not
608 necessary and some servers don't allow it. So don't do it. */
609 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
611 #ifdef DEBUG_X_COLORS
612 unregister_colors (pixels
, npixels
);
614 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
622 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
623 color values. Interrupt input must be blocked when this function
627 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
628 long unsigned int *pixels
, int npixels
)
630 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
631 int class = dpyinfo
->visual
->class;
633 /* If display has an immutable color map, freeing colors is not
634 necessary and some servers don't allow it. So don't do it. */
635 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
637 #ifdef DEBUG_X_COLORS
638 unregister_colors (pixels
, npixels
);
640 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
643 #endif /* USE_X_TOOLKIT */
645 /* Create and return a GC for use on frame F. GC values and mask
646 are given by XGCV and MASK. */
649 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
653 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
660 /* Free GC which was used on frame F. */
663 x_free_gc (struct frame
*f
, GC gc
)
665 eassert (interrupt_input_blocked
);
666 IF_DEBUG (eassert (--ngcs
>= 0));
667 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
670 #endif /* HAVE_X_WINDOWS */
673 /* W32 emulation of GCs */
676 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
680 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
687 /* Free GC which was used on frame F. */
690 x_free_gc (struct frame
*f
, GC gc
)
692 IF_DEBUG (eassert (--ngcs
>= 0));
696 #endif /* WINDOWSNT */
699 /* NS emulation of GCs */
702 x_create_gc (struct frame
*f
,
706 GC gc
= xmalloc (sizeof (*gc
));
708 memcpy (gc
, xgcv
, sizeof (XGCValues
));
713 x_free_gc (struct frame
*f
, GC gc
)
719 #ifndef HAVE_STRCASECMP
720 /* Like strcasecmp/stricmp. Used to compare parts of font names which
724 xstrcasecmp (const char *s1
, const char *s2
)
728 unsigned char b1
= *s1
;
729 unsigned char b2
= *s2
;
730 unsigned char c1
= tolower (b1
);
731 unsigned char c2
= tolower (b2
);
733 return c1
< c2
? -1 : 1;
738 return *s2
== 0 ? 0 : -1;
741 #endif /* HAVE_STRCASECMP */
743 /* If FRAME is nil, return a pointer to the selected frame.
744 Otherwise, check that FRAME is a live frame, and return a pointer
745 to it. NPARAM is the parameter number of FRAME, for
746 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
747 Lisp function definitions. */
749 static inline struct frame
*
750 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
753 frame
= selected_frame
;
755 CHECK_LIVE_FRAME (frame
);
756 return XFRAME (frame
);
760 /***********************************************************************
762 ***********************************************************************/
764 /* Initialize face cache and basic faces for frame F. */
767 init_frame_faces (struct frame
*f
)
769 /* Make a face cache, if F doesn't have one. */
770 if (FRAME_FACE_CACHE (f
) == NULL
)
771 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
773 #ifdef HAVE_WINDOW_SYSTEM
774 /* Make the image cache. */
775 if (FRAME_WINDOW_P (f
))
777 /* We initialize the image cache when creating the first frame
778 on a terminal, and not during terminal creation. This way,
779 `x-open-connection' on a tty won't create an image cache. */
780 if (FRAME_IMAGE_CACHE (f
) == NULL
)
781 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
782 ++FRAME_IMAGE_CACHE (f
)->refcount
;
784 #endif /* HAVE_WINDOW_SYSTEM */
786 /* Realize basic faces. Must have enough information in frame
787 parameters to realize basic faces at this point. */
788 #ifdef HAVE_X_WINDOWS
789 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
792 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
795 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
797 if (!realize_basic_faces (f
))
802 /* Free face cache of frame F. Called from delete_frame. */
805 free_frame_faces (struct frame
*f
)
807 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
811 free_face_cache (face_cache
);
812 FRAME_FACE_CACHE (f
) = NULL
;
815 #ifdef HAVE_WINDOW_SYSTEM
816 if (FRAME_WINDOW_P (f
))
818 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
821 --image_cache
->refcount
;
822 if (image_cache
->refcount
== 0)
823 free_image_cache (f
);
826 #endif /* HAVE_WINDOW_SYSTEM */
830 /* Clear face caches, and recompute basic faces for frame F. Call
831 this after changing frame parameters on which those faces depend,
832 or when realized faces have been freed due to changing attributes
836 recompute_basic_faces (struct frame
*f
)
838 if (FRAME_FACE_CACHE (f
))
840 clear_face_cache (0);
841 if (!realize_basic_faces (f
))
847 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
848 try to free unused fonts, too. */
851 clear_face_cache (int clear_fonts_p
)
853 #ifdef HAVE_WINDOW_SYSTEM
854 Lisp_Object tail
, frame
;
857 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
860 /* Not yet implemented. */
861 clear_font_cache (frame
);
864 /* From time to time see if we can unload some fonts. This also
865 frees all realized faces on all frames. Fonts needed by
866 faces will be loaded again when faces are realized again. */
867 clear_font_table_count
= 0;
869 FOR_EACH_FRAME (tail
, frame
)
871 struct frame
*f
= XFRAME (frame
);
872 if (FRAME_WINDOW_P (f
)
873 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
874 free_all_realized_faces (frame
);
879 /* Clear GCs of realized faces. */
880 FOR_EACH_FRAME (tail
, frame
)
882 struct frame
*f
= XFRAME (frame
);
883 if (FRAME_WINDOW_P (f
))
884 clear_face_gcs (FRAME_FACE_CACHE (f
));
886 clear_image_caches (Qnil
);
888 #endif /* HAVE_WINDOW_SYSTEM */
892 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
893 doc
: /* Clear face caches on all frames.
894 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
895 (Lisp_Object thoroughly
)
897 clear_face_cache (!NILP (thoroughly
));
899 ++windows_or_buffers_changed
;
904 /***********************************************************************
906 ***********************************************************************/
908 #ifdef HAVE_WINDOW_SYSTEM
910 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
911 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
912 A bitmap specification is either a string, a file name, or a list
913 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
914 HEIGHT is its height, and DATA is a string containing the bits of
915 the pixmap. Bits are stored row by row, each row occupies
916 \(WIDTH + 7)/8 bytes. */)
921 if (STRINGP (object
))
922 /* If OBJECT is a string, it's a file name. */
924 else if (CONSP (object
))
926 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
927 HEIGHT must be ints > 0, and DATA must be string large
928 enough to hold a bitmap of the specified size. */
929 Lisp_Object width
, height
, data
;
931 height
= width
= data
= Qnil
;
935 width
= XCAR (object
);
936 object
= XCDR (object
);
939 height
= XCAR (object
);
940 object
= XCDR (object
);
942 data
= XCAR (object
);
947 && RANGED_INTEGERP (1, width
, INT_MAX
)
948 && RANGED_INTEGERP (1, height
, INT_MAX
))
950 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
952 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
957 return pixmap_p
? Qt
: Qnil
;
961 /* Load a bitmap according to NAME (which is either a file name or a
962 pixmap spec) for use on frame F. Value is the bitmap_id (see
963 xfns.c). If NAME is nil, return with a bitmap id of zero. If
964 bitmap cannot be loaded, display a message saying so, and return
965 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
966 if these pointers are not null. */
969 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
,
977 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
982 /* Decode a bitmap spec into a bitmap. */
987 w
= XINT (Fcar (name
));
988 h
= XINT (Fcar (Fcdr (name
)));
989 bits
= Fcar (Fcdr (Fcdr (name
)));
991 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
996 /* It must be a string -- a file name. */
997 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1003 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
1014 ++npixmaps_allocated
;
1017 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1020 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1026 #endif /* HAVE_WINDOW_SYSTEM */
1030 /***********************************************************************
1032 ***********************************************************************/
1034 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1035 RGB_LIST should contain (at least) 3 lisp integers.
1036 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1039 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1041 #define PARSE_RGB_LIST_FIELD(field) \
1042 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1044 color->field = XINT (XCAR (rgb_list)); \
1045 rgb_list = XCDR (rgb_list); \
1050 PARSE_RGB_LIST_FIELD (red
);
1051 PARSE_RGB_LIST_FIELD (green
);
1052 PARSE_RGB_LIST_FIELD (blue
);
1058 /* Lookup on frame F the color described by the lisp string COLOR.
1059 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1060 non-zero, then the `standard' definition of the same color is
1064 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
1067 Lisp_Object frame
, color_desc
;
1069 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1072 XSETFRAME (frame
, f
);
1074 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1075 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1079 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1082 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1084 rgb
= XCDR (XCDR (color_desc
));
1085 if (! parse_rgb_list (rgb
, tty_color
))
1088 /* Should we fill in STD_COLOR too? */
1091 /* Default STD_COLOR to the same as TTY_COLOR. */
1092 *std_color
= *tty_color
;
1094 /* Do a quick check to see if the returned descriptor is
1095 actually _exactly_ equal to COLOR, otherwise we have to
1096 lookup STD_COLOR separately. If it's impossible to lookup
1097 a standard color, we just give up and use TTY_COLOR. */
1098 if ((!STRINGP (XCAR (color_desc
))
1099 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1100 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1102 /* Look up STD_COLOR separately. */
1103 rgb
= call1 (Qtty_color_standard_values
, color
);
1104 if (! parse_rgb_list (rgb
, std_color
))
1111 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1112 /* We were called early during startup, and the colors are not
1113 yet set up in tty-defined-color-alist. Don't return a failure
1114 indication, since this produces the annoying "Unable to
1115 load color" messages in the *Messages* buffer. */
1118 /* tty-color-desc seems to have returned a bad value. */
1122 /* A version of defined_color for non-X frames. */
1125 tty_defined_color (struct frame
*f
, const char *color_name
,
1126 XColor
*color_def
, int alloc
)
1131 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1133 color_def
->blue
= 0;
1134 color_def
->green
= 0;
1137 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1139 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1141 if (strcmp (color_name
, "unspecified-fg") == 0)
1142 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1143 else if (strcmp (color_name
, "unspecified-bg") == 0)
1144 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1147 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1154 /* Decide if color named COLOR_NAME is valid for the display
1155 associated with the frame F; if so, return the rgb values in
1156 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1158 This does the right thing for any type of frame. */
1161 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1164 if (!FRAME_WINDOW_P (f
))
1165 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1166 #ifdef HAVE_X_WINDOWS
1167 else if (FRAME_X_P (f
))
1168 return x_defined_color (f
, color_name
, color_def
, alloc
);
1171 else if (FRAME_W32_P (f
))
1172 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1175 else if (FRAME_NS_P (f
))
1176 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1183 /* Given the index IDX of a tty color on frame F, return its name, a
1187 tty_color_name (struct frame
*f
, int idx
)
1189 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1192 Lisp_Object coldesc
;
1194 XSETFRAME (frame
, f
);
1195 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1197 if (!NILP (coldesc
))
1198 return XCAR (coldesc
);
1201 /* We can have an MSDOG frame under -nw for a short window of
1202 opportunity before internal_terminal_init is called. DTRT. */
1203 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1204 return msdos_stdcolor_name (idx
);
1207 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1208 return build_string (unspecified_fg
);
1209 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1210 return build_string (unspecified_bg
);
1212 return Qunspecified
;
1216 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1219 The criterion implemented here is not a terribly sophisticated one. */
1222 face_color_gray_p (struct frame
*f
, const char *color_name
)
1227 if (defined_color (f
, color_name
, &color
, 0))
1228 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1229 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1231 ((eabs (color
.red
- color
.green
)
1232 < max (color
.red
, color
.green
) / 20)
1233 && (eabs (color
.green
- color
.blue
)
1234 < max (color
.green
, color
.blue
) / 20)
1235 && (eabs (color
.blue
- color
.red
)
1236 < max (color
.blue
, color
.red
) / 20)));
1244 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1245 BACKGROUND_P non-zero means the color will be used as background
1249 face_color_supported_p (struct frame
*f
, const char *color_name
,
1255 XSETFRAME (frame
, f
);
1257 #ifdef HAVE_WINDOW_SYSTEM
1259 ? (!NILP (Fxw_display_color_p (frame
))
1260 || xstrcasecmp (color_name
, "black") == 0
1261 || xstrcasecmp (color_name
, "white") == 0
1263 && face_color_gray_p (f
, color_name
))
1264 || (!NILP (Fx_display_grayscale_p (frame
))
1265 && face_color_gray_p (f
, color_name
)))
1268 tty_defined_color (f
, color_name
, ¬_used
, 0);
1272 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1273 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1274 FRAME specifies the frame and thus the display for interpreting COLOR.
1275 If FRAME is nil or omitted, use the selected frame. */)
1276 (Lisp_Object color
, Lisp_Object frame
)
1280 CHECK_STRING (color
);
1282 frame
= selected_frame
;
1284 CHECK_FRAME (frame
);
1286 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1290 DEFUN ("color-supported-p", Fcolor_supported_p
,
1291 Scolor_supported_p
, 1, 3, 0,
1292 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1293 BACKGROUND-P non-nil means COLOR is used as a background.
1294 Otherwise, this function tells whether it can be used as a foreground.
1295 If FRAME is nil or omitted, use the selected frame.
1296 COLOR must be a valid color name. */)
1297 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1301 CHECK_STRING (color
);
1303 frame
= selected_frame
;
1305 CHECK_FRAME (frame
);
1307 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1313 /* Load color with name NAME for use by face FACE on frame F.
1314 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1315 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1316 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1317 pixel color. If color cannot be loaded, display a message, and
1318 return the foreground, background or underline color of F, but
1319 record that fact in flags of the face so that we don't try to free
1323 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1324 enum lface_attribute_index target_index
)
1328 eassert (STRINGP (name
));
1329 eassert (target_index
== LFACE_FOREGROUND_INDEX
1330 || target_index
== LFACE_BACKGROUND_INDEX
1331 || target_index
== LFACE_UNDERLINE_INDEX
1332 || target_index
== LFACE_OVERLINE_INDEX
1333 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1334 || target_index
== LFACE_BOX_INDEX
);
1336 /* if the color map is full, defined_color will return a best match
1337 to the values in an existing cell. */
1338 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1340 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1342 switch (target_index
)
1344 case LFACE_FOREGROUND_INDEX
:
1345 face
->foreground_defaulted_p
= 1;
1346 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1349 case LFACE_BACKGROUND_INDEX
:
1350 face
->background_defaulted_p
= 1;
1351 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1354 case LFACE_UNDERLINE_INDEX
:
1355 face
->underline_defaulted_p
= 1;
1356 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1359 case LFACE_OVERLINE_INDEX
:
1360 face
->overline_color_defaulted_p
= 1;
1361 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1364 case LFACE_STRIKE_THROUGH_INDEX
:
1365 face
->strike_through_color_defaulted_p
= 1;
1366 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1369 case LFACE_BOX_INDEX
:
1370 face
->box_color_defaulted_p
= 1;
1371 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1380 ++ncolors_allocated
;
1387 #ifdef HAVE_WINDOW_SYSTEM
1389 /* Load colors for face FACE which is used on frame F. Colors are
1390 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1391 of ATTRS. If the background color specified is not supported on F,
1392 try to emulate gray colors with a stipple from Vface_default_stipple. */
1395 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1399 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1400 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1402 /* Swap colors if face is inverse-video. */
1403 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1411 /* Check for support for foreground, not for background because
1412 face_color_supported_p is smart enough to know that grays are
1413 "supported" as background because we are supposed to use stipple
1415 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1416 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1418 x_destroy_bitmap (f
, face
->stipple
);
1419 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1420 &face
->pixmap_w
, &face
->pixmap_h
);
1423 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1424 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1428 /* Free color PIXEL on frame F. */
1431 unload_color (struct frame
*f
, long unsigned int pixel
)
1433 #ifdef HAVE_X_WINDOWS
1437 x_free_colors (f
, &pixel
, 1);
1444 /* Free colors allocated for FACE. */
1447 free_face_colors (struct frame
*f
, struct face
*face
)
1449 /* PENDING(NS): need to do something here? */
1450 #ifdef HAVE_X_WINDOWS
1451 if (face
->colors_copied_bitwise_p
)
1456 if (!face
->foreground_defaulted_p
)
1458 x_free_colors (f
, &face
->foreground
, 1);
1459 IF_DEBUG (--ncolors_allocated
);
1462 if (!face
->background_defaulted_p
)
1464 x_free_colors (f
, &face
->background
, 1);
1465 IF_DEBUG (--ncolors_allocated
);
1468 if (face
->underline_p
1469 && !face
->underline_defaulted_p
)
1471 x_free_colors (f
, &face
->underline_color
, 1);
1472 IF_DEBUG (--ncolors_allocated
);
1475 if (face
->overline_p
1476 && !face
->overline_color_defaulted_p
)
1478 x_free_colors (f
, &face
->overline_color
, 1);
1479 IF_DEBUG (--ncolors_allocated
);
1482 if (face
->strike_through_p
1483 && !face
->strike_through_color_defaulted_p
)
1485 x_free_colors (f
, &face
->strike_through_color
, 1);
1486 IF_DEBUG (--ncolors_allocated
);
1489 if (face
->box
!= FACE_NO_BOX
1490 && !face
->box_color_defaulted_p
)
1492 x_free_colors (f
, &face
->box_color
, 1);
1493 IF_DEBUG (--ncolors_allocated
);
1497 #endif /* HAVE_X_WINDOWS */
1500 #endif /* HAVE_WINDOW_SYSTEM */
1504 /***********************************************************************
1506 ***********************************************************************/
1508 /* An enumerator for each field of an XLFD font name. */
1529 /* An enumerator for each possible slant value of a font. Taken from
1530 the XLFD specification. */
1538 XLFD_SLANT_REVERSE_ITALIC
,
1539 XLFD_SLANT_REVERSE_OBLIQUE
,
1543 /* Relative font weight according to XLFD documentation. */
1547 XLFD_WEIGHT_UNKNOWN
,
1548 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1549 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1550 XLFD_WEIGHT_LIGHT
, /* 30 */
1551 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1552 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1553 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1554 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1555 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1556 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1559 /* Relative proportionate width. */
1563 XLFD_SWIDTH_UNKNOWN
,
1564 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1565 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1566 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1567 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1568 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1569 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1570 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1571 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1572 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1575 /* Order by which font selection chooses fonts. The default values
1576 mean `first, find a best match for the font width, then for the
1577 font height, then for weight, then for slant.' This variable can be
1578 set via set-face-font-sort-order. */
1580 static int font_sort_order
[4];
1582 #ifdef HAVE_WINDOW_SYSTEM
1584 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1587 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1589 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1590 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1593 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1595 enum font_property_index idx
= font_props_for_sorting
[i
];
1596 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1599 if (idx
<= FONT_REGISTRY_INDEX
)
1602 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1604 result
= STRINGP (val2
) ? 1 : 0;
1608 if (INTEGERP (val1
))
1609 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1610 ? XINT (val1
) > XINT (val2
)
1613 result
= INTEGERP (val2
) ? 1 : 0;
1621 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1622 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1623 If FAMILY is omitted or nil, list all families.
1624 Otherwise, FAMILY must be a string, possibly containing wildcards
1626 If FRAME is omitted or nil, use the selected frame.
1627 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1628 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1629 FAMILY is the font family name. POINT-SIZE is the size of the
1630 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1631 width, weight and slant of the font. These symbols are the same as for
1632 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1633 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1634 giving the registry and encoding of the font.
1635 The result list is sorted according to the current setting of
1636 the face font sort order. */)
1637 (Lisp_Object family
, Lisp_Object frame
)
1639 Lisp_Object font_spec
, list
, *drivers
, vec
;
1640 ptrdiff_t i
, nfonts
;
1646 frame
= selected_frame
;
1647 CHECK_LIVE_FRAME (frame
);
1649 font_spec
= Ffont_spec (0, NULL
);
1652 CHECK_STRING (family
);
1653 font_parse_family_registry (family
, Qnil
, font_spec
);
1656 list
= font_list_entities (frame
, font_spec
);
1660 /* Sort the font entities. */
1661 for (i
= 0; i
< 4; i
++)
1662 switch (font_sort_order
[i
])
1665 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1666 case XLFD_POINT_SIZE
:
1667 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1669 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1671 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1673 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1674 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1675 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1676 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1678 ndrivers
= XINT (Flength (list
));
1679 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1680 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1681 drivers
[i
] = XCAR (list
);
1682 vec
= Fvconcat (ndrivers
, drivers
);
1683 nfonts
= ASIZE (vec
);
1685 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1686 compare_fonts_by_sort_order
);
1689 for (i
= nfonts
- 1; i
>= 0; --i
)
1691 Lisp_Object font
= AREF (vec
, i
);
1692 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1694 Lisp_Object spacing
;
1696 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1697 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1698 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1699 XFRAME (frame
)->resy
);
1700 ASET (v
, 2, make_number (point
));
1701 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1702 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1703 spacing
= Ffont_get (font
, QCspacing
);
1704 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1705 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1706 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1708 result
= Fcons (v
, result
);
1715 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1716 doc
: /* Return a list of the names of available fonts matching PATTERN.
1717 If optional arguments FACE and FRAME are specified, return only fonts
1718 the same size as FACE on FRAME.
1720 PATTERN should be a string containing a font name in the XLFD,
1721 Fontconfig, or GTK format. A font name given in the XLFD format may
1722 contain wildcard characters:
1723 the * character matches any substring, and
1724 the ? character matches any single character.
1725 PATTERN is case-insensitive.
1727 The return value is a list of strings, suitable as arguments to
1730 Fonts Emacs can't use may or may not be excluded
1731 even if they match PATTERN and FACE.
1732 The optional fourth argument MAXIMUM sets a limit on how many
1733 fonts to match. The first MAXIMUM fonts are reported.
1734 The optional fifth argument WIDTH, if specified, is a number of columns
1735 occupied by a character of a font. In that case, return only fonts
1736 the WIDTH times as wide as FACE on FRAME. */)
1737 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1738 Lisp_Object maximum
, Lisp_Object width
)
1741 int size
, avgwidth
IF_LINT (= 0);
1744 CHECK_STRING (pattern
);
1746 if (! NILP (maximum
))
1747 CHECK_NATNUM (maximum
);
1750 CHECK_NUMBER (width
);
1752 /* We can't simply call check_x_frame because this function may be
1753 called before any frame is created. */
1755 frame
= selected_frame
;
1756 f
= frame_or_selected_frame (frame
, 2);
1757 if (! FRAME_WINDOW_P (f
))
1759 /* Perhaps we have not yet created any frame. */
1765 /* Determine the width standard for comparison with the fonts we find. */
1771 /* This is of limited utility since it works with character
1772 widths. Keep it for compatibility. --gerd. */
1773 int face_id
= lookup_named_face (f
, face
, 0);
1774 struct face
*width_face
= (face_id
< 0
1776 : FACE_FROM_ID (f
, face_id
));
1778 if (width_face
&& width_face
->font
)
1780 size
= width_face
->font
->pixel_size
;
1781 avgwidth
= width_face
->font
->average_width
;
1785 size
= FRAME_FONT (f
)->pixel_size
;
1786 avgwidth
= FRAME_FONT (f
)->average_width
;
1789 avgwidth
*= XINT (width
);
1793 Lisp_Object font_spec
;
1794 Lisp_Object args
[2], tail
;
1796 font_spec
= font_spec_from_name (pattern
);
1797 if (!FONTP (font_spec
))
1798 signal_error ("Invalid font name", pattern
);
1802 Ffont_put (font_spec
, QCsize
, make_number (size
));
1803 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1805 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1806 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1808 Lisp_Object font_entity
;
1810 font_entity
= XCAR (tail
);
1811 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1812 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1813 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1815 /* This is a scalable font. For backward compatibility,
1816 we set the specified size. */
1817 font_entity
= copy_font_spec (font_entity
);
1818 ASET (font_entity
, FONT_SIZE_INDEX
,
1819 AREF (font_spec
, FONT_SIZE_INDEX
));
1821 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1824 /* We don't have to check fontsets. */
1826 args
[1] = list_fontsets (f
, pattern
, size
);
1827 return Fnconc (2, args
);
1831 #endif /* HAVE_WINDOW_SYSTEM */
1834 /***********************************************************************
1836 ***********************************************************************/
1838 /* Access face attributes of face LFACE, a Lisp vector. */
1840 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1841 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1842 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1843 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1844 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1845 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1846 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1847 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1848 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1849 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1850 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1851 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1852 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1853 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1854 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1855 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1856 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1858 #ifdef ENABLE_CHECKING
1859 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1860 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1862 #define LFACEP(LFACE) \
1864 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1865 && EQ (AREF (LFACE, 0), Qface))
1871 /* Check consistency of Lisp face attribute vector ATTRS. */
1874 check_lface_attrs (Lisp_Object
*attrs
)
1876 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1877 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1878 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1879 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1880 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1881 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1882 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1883 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1884 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1885 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1886 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1887 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1888 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1889 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1890 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1891 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1892 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1893 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1894 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1895 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1896 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1897 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1898 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1899 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1900 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1901 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1902 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1903 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1904 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1905 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1906 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1907 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1908 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1909 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1910 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1911 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1912 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1913 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1914 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1915 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1916 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1917 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1918 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1919 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1920 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1921 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1922 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1923 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1924 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1925 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1926 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1927 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1928 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1929 #ifdef HAVE_WINDOW_SYSTEM
1930 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1931 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1932 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1933 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1934 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1935 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1936 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1937 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1938 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1939 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1944 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1947 check_lface (Lisp_Object lface
)
1951 eassert (LFACEP (lface
));
1952 check_lface_attrs (XVECTOR (lface
)->contents
);
1956 #else /* GLYPH_DEBUG == 0 */
1958 #define check_lface_attrs(attrs) (void) 0
1959 #define check_lface(lface) (void) 0
1961 #endif /* GLYPH_DEBUG == 0 */
1965 /* Face-merge cycle checking. */
1967 enum named_merge_point_kind
1969 NAMED_MERGE_POINT_NORMAL
,
1970 NAMED_MERGE_POINT_REMAP
1973 /* A `named merge point' is simply a point during face-merging where we
1974 look up a face by name. We keep a stack of which named lookups we're
1975 currently processing so that we can easily detect cycles, using a
1976 linked- list of struct named_merge_point structures, typically
1977 allocated on the stack frame of the named lookup functions which are
1978 active (so no consing is required). */
1979 struct named_merge_point
1981 Lisp_Object face_name
;
1982 enum named_merge_point_kind named_merge_point_kind
;
1983 struct named_merge_point
*prev
;
1987 /* If a face merging cycle is detected for FACE_NAME, return 0,
1988 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1989 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1990 pointed to by NAMED_MERGE_POINTS, and return 1. */
1993 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1994 Lisp_Object face_name
,
1995 enum named_merge_point_kind named_merge_point_kind
,
1996 struct named_merge_point
**named_merge_points
)
1998 struct named_merge_point
*prev
;
2000 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
2001 if (EQ (face_name
, prev
->face_name
))
2003 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
2004 /* A cycle, so fail. */
2006 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
2007 /* A remap `hides ' any previous normal merge points
2008 (because the remap means that it's actually different face),
2009 so as we know the current merge point must be normal, we
2010 can just assume it's OK. */
2014 new_named_merge_point
->face_name
= face_name
;
2015 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
2016 new_named_merge_point
->prev
= *named_merge_points
;
2018 *named_merge_points
= new_named_merge_point
;
2024 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2025 to make it a symbol. If FACE_NAME is an alias for another face,
2026 return that face's name.
2028 Return default face in case of errors. */
2031 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2033 Lisp_Object orig_face
;
2034 Lisp_Object tortoise
, hare
;
2036 if (STRINGP (face_name
))
2037 face_name
= intern (SSDATA (face_name
));
2039 if (NILP (face_name
) || !SYMBOLP (face_name
))
2042 orig_face
= face_name
;
2043 tortoise
= hare
= face_name
;
2048 hare
= Fget (hare
, Qface_alias
);
2049 if (NILP (hare
) || !SYMBOLP (hare
))
2053 hare
= Fget (hare
, Qface_alias
);
2054 if (NILP (hare
) || !SYMBOLP (hare
))
2057 tortoise
= Fget (tortoise
, Qface_alias
);
2058 if (EQ (hare
, tortoise
))
2061 xsignal1 (Qcircular_list
, orig_face
);
2070 /* Return the face definition of FACE_NAME on frame F. F null means
2071 return the definition for new frames. FACE_NAME may be a string or
2072 a symbol (apparently Emacs 20.2 allowed strings as face names in
2073 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2074 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2075 is zero, value is nil if FACE_NAME is not a valid face name. */
2076 static inline Lisp_Object
2077 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
2083 lface
= assq_no_quit (face_name
, f
->face_alist
);
2085 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2088 lface
= XCDR (lface
);
2090 signal_error ("Invalid face", face_name
);
2092 check_lface (lface
);
2097 /* Return the face definition of FACE_NAME on frame F. F null means
2098 return the definition for new frames. FACE_NAME may be a string or
2099 a symbol (apparently Emacs 20.2 allowed strings as face names in
2100 face text properties; Ediff uses that). If FACE_NAME is an alias
2101 for another face, return that face's definition. If SIGNAL_P is
2102 non-zero, signal an error if FACE_NAME is not a valid face name.
2103 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2105 static inline Lisp_Object
2106 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2108 face_name
= resolve_face_name (face_name
, signal_p
);
2109 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2113 /* Get face attributes of face FACE_NAME from frame-local faces on
2114 frame F. Store the resulting attributes in ATTRS which must point
2115 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2116 is non-zero, signal an error if FACE_NAME does not name a face.
2117 Otherwise, value is zero if FACE_NAME is not a face. */
2120 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
2121 Lisp_Object
*attrs
, int signal_p
)
2125 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2128 memcpy (attrs
, XVECTOR (lface
)->contents
,
2129 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2131 return !NILP (lface
);
2134 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2135 F. Store the resulting attributes in ATTRS which must point to a
2136 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2137 alias for another face, use that face's definition. If SIGNAL_P is
2138 non-zero, signal an error if FACE_NAME does not name a face.
2139 Otherwise, value is zero if FACE_NAME is not a face. */
2142 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2143 Lisp_Object
*attrs
, int signal_p
,
2144 struct named_merge_point
*named_merge_points
)
2146 Lisp_Object face_remapping
;
2148 face_name
= resolve_face_name (face_name
, signal_p
);
2150 /* See if SYMBOL has been remapped to some other face (usually this
2151 is done buffer-locally). */
2152 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2153 if (CONSP (face_remapping
))
2155 struct named_merge_point named_merge_point
;
2157 if (push_named_merge_point (&named_merge_point
,
2158 face_name
, NAMED_MERGE_POINT_REMAP
,
2159 &named_merge_points
))
2163 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2164 attrs
[i
] = Qunspecified
;
2166 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2167 signal_p
, named_merge_points
);
2171 /* Default case, no remapping. */
2172 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2176 /* Non-zero if all attributes in face attribute vector ATTRS are
2177 specified, i.e. are non-nil. */
2180 lface_fully_specified_p (Lisp_Object
*attrs
)
2184 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2185 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2186 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2189 return i
== LFACE_VECTOR_SIZE
;
2192 #ifdef HAVE_WINDOW_SYSTEM
2194 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2195 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2196 exception is `font' attribute. It is set to FONT_OBJECT regardless
2200 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2201 Lisp_Object font_object
, int force_p
)
2204 struct font
*font
= XFONT_OBJECT (font_object
);
2206 /* Set attributes only if unspecified, otherwise face defaults for
2207 new frames would never take effect. If the font doesn't have a
2208 specific property, set a normal value for that. */
2210 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2212 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2214 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2217 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2219 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2221 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2224 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2226 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2229 LFACE_HEIGHT (lface
) = make_number (pt
);
2232 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2234 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2235 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2237 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2239 val
= FONT_SLANT_FOR_FACE (font_object
);
2240 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2242 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2244 val
= FONT_WIDTH_FOR_FACE (font_object
);
2245 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2248 LFACE_FONT (lface
) = font_object
;
2252 #endif /* HAVE_WINDOW_SYSTEM */
2255 /* Merges the face height FROM with the face height TO, and returns the
2256 merged height. If FROM is an invalid height, then INVALID is
2257 returned instead. FROM and TO may be either absolute face heights or
2258 `relative' heights; the returned value is always an absolute height
2259 unless both FROM and TO are relative. */
2262 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2264 Lisp_Object result
= invalid
;
2266 if (INTEGERP (from
))
2267 /* FROM is absolute, just use it as is. */
2269 else if (FLOATP (from
))
2270 /* FROM is a scale, use it to adjust TO. */
2273 /* relative X absolute => absolute */
2274 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2275 else if (FLOATP (to
))
2276 /* relative X relative => relative */
2277 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2278 else if (UNSPECIFIEDP (to
))
2281 else if (FUNCTIONP (from
))
2282 /* FROM is a function, which use to adjust TO. */
2284 /* Call function with current height as argument.
2285 From is the new height. */
2286 Lisp_Object args
[2];
2290 result
= safe_call (2, args
);
2292 /* Ensure that if TO was absolute, so is the result. */
2293 if (INTEGERP (to
) && !INTEGERP (result
))
2301 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2302 store the resulting attributes in TO, which must be already be
2303 completely specified and contain only absolute attributes. Every
2304 specified attribute of FROM overrides the corresponding attribute of
2305 TO; relative attributes in FROM are merged with the absolute value in
2306 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2307 loops in face inheritance/remapping; it should be 0 when called from
2311 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2312 struct named_merge_point
*named_merge_points
)
2316 /* If FROM inherits from some other faces, merge their attributes into
2317 TO before merging FROM's direct attributes. Note that an :inherit
2318 attribute of `unspecified' is the same as one of nil; we never
2319 merge :inherit attributes, so nil is more correct, but lots of
2320 other code uses `unspecified' as a generic value for face attributes. */
2321 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2322 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2323 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2325 i
= LFACE_FONT_INDEX
;
2326 if (!UNSPECIFIEDP (from
[i
]))
2328 if (!UNSPECIFIEDP (to
[i
]))
2329 to
[i
] = merge_font_spec (from
[i
], to
[i
]);
2331 to
[i
] = copy_font_spec (from
[i
]);
2332 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2333 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2334 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2335 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2336 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2337 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2338 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2339 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2340 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2341 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2342 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2345 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2346 if (!UNSPECIFIEDP (from
[i
]))
2348 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2350 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2351 font_clear_prop (to
, FONT_SIZE_INDEX
);
2353 else if (i
!= LFACE_FONT_INDEX
2354 && ! EQ (to
[i
], from
[i
]))
2357 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2358 font_clear_prop (to
,
2359 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2360 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2361 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2362 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2363 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2364 : FONT_SLANT_INDEX
));
2368 /* TO is always an absolute face, which should inherit from nothing.
2369 We blindly copy the :inherit attribute above and fix it up here. */
2370 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2373 /* Merge the named face FACE_NAME on frame F, into the vector of face
2374 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2375 inheritance. Returns true if FACE_NAME is a valid face name and
2376 merging succeeded. */
2379 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2380 struct named_merge_point
*named_merge_points
)
2382 struct named_merge_point named_merge_point
;
2384 if (push_named_merge_point (&named_merge_point
,
2385 face_name
, NAMED_MERGE_POINT_NORMAL
,
2386 &named_merge_points
))
2388 struct gcpro gcpro1
;
2389 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2390 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2394 GCPRO1 (named_merge_point
.face_name
);
2395 merge_face_vectors (f
, from
, to
, named_merge_points
);
2406 /* Merge face attributes from the lisp `face reference' FACE_REF on
2407 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2408 problems with FACE_REF cause an error message to be shown. Return
2409 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2410 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2411 list structure; it may be 0 for most callers.
2413 FACE_REF may be a single face specification or a list of such
2414 specifications. Each face specification can be:
2416 1. A symbol or string naming a Lisp face.
2418 2. A property list of the form (KEYWORD VALUE ...) where each
2419 KEYWORD is a face attribute name, and value is an appropriate value
2422 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2423 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2424 for compatibility with 20.2.
2426 Face specifications earlier in lists take precedence over later
2430 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2431 int err_msgs
, struct named_merge_point
*named_merge_points
)
2433 int ok
= 1; /* Succeed without an error? */
2435 if (CONSP (face_ref
))
2437 Lisp_Object first
= XCAR (face_ref
);
2439 if (EQ (first
, Qforeground_color
)
2440 || EQ (first
, Qbackground_color
))
2442 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2443 . COLOR). COLOR must be a string. */
2444 Lisp_Object color_name
= XCDR (face_ref
);
2445 Lisp_Object color
= first
;
2447 if (STRINGP (color_name
))
2449 if (EQ (color
, Qforeground_color
))
2450 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2452 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2457 add_to_log ("Invalid face color", color_name
, Qnil
);
2461 else if (SYMBOLP (first
)
2462 && *SDATA (SYMBOL_NAME (first
)) == ':')
2464 /* Assume this is the property list form. */
2465 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2467 Lisp_Object keyword
= XCAR (face_ref
);
2468 Lisp_Object value
= XCAR (XCDR (face_ref
));
2471 /* Specifying `unspecified' is a no-op. */
2472 if (EQ (value
, Qunspecified
))
2474 else if (EQ (keyword
, QCfamily
))
2476 if (STRINGP (value
))
2478 to
[LFACE_FAMILY_INDEX
] = value
;
2479 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2484 else if (EQ (keyword
, QCfoundry
))
2486 if (STRINGP (value
))
2488 to
[LFACE_FOUNDRY_INDEX
] = value
;
2489 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2494 else if (EQ (keyword
, QCheight
))
2496 Lisp_Object new_height
=
2497 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2499 if (! NILP (new_height
))
2501 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2502 font_clear_prop (to
, FONT_SIZE_INDEX
);
2507 else if (EQ (keyword
, QCweight
))
2509 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2511 to
[LFACE_WEIGHT_INDEX
] = value
;
2512 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2517 else if (EQ (keyword
, QCslant
))
2519 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2521 to
[LFACE_SLANT_INDEX
] = value
;
2522 font_clear_prop (to
, FONT_SLANT_INDEX
);
2527 else if (EQ (keyword
, QCunderline
))
2533 to
[LFACE_UNDERLINE_INDEX
] = value
;
2537 else if (EQ (keyword
, QCoverline
))
2542 to
[LFACE_OVERLINE_INDEX
] = value
;
2546 else if (EQ (keyword
, QCstrike_through
))
2551 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2555 else if (EQ (keyword
, QCbox
))
2558 value
= make_number (1);
2559 if (INTEGERP (value
)
2563 to
[LFACE_BOX_INDEX
] = value
;
2567 else if (EQ (keyword
, QCinverse_video
)
2568 || EQ (keyword
, QCreverse_video
))
2570 if (EQ (value
, Qt
) || NILP (value
))
2571 to
[LFACE_INVERSE_INDEX
] = value
;
2575 else if (EQ (keyword
, QCforeground
))
2577 if (STRINGP (value
))
2578 to
[LFACE_FOREGROUND_INDEX
] = value
;
2582 else if (EQ (keyword
, QCbackground
))
2584 if (STRINGP (value
))
2585 to
[LFACE_BACKGROUND_INDEX
] = value
;
2589 else if (EQ (keyword
, QCstipple
))
2591 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
2592 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2593 if (!NILP (pixmap_p
))
2594 to
[LFACE_STIPPLE_INDEX
] = value
;
2599 else if (EQ (keyword
, QCwidth
))
2601 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2603 to
[LFACE_SWIDTH_INDEX
] = value
;
2604 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2609 else if (EQ (keyword
, QCinherit
))
2611 /* This is not really very useful; it's just like a
2612 normal face reference. */
2613 if (! merge_face_ref (f
, value
, to
,
2614 err_msgs
, named_merge_points
))
2622 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2626 face_ref
= XCDR (XCDR (face_ref
));
2631 /* This is a list of face refs. Those at the beginning of the
2632 list take precedence over what follows, so we have to merge
2633 from the end backwards. */
2634 Lisp_Object next
= XCDR (face_ref
);
2637 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2639 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2645 /* FACE_REF ought to be a face name. */
2646 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2647 if (!ok
&& err_msgs
)
2648 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2655 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2656 Sinternal_make_lisp_face
, 1, 2, 0,
2657 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2658 If FACE was not known as a face before, create a new one.
2659 If optional argument FRAME is specified, make a frame-local face
2660 for that frame. Otherwise operate on the global face definition.
2661 Value is a vector of face attributes. */)
2662 (Lisp_Object face
, Lisp_Object frame
)
2664 Lisp_Object global_lface
, lface
;
2668 CHECK_SYMBOL (face
);
2669 global_lface
= lface_from_face_name (NULL
, face
, 0);
2673 CHECK_LIVE_FRAME (frame
);
2675 lface
= lface_from_face_name (f
, face
, 0);
2678 f
= NULL
, lface
= Qnil
;
2680 /* Add a global definition if there is none. */
2681 if (NILP (global_lface
))
2683 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2685 ASET (global_lface
, 0, Qface
);
2686 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2687 Vface_new_frame_defaults
);
2689 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2690 face id to Lisp face is given by the vector lface_id_to_name.
2691 The mapping from Lisp face to Lisp face id is given by the
2692 property `face' of the Lisp face name. */
2693 if (next_lface_id
== lface_id_to_name_size
)
2695 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2696 sizeof *lface_id_to_name
);
2698 lface_id_to_name
[next_lface_id
] = face
;
2699 Fput (face
, Qface
, make_number (next_lface_id
));
2703 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2704 ASET (global_lface
, i
, Qunspecified
);
2706 /* Add a frame-local definition. */
2711 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2713 ASET (lface
, 0, Qface
);
2714 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2717 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2718 ASET (lface
, i
, Qunspecified
);
2721 lface
= global_lface
;
2723 /* Changing a named face means that all realized faces depending on
2724 that face are invalid. Since we cannot tell which realized faces
2725 depend on the face, make sure they are all removed. This is done
2726 by incrementing face_change_count. The next call to
2727 init_iterator will then free realized faces. */
2728 if (NILP (Fget (face
, Qface_no_inherit
)))
2730 ++face_change_count
;
2731 ++windows_or_buffers_changed
;
2734 eassert (LFACEP (lface
));
2735 check_lface (lface
);
2740 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2741 Sinternal_lisp_face_p
, 1, 2, 0,
2742 doc
: /* Return non-nil if FACE names a face.
2743 FACE should be a symbol or string.
2744 If optional second argument FRAME is non-nil, check for the
2745 existence of a frame-local face with name FACE on that frame.
2746 Otherwise check for the existence of a global face. */)
2747 (Lisp_Object face
, Lisp_Object frame
)
2751 face
= resolve_face_name (face
, 1);
2755 CHECK_LIVE_FRAME (frame
);
2756 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2759 lface
= lface_from_face_name (NULL
, face
, 0);
2765 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2766 Sinternal_copy_lisp_face
, 4, 4, 0,
2767 doc
: /* Copy face FROM to TO.
2768 If FRAME is t, copy the global face definition of FROM.
2769 Otherwise, copy the frame-local definition of FROM on FRAME.
2770 If NEW-FRAME is a frame, copy that data into the frame-local
2771 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2772 FRAME controls where the data is copied to.
2774 The value is TO. */)
2775 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2777 Lisp_Object lface
, copy
;
2779 CHECK_SYMBOL (from
);
2784 /* Copy global definition of FROM. We don't make copies of
2785 strings etc. because 20.2 didn't do it either. */
2786 lface
= lface_from_face_name (NULL
, from
, 1);
2787 copy
= Finternal_make_lisp_face (to
, Qnil
);
2791 /* Copy frame-local definition of FROM. */
2792 if (NILP (new_frame
))
2794 CHECK_LIVE_FRAME (frame
);
2795 CHECK_LIVE_FRAME (new_frame
);
2796 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2797 copy
= Finternal_make_lisp_face (to
, new_frame
);
2800 memcpy (XVECTOR (copy
)->contents
, XVECTOR (lface
)->contents
,
2801 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2803 /* Changing a named face means that all realized faces depending on
2804 that face are invalid. Since we cannot tell which realized faces
2805 depend on the face, make sure they are all removed. This is done
2806 by incrementing face_change_count. The next call to
2807 init_iterator will then free realized faces. */
2808 if (NILP (Fget (to
, Qface_no_inherit
)))
2810 ++face_change_count
;
2811 ++windows_or_buffers_changed
;
2818 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2819 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2820 doc
: /* Set attribute ATTR of FACE to VALUE.
2821 FRAME being a frame means change the face on that frame.
2822 FRAME nil means change the face of the selected frame.
2823 FRAME t means change the default for new frames.
2824 FRAME 0 means change the face on all frames, and change the default
2826 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2829 Lisp_Object old_value
= Qnil
;
2830 /* Set one of enum font_property_index (> 0) if ATTR is one of
2831 font-related attributes other than QCfont and QCfontset. */
2832 enum font_property_index prop_index
= 0;
2834 CHECK_SYMBOL (face
);
2835 CHECK_SYMBOL (attr
);
2837 face
= resolve_face_name (face
, 1);
2839 /* If FRAME is 0, change face on all frames, and change the
2840 default for new frames. */
2841 if (INTEGERP (frame
) && XINT (frame
) == 0)
2844 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2845 FOR_EACH_FRAME (tail
, frame
)
2846 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2850 /* Set lface to the Lisp attribute vector of FACE. */
2853 lface
= lface_from_face_name (NULL
, face
, 1);
2855 /* When updating face-new-frame-defaults, we put :ignore-defface
2856 where the caller wants `unspecified'. This forces the frame
2857 defaults to ignore the defface value. Otherwise, the defface
2858 will take effect, which is generally not what is intended.
2859 The value of that attribute will be inherited from some other
2860 face during face merging. See internal_merge_in_global_face. */
2861 if (UNSPECIFIEDP (value
))
2862 value
= QCignore_defface
;
2867 frame
= selected_frame
;
2869 CHECK_LIVE_FRAME (frame
);
2870 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2872 /* If a frame-local face doesn't exist yet, create one. */
2874 lface
= Finternal_make_lisp_face (face
, frame
);
2877 if (EQ (attr
, QCfamily
))
2879 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2881 CHECK_STRING (value
);
2882 if (SCHARS (value
) == 0)
2883 signal_error ("Invalid face family", value
);
2885 old_value
= LFACE_FAMILY (lface
);
2886 LFACE_FAMILY (lface
) = value
;
2887 prop_index
= FONT_FAMILY_INDEX
;
2889 else if (EQ (attr
, QCfoundry
))
2891 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2893 CHECK_STRING (value
);
2894 if (SCHARS (value
) == 0)
2895 signal_error ("Invalid face foundry", value
);
2897 old_value
= LFACE_FOUNDRY (lface
);
2898 LFACE_FOUNDRY (lface
) = value
;
2899 prop_index
= FONT_FOUNDRY_INDEX
;
2901 else if (EQ (attr
, QCheight
))
2903 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2905 if (EQ (face
, Qdefault
))
2907 /* The default face must have an absolute size. */
2908 if (!INTEGERP (value
) || XINT (value
) <= 0)
2909 signal_error ("Default face height not absolute and positive",
2914 /* For non-default faces, do a test merge with a random
2915 height to see if VALUE's ok. */
2916 Lisp_Object test
= merge_face_heights (value
,
2919 if (!INTEGERP (test
) || XINT (test
) <= 0)
2920 signal_error ("Face height does not produce a positive integer",
2925 old_value
= LFACE_HEIGHT (lface
);
2926 LFACE_HEIGHT (lface
) = value
;
2927 prop_index
= FONT_SIZE_INDEX
;
2929 else if (EQ (attr
, QCweight
))
2931 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2933 CHECK_SYMBOL (value
);
2934 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2935 signal_error ("Invalid face weight", value
);
2937 old_value
= LFACE_WEIGHT (lface
);
2938 LFACE_WEIGHT (lface
) = value
;
2939 prop_index
= FONT_WEIGHT_INDEX
;
2941 else if (EQ (attr
, QCslant
))
2943 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2945 CHECK_SYMBOL (value
);
2946 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2947 signal_error ("Invalid face slant", value
);
2949 old_value
= LFACE_SLANT (lface
);
2950 LFACE_SLANT (lface
) = value
;
2951 prop_index
= FONT_SLANT_INDEX
;
2953 else if (EQ (attr
, QCunderline
))
2957 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2959 else if (NILP (value
) || EQ (value
, Qt
))
2961 else if (STRINGP (value
) && SCHARS (value
) > 0)
2963 else if (CONSP (value
))
2965 Lisp_Object key
, val
, list
;
2970 while (!NILP (CAR_SAFE(list
)))
2972 key
= CAR_SAFE (list
);
2973 list
= CDR_SAFE (list
);
2974 val
= CAR_SAFE (list
);
2975 list
= CDR_SAFE (list
);
2977 if(NILP (key
) || NILP (val
))
2983 else if (EQ (key
, QCcolor
)
2984 && !(EQ (val
, Qforeground_color
)
2985 || (STRINGP (val
) && SCHARS (val
) > 0)))
2991 else if (EQ (key
, QCstyle
)
2992 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
3001 signal_error ("Invalid face underline", value
);
3003 old_value
= LFACE_UNDERLINE (lface
);
3004 LFACE_UNDERLINE (lface
) = value
;
3006 else if (EQ (attr
, QCoverline
))
3008 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3009 if ((SYMBOLP (value
)
3011 && !EQ (value
, Qnil
))
3012 /* Overline color. */
3014 && SCHARS (value
) == 0))
3015 signal_error ("Invalid face overline", value
);
3017 old_value
= LFACE_OVERLINE (lface
);
3018 LFACE_OVERLINE (lface
) = value
;
3020 else if (EQ (attr
, QCstrike_through
))
3022 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3023 if ((SYMBOLP (value
)
3025 && !EQ (value
, Qnil
))
3026 /* Strike-through color. */
3028 && SCHARS (value
) == 0))
3029 signal_error ("Invalid face strike-through", value
);
3031 old_value
= LFACE_STRIKE_THROUGH (lface
);
3032 LFACE_STRIKE_THROUGH (lface
) = value
;
3034 else if (EQ (attr
, QCbox
))
3038 /* Allow t meaning a simple box of width 1 in foreground color
3041 value
= make_number (1);
3043 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3045 else if (NILP (value
))
3047 else if (INTEGERP (value
))
3048 valid_p
= XINT (value
) != 0;
3049 else if (STRINGP (value
))
3050 valid_p
= SCHARS (value
) > 0;
3051 else if (CONSP (value
))
3067 if (EQ (k
, QCline_width
))
3069 if (!INTEGERP (v
) || XINT (v
) == 0)
3072 else if (EQ (k
, QCcolor
))
3074 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3077 else if (EQ (k
, QCstyle
))
3079 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3086 valid_p
= NILP (tem
);
3092 signal_error ("Invalid face box", value
);
3094 old_value
= LFACE_BOX (lface
);
3095 LFACE_BOX (lface
) = value
;
3097 else if (EQ (attr
, QCinverse_video
)
3098 || EQ (attr
, QCreverse_video
))
3100 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3102 CHECK_SYMBOL (value
);
3103 if (!EQ (value
, Qt
) && !NILP (value
))
3104 signal_error ("Invalid inverse-video face attribute value", value
);
3106 old_value
= LFACE_INVERSE (lface
);
3107 LFACE_INVERSE (lface
) = value
;
3109 else if (EQ (attr
, QCforeground
))
3111 /* Compatibility with 20.x. */
3113 value
= Qunspecified
;
3114 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3116 /* Don't check for valid color names here because it depends
3117 on the frame (display) whether the color will be valid
3118 when the face is realized. */
3119 CHECK_STRING (value
);
3120 if (SCHARS (value
) == 0)
3121 signal_error ("Empty foreground color value", value
);
3123 old_value
= LFACE_FOREGROUND (lface
);
3124 LFACE_FOREGROUND (lface
) = value
;
3126 else if (EQ (attr
, QCbackground
))
3128 /* Compatibility with 20.x. */
3130 value
= Qunspecified
;
3131 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3133 /* Don't check for valid color names here because it depends
3134 on the frame (display) whether the color will be valid
3135 when the face is realized. */
3136 CHECK_STRING (value
);
3137 if (SCHARS (value
) == 0)
3138 signal_error ("Empty background color value", value
);
3140 old_value
= LFACE_BACKGROUND (lface
);
3141 LFACE_BACKGROUND (lface
) = value
;
3143 else if (EQ (attr
, QCstipple
))
3145 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
3146 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3148 && NILP (Fbitmap_spec_p (value
)))
3149 signal_error ("Invalid stipple attribute", value
);
3150 old_value
= LFACE_STIPPLE (lface
);
3151 LFACE_STIPPLE (lface
) = value
;
3152 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3154 else if (EQ (attr
, QCwidth
))
3156 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3158 CHECK_SYMBOL (value
);
3159 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3160 signal_error ("Invalid face width", value
);
3162 old_value
= LFACE_SWIDTH (lface
);
3163 LFACE_SWIDTH (lface
) = value
;
3164 prop_index
= FONT_WIDTH_INDEX
;
3166 else if (EQ (attr
, QCfont
))
3168 #ifdef HAVE_WINDOW_SYSTEM
3169 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3171 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3175 old_value
= LFACE_FONT (lface
);
3176 if (! FONTP (value
))
3178 if (STRINGP (value
))
3180 Lisp_Object name
= value
;
3181 int fontset
= fs_query_fontset (name
, 0);
3184 name
= fontset_ascii (fontset
);
3185 value
= font_spec_from_name (name
);
3187 signal_error ("Invalid font name", name
);
3190 signal_error ("Invalid font or font-spec", value
);
3193 f
= XFRAME (selected_frame
);
3196 if (! FONT_OBJECT_P (value
))
3198 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3199 Lisp_Object font_object
;
3201 font_object
= font_load_for_lface (f
, attrs
, value
);
3202 if (NILP (font_object
))
3203 signal_error ("Font not available", value
);
3204 value
= font_object
;
3206 set_lface_from_font (f
, lface
, value
, 1);
3209 LFACE_FONT (lface
) = value
;
3211 #endif /* HAVE_WINDOW_SYSTEM */
3213 else if (EQ (attr
, QCfontset
))
3215 #ifdef HAVE_WINDOW_SYSTEM
3216 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3220 old_value
= LFACE_FONTSET (lface
);
3221 tmp
= Fquery_fontset (value
, Qnil
);
3223 signal_error ("Invalid fontset name", value
);
3224 LFACE_FONTSET (lface
) = value
= tmp
;
3226 #endif /* HAVE_WINDOW_SYSTEM */
3228 else if (EQ (attr
, QCinherit
))
3231 if (SYMBOLP (value
))
3234 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3235 if (!SYMBOLP (XCAR (tail
)))
3238 LFACE_INHERIT (lface
) = value
;
3240 signal_error ("Invalid face inheritance", value
);
3242 else if (EQ (attr
, QCbold
))
3244 old_value
= LFACE_WEIGHT (lface
);
3245 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3246 prop_index
= FONT_WEIGHT_INDEX
;
3248 else if (EQ (attr
, QCitalic
))
3251 old_value
= LFACE_SLANT (lface
);
3252 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3253 prop_index
= FONT_SLANT_INDEX
;
3256 signal_error ("Invalid face attribute name", attr
);
3260 /* If a font-related attribute other than QCfont and QCfontset
3261 is specified, and if the original QCfont attribute has a font
3262 (font-spec or font-object), set the corresponding property in
3263 the font to nil so that the font selector doesn't think that
3264 the attribute is mandatory. Also, clear the average
3266 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3269 /* Changing a named face means that all realized faces depending on
3270 that face are invalid. Since we cannot tell which realized faces
3271 depend on the face, make sure they are all removed. This is done
3272 by incrementing face_change_count. The next call to
3273 init_iterator will then free realized faces. */
3275 && NILP (Fget (face
, Qface_no_inherit
))
3276 && NILP (Fequal (old_value
, value
)))
3278 ++face_change_count
;
3279 ++windows_or_buffers_changed
;
3282 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3283 && NILP (Fequal (old_value
, value
)))
3289 if (EQ (face
, Qdefault
))
3291 #ifdef HAVE_WINDOW_SYSTEM
3292 /* Changed font-related attributes of the `default' face are
3293 reflected in changed `font' frame parameters. */
3295 && (prop_index
|| EQ (attr
, QCfont
))
3296 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3297 set_font_frame_param (frame
, lface
);
3299 #endif /* HAVE_WINDOW_SYSTEM */
3301 if (EQ (attr
, QCforeground
))
3302 param
= Qforeground_color
;
3303 else if (EQ (attr
, QCbackground
))
3304 param
= Qbackground_color
;
3306 #ifdef HAVE_WINDOW_SYSTEM
3308 else if (EQ (face
, Qscroll_bar
))
3310 /* Changing the colors of `scroll-bar' sets frame parameters
3311 `scroll-bar-foreground' and `scroll-bar-background'. */
3312 if (EQ (attr
, QCforeground
))
3313 param
= Qscroll_bar_foreground
;
3314 else if (EQ (attr
, QCbackground
))
3315 param
= Qscroll_bar_background
;
3317 #endif /* not WINDOWSNT */
3318 else if (EQ (face
, Qborder
))
3320 /* Changing background color of `border' sets frame parameter
3322 if (EQ (attr
, QCbackground
))
3323 param
= Qborder_color
;
3325 else if (EQ (face
, Qcursor
))
3327 /* Changing background color of `cursor' sets frame parameter
3329 if (EQ (attr
, QCbackground
))
3330 param
= Qcursor_color
;
3332 else if (EQ (face
, Qmouse
))
3334 /* Changing background color of `mouse' sets frame parameter
3336 if (EQ (attr
, QCbackground
))
3337 param
= Qmouse_color
;
3339 #endif /* HAVE_WINDOW_SYSTEM */
3340 else if (EQ (face
, Qmenu
))
3342 /* Indicate that we have to update the menu bar when
3343 realizing faces on FRAME. FRAME t change the
3344 default for new frames. We do this by setting
3345 setting the flag in new face caches */
3348 struct frame
*f
= XFRAME (frame
);
3349 if (FRAME_FACE_CACHE (f
) == NULL
)
3350 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3351 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3354 menu_face_changed_default
= 1;
3360 /* Update `default-frame-alist', which is used for new frames. */
3362 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3365 /* Update the current frame's parameters. */
3368 cons
= XCAR (Vparam_value_alist
);
3369 XSETCAR (cons
, param
);
3370 XSETCDR (cons
, value
);
3371 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3380 /* Update the corresponding face when frame parameter PARAM on frame F
3381 has been assigned the value NEW_VALUE. */
3384 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3385 Lisp_Object new_value
)
3387 Lisp_Object face
= Qnil
;
3390 /* If there are no faces yet, give up. This is the case when called
3391 from Fx_create_frame, and we do the necessary things later in
3392 face-set-after-frame-defaults. */
3393 if (NILP (f
->face_alist
))
3396 if (EQ (param
, Qforeground_color
))
3399 lface
= lface_from_face_name (f
, face
, 1);
3400 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3401 ? new_value
: Qunspecified
);
3402 realize_basic_faces (f
);
3404 else if (EQ (param
, Qbackground_color
))
3408 /* Changing the background color might change the background
3409 mode, so that we have to load new defface specs.
3410 Call frame-set-background-mode to do that. */
3411 XSETFRAME (frame
, f
);
3412 call1 (Qframe_set_background_mode
, frame
);
3415 lface
= lface_from_face_name (f
, face
, 1);
3416 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3417 ? new_value
: Qunspecified
);
3418 realize_basic_faces (f
);
3420 #ifdef HAVE_WINDOW_SYSTEM
3421 else if (EQ (param
, Qborder_color
))
3424 lface
= lface_from_face_name (f
, face
, 1);
3425 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3426 ? new_value
: Qunspecified
);
3428 else if (EQ (param
, Qcursor_color
))
3431 lface
= lface_from_face_name (f
, face
, 1);
3432 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3433 ? new_value
: Qunspecified
);
3435 else if (EQ (param
, Qmouse_color
))
3438 lface
= lface_from_face_name (f
, face
, 1);
3439 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3440 ? new_value
: Qunspecified
);
3444 /* Changing a named face means that all realized faces depending on
3445 that face are invalid. Since we cannot tell which realized faces
3446 depend on the face, make sure they are all removed. This is done
3447 by incrementing face_change_count. The next call to
3448 init_iterator will then free realized faces. */
3450 && NILP (Fget (face
, Qface_no_inherit
)))
3452 ++face_change_count
;
3453 ++windows_or_buffers_changed
;
3458 #ifdef HAVE_WINDOW_SYSTEM
3460 /* Set the `font' frame parameter of FRAME determined from the
3461 font-object set in `default' face attributes LFACE. */
3464 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3466 struct frame
*f
= XFRAME (frame
);
3469 if (FRAME_WINDOW_P (f
)
3470 /* Don't do anything if the font is `unspecified'. This can
3471 happen during frame creation. */
3472 && (font
= LFACE_FONT (lface
),
3473 ! UNSPECIFIEDP (font
)))
3475 if (FONT_SPEC_P (font
))
3477 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3480 LFACE_FONT (lface
) = font
;
3482 f
->default_face_done_p
= 0;
3483 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3488 /* Get the value of X resource RESOURCE, class CLASS for the display
3489 of frame FRAME. This is here because ordinary `x-get-resource'
3490 doesn't take a frame argument. */
3492 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3493 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3494 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3496 Lisp_Object value
= Qnil
;
3497 CHECK_STRING (resource
);
3498 CHECK_STRING (class);
3499 CHECK_LIVE_FRAME (frame
);
3501 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3502 resource
, class, Qnil
, Qnil
);
3508 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3509 If VALUE is "on" or "true", return t. If VALUE is "off" or
3510 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3511 error; if SIGNAL_P is zero, return 0. */
3514 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3516 Lisp_Object result
= make_number (0);
3518 eassert (STRINGP (value
));
3520 if (xstrcasecmp (SSDATA (value
), "on") == 0
3521 || xstrcasecmp (SSDATA (value
), "true") == 0)
3523 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3524 || xstrcasecmp (SSDATA (value
), "false") == 0)
3526 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3527 result
= Qunspecified
;
3529 signal_error ("Invalid face attribute value from X resource", value
);
3535 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3536 Finternal_set_lisp_face_attribute_from_resource
,
3537 Sinternal_set_lisp_face_attribute_from_resource
,
3538 3, 4, 0, doc
: /* */)
3539 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3541 CHECK_SYMBOL (face
);
3542 CHECK_SYMBOL (attr
);
3543 CHECK_STRING (value
);
3545 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3546 value
= Qunspecified
;
3547 else if (EQ (attr
, QCheight
))
3549 value
= Fstring_to_number (value
, make_number (10));
3550 if (XINT (value
) <= 0)
3551 signal_error ("Invalid face height from X resource", value
);
3553 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3554 value
= face_boolean_x_resource_value (value
, 1);
3555 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3556 value
= intern (SSDATA (value
));
3557 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3558 value
= face_boolean_x_resource_value (value
, 1);
3559 else if (EQ (attr
, QCunderline
)
3560 || EQ (attr
, QCoverline
)
3561 || EQ (attr
, QCstrike_through
))
3563 Lisp_Object boolean_value
;
3565 /* If the result of face_boolean_x_resource_value is t or nil,
3566 VALUE does NOT specify a color. */
3567 boolean_value
= face_boolean_x_resource_value (value
, 0);
3568 if (SYMBOLP (boolean_value
))
3569 value
= boolean_value
;
3571 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3572 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3574 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3577 #endif /* HAVE_WINDOW_SYSTEM */
3580 /***********************************************************************
3582 ***********************************************************************/
3584 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3586 /* Make menus on frame F appear as specified by the `menu' face. */
3589 x_update_menu_appearance (struct frame
*f
)
3591 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3595 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3600 ptrdiff_t bufsize
= sizeof line
;
3601 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3602 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3603 const char *myname
= SSDATA (Vx_resource_name
);
3606 const char *popup_path
= "popup_menu";
3608 const char *popup_path
= "menu.popup";
3611 if (STRINGP (LFACE_FOREGROUND (lface
)))
3613 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3615 SDATA (LFACE_FOREGROUND (lface
)));
3616 XrmPutLineResource (&rdb
, line
);
3617 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3618 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3619 XrmPutLineResource (&rdb
, line
);
3623 if (STRINGP (LFACE_BACKGROUND (lface
)))
3625 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3627 SDATA (LFACE_BACKGROUND (lface
)));
3628 XrmPutLineResource (&rdb
, line
);
3630 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3631 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3632 XrmPutLineResource (&rdb
, line
);
3637 /* On Solaris 5.8, it's been reported that the `menu' face
3638 can be unspecified here, during startup. Why this
3639 happens remains unknown. -- cyd */
3640 && FONTP (LFACE_FONT (lface
))
3641 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3642 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3643 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3644 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3645 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3646 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3648 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3650 const char *suffix
= "List";
3653 #if defined HAVE_X_I18N
3655 const char *suffix
= "Set";
3657 const char *suffix
= "";
3664 #if defined HAVE_X_I18N
3665 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3667 char *fontsetname
= SSDATA (xlfd
);
3669 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3670 myname
, suffix
, fontsetname
);
3671 XrmPutLineResource (&rdb
, line
);
3673 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3674 myname
, popup_path
, suffix
, fontsetname
);
3675 XrmPutLineResource (&rdb
, line
);
3677 if (fontsetname
!= SSDATA (xlfd
))
3678 xfree (fontsetname
);
3682 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3683 free_frame_menubar (f
);
3690 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3693 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3694 Sface_attribute_relative_p
,
3696 doc
: /* Check whether a face attribute value is relative.
3697 Specifically, this function returns t if the attribute ATTRIBUTE
3698 with the value VALUE is relative.
3700 A relative value is one that doesn't entirely override whatever is
3701 inherited from another face. For most possible attributes,
3702 the only relative value that users see is `unspecified'.
3703 However, for :height, floating point values are also relative. */)
3704 (Lisp_Object attribute
, Lisp_Object value
)
3706 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3708 else if (EQ (attribute
, QCheight
))
3709 return INTEGERP (value
) ? Qnil
: Qt
;
3714 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3716 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3717 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3718 the result will be absolute, otherwise it will be relative. */)
3719 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3721 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3723 else if (EQ (attribute
, QCheight
))
3724 return merge_face_heights (value1
, value2
, value1
);
3730 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3731 Sinternal_get_lisp_face_attribute
,
3733 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3734 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3735 face attribute name, signal an error.
3736 If the optional argument FRAME is given, report on face SYMBOL in that
3737 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3738 frames). If FRAME is omitted or nil, use the selected frame. */)
3739 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3741 Lisp_Object lface
, value
= Qnil
;
3743 CHECK_SYMBOL (symbol
);
3744 CHECK_SYMBOL (keyword
);
3747 lface
= lface_from_face_name (NULL
, symbol
, 1);
3751 frame
= selected_frame
;
3752 CHECK_LIVE_FRAME (frame
);
3753 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3756 if (EQ (keyword
, QCfamily
))
3757 value
= LFACE_FAMILY (lface
);
3758 else if (EQ (keyword
, QCfoundry
))
3759 value
= LFACE_FOUNDRY (lface
);
3760 else if (EQ (keyword
, QCheight
))
3761 value
= LFACE_HEIGHT (lface
);
3762 else if (EQ (keyword
, QCweight
))
3763 value
= LFACE_WEIGHT (lface
);
3764 else if (EQ (keyword
, QCslant
))
3765 value
= LFACE_SLANT (lface
);
3766 else if (EQ (keyword
, QCunderline
))
3767 value
= LFACE_UNDERLINE (lface
);
3768 else if (EQ (keyword
, QCoverline
))
3769 value
= LFACE_OVERLINE (lface
);
3770 else if (EQ (keyword
, QCstrike_through
))
3771 value
= LFACE_STRIKE_THROUGH (lface
);
3772 else if (EQ (keyword
, QCbox
))
3773 value
= LFACE_BOX (lface
);
3774 else if (EQ (keyword
, QCinverse_video
)
3775 || EQ (keyword
, QCreverse_video
))
3776 value
= LFACE_INVERSE (lface
);
3777 else if (EQ (keyword
, QCforeground
))
3778 value
= LFACE_FOREGROUND (lface
);
3779 else if (EQ (keyword
, QCbackground
))
3780 value
= LFACE_BACKGROUND (lface
);
3781 else if (EQ (keyword
, QCstipple
))
3782 value
= LFACE_STIPPLE (lface
);
3783 else if (EQ (keyword
, QCwidth
))
3784 value
= LFACE_SWIDTH (lface
);
3785 else if (EQ (keyword
, QCinherit
))
3786 value
= LFACE_INHERIT (lface
);
3787 else if (EQ (keyword
, QCfont
))
3788 value
= LFACE_FONT (lface
);
3789 else if (EQ (keyword
, QCfontset
))
3790 value
= LFACE_FONTSET (lface
);
3792 signal_error ("Invalid face attribute name", keyword
);
3794 if (IGNORE_DEFFACE_P (value
))
3795 return Qunspecified
;
3801 DEFUN ("internal-lisp-face-attribute-values",
3802 Finternal_lisp_face_attribute_values
,
3803 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3804 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3805 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3808 Lisp_Object result
= Qnil
;
3810 CHECK_SYMBOL (attr
);
3812 if (EQ (attr
, QCunderline
))
3813 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3814 else if (EQ (attr
, QCoverline
))
3815 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3816 else if (EQ (attr
, QCstrike_through
))
3817 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3818 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3819 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3825 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3826 Sinternal_merge_in_global_face
, 2, 2, 0,
3827 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3828 Default face attributes override any local face attributes. */)
3829 (Lisp_Object face
, Lisp_Object frame
)
3832 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3833 struct frame
*f
= XFRAME (frame
);
3835 CHECK_LIVE_FRAME (frame
);
3836 global_lface
= lface_from_face_name (NULL
, face
, 1);
3837 local_lface
= lface_from_face_name (f
, face
, 0);
3838 if (NILP (local_lface
))
3839 local_lface
= Finternal_make_lisp_face (face
, frame
);
3841 /* Make every specified global attribute override the local one.
3842 BEWARE!! This is only used from `face-set-after-frame-default' where
3843 the local frame is defined from default specs in `face-defface-spec'
3844 and those should be overridden by global settings. Hence the strange
3845 "global before local" priority. */
3846 lvec
= XVECTOR (local_lface
)->contents
;
3847 gvec
= XVECTOR (global_lface
)->contents
;
3848 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3849 if (IGNORE_DEFFACE_P (gvec
[i
]))
3850 lvec
[i
] = Qunspecified
;
3851 else if (! UNSPECIFIEDP (gvec
[i
]))
3854 /* If the default face was changed, update the face cache and the
3855 `font' frame parameter. */
3856 if (EQ (face
, Qdefault
))
3858 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3859 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3860 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3862 /* This can be NULL (e.g., in batch mode). */
3865 /* Ensure that the face vector is fully specified by merging
3866 the previously-cached vector. */
3867 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3868 merge_face_vectors (f
, lvec
, attrs
, 0);
3869 memcpy (lvec
, attrs
, sizeof attrs
);
3870 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3872 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3873 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3874 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3875 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3876 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3877 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3878 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3881 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3882 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3886 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3887 Fmodify_frame_parameters (frame
,
3888 Fcons (Fcons (Qforeground_color
,
3889 gvec
[LFACE_FOREGROUND_INDEX
]),
3892 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3893 Fmodify_frame_parameters (frame
,
3894 Fcons (Fcons (Qbackground_color
,
3895 gvec
[LFACE_BACKGROUND_INDEX
]),
3904 /* The following function is implemented for compatibility with 20.2.
3905 The function is used in x-resolve-fonts when it is asked to
3906 return fonts with the same size as the font of a face. This is
3907 done in fontset.el. */
3909 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3910 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3911 The font name is, by default, for ASCII characters.
3912 If the optional argument FRAME is given, report on face FACE in that frame.
3913 If FRAME is t, report on the defaults for face FACE (for new frames).
3914 The font default for a face is either nil, or a list
3915 of the form (bold), (italic) or (bold italic).
3916 If FRAME is omitted or nil, use the selected frame. And, in this case,
3917 if the optional third argument CHARACTER is given,
3918 return the font name used for CHARACTER. */)
3919 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3923 Lisp_Object result
= Qnil
;
3924 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3926 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3927 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3928 result
= Fcons (Qbold
, result
);
3930 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3931 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3932 result
= Fcons (Qitalic
, result
);
3938 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3939 int face_id
= lookup_named_face (f
, face
, 1);
3940 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3944 #ifdef HAVE_WINDOW_SYSTEM
3945 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3947 CHECK_CHARACTER (character
);
3948 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3949 fface
= FACE_FROM_ID (f
, face_id
);
3952 ? fface
->font
->props
[FONT_NAME_INDEX
]
3954 #else /* !HAVE_WINDOW_SYSTEM */
3955 return build_string (FRAME_MSDOS_P (f
)
3957 : FRAME_W32_P (f
) ? "w32term"
3964 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3965 all attributes are `equal'. Tries to be fast because this function
3966 is called quite often. */
3969 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3971 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3972 and the other is specified. */
3973 if (XTYPE (v1
) != XTYPE (v2
))
3982 if (SBYTES (v1
) != SBYTES (v2
))
3985 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3992 return !NILP (Fequal (v1
, v2
));
3997 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
3998 all attributes are `equal'. Tries to be fast because this function
3999 is called quite often. */
4002 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
4006 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4007 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
4013 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4014 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4015 doc
: /* True if FACE1 and FACE2 are equal.
4016 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
4017 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
4018 If FRAME is omitted or nil, use the selected frame. */)
4019 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
4023 Lisp_Object lface1
, lface2
;
4028 /* Don't use check_x_frame here because this function is called
4029 before X frames exist. At that time, if FRAME is nil,
4030 selected_frame will be used which is the frame dumped with
4031 Emacs. That frame is not an X frame. */
4032 f
= frame_or_selected_frame (frame
, 2);
4034 lface1
= lface_from_face_name (f
, face1
, 1);
4035 lface2
= lface_from_face_name (f
, face2
, 1);
4036 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4037 XVECTOR (lface2
)->contents
);
4038 return equal_p
? Qt
: Qnil
;
4042 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4043 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4044 doc
: /* True if FACE has no attribute specified.
4045 If the optional argument FRAME is given, report on face FACE in that frame.
4046 If FRAME is t, report on the defaults for face FACE (for new frames).
4047 If FRAME is omitted or nil, use the selected frame. */)
4048 (Lisp_Object face
, Lisp_Object frame
)
4055 frame
= selected_frame
;
4056 CHECK_LIVE_FRAME (frame
);
4060 lface
= lface_from_face_name (NULL
, face
, 1);
4062 lface
= lface_from_face_name (f
, face
, 1);
4064 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4065 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4068 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4072 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4074 doc
: /* Return an alist of frame-local faces defined on FRAME.
4075 For internal use only. */)
4078 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4079 return f
->face_alist
;
4083 /* Return a hash code for Lisp string STRING with case ignored. Used
4084 below in computing a hash value for a Lisp face. */
4086 static inline unsigned
4087 hash_string_case_insensitive (Lisp_Object string
)
4089 const unsigned char *s
;
4091 eassert (STRINGP (string
));
4092 for (s
= SDATA (string
); *s
; ++s
)
4093 hash
= (hash
<< 1) ^ tolower (*s
);
4098 /* Return a hash code for face attribute vector V. */
4100 static inline unsigned
4101 lface_hash (Lisp_Object
*v
)
4103 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4104 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4105 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4106 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4107 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4108 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4109 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4110 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4114 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4115 considering charsets/registries). They do if they specify the same
4116 family, point size, weight, width, slant, and font. Both
4117 LFACE1 and LFACE2 must be fully-specified. */
4120 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4122 eassert (lface_fully_specified_p (lface1
)
4123 && lface_fully_specified_p (lface2
));
4124 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4125 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4126 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4127 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4128 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4129 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4130 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4131 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4132 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4133 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4134 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4135 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4136 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4137 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4143 /***********************************************************************
4145 ***********************************************************************/
4147 /* Allocate and return a new realized face for Lisp face attribute
4150 static struct face
*
4151 make_realized_face (Lisp_Object
*attr
)
4153 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4154 memset (face
, 0, sizeof *face
);
4155 face
->ascii_face
= face
;
4156 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4161 /* Free realized face FACE, including its X resources. FACE may
4165 free_realized_face (struct frame
*f
, struct face
*face
)
4169 #ifdef HAVE_WINDOW_SYSTEM
4170 if (FRAME_WINDOW_P (f
))
4172 /* Free fontset of FACE if it is ASCII face. */
4173 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4174 free_face_fontset (f
, face
);
4179 font_done_for_face (f
, face
);
4180 x_free_gc (f
, face
->gc
);
4185 free_face_colors (f
, face
);
4186 x_destroy_bitmap (f
, face
->stipple
);
4188 #endif /* HAVE_WINDOW_SYSTEM */
4195 /* Prepare face FACE for subsequent display on frame F. This
4196 allocated GCs if they haven't been allocated yet or have been freed
4197 by clearing the face cache. */
4200 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4202 #ifdef HAVE_WINDOW_SYSTEM
4203 eassert (FRAME_WINDOW_P (f
));
4208 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4210 xgcv
.foreground
= face
->foreground
;
4211 xgcv
.background
= face
->background
;
4212 #ifdef HAVE_X_WINDOWS
4213 xgcv
.graphics_exposures
= False
;
4217 #ifdef HAVE_X_WINDOWS
4220 xgcv
.fill_style
= FillOpaqueStippled
;
4221 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4222 mask
|= GCFillStyle
| GCStipple
;
4225 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4227 font_prepare_for_face (f
, face
);
4230 #endif /* HAVE_WINDOW_SYSTEM */
4234 /* Returns the `distance' between the colors X and Y. */
4237 color_distance (XColor
*x
, XColor
*y
)
4239 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4240 Quoting from that paper:
4242 This formula has results that are very close to L*u*v* (with the
4243 modified lightness curve) and, more importantly, it is a more even
4244 algorithm: it does not have a range of colors where it suddenly
4245 gives far from optimal results.
4247 See <http://www.compuphase.com/cmetric.htm> for more info. */
4249 long r
= (x
->red
- y
->red
) >> 8;
4250 long g
= (x
->green
- y
->green
) >> 8;
4251 long b
= (x
->blue
- y
->blue
) >> 8;
4252 long r_mean
= (x
->red
+ y
->red
) >> 9;
4255 (((512 + r_mean
) * r
* r
) >> 8)
4257 + (((767 - r_mean
) * b
* b
) >> 8);
4261 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4262 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4263 COLOR1 and COLOR2 may be either strings containing the color name,
4264 or lists of the form (RED GREEN BLUE).
4265 If FRAME is unspecified or nil, the current frame is used. */)
4266 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4269 XColor cdef1
, cdef2
;
4272 frame
= selected_frame
;
4273 CHECK_LIVE_FRAME (frame
);
4276 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4277 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4278 signal_error ("Invalid color", color1
);
4279 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4280 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4281 signal_error ("Invalid color", color2
);
4283 return make_number (color_distance (&cdef1
, &cdef2
));
4287 /***********************************************************************
4289 ***********************************************************************/
4291 /* Return a new face cache for frame F. */
4293 static struct face_cache
*
4294 make_face_cache (struct frame
*f
)
4296 struct face_cache
*c
;
4299 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4300 memset (c
, 0, sizeof *c
);
4301 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4302 c
->buckets
= (struct face
**) xmalloc (size
);
4303 memset (c
->buckets
, 0, size
);
4305 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4307 c
->menu_face_changed_p
= menu_face_changed_default
;
4312 /* Clear out all graphics contexts for all realized faces, except for
4313 the basic faces. This should be done from time to time just to avoid
4314 keeping too many graphics contexts that are no longer needed. */
4317 clear_face_gcs (struct face_cache
*c
)
4319 if (c
&& FRAME_WINDOW_P (c
->f
))
4321 #ifdef HAVE_WINDOW_SYSTEM
4323 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4325 struct face
*face
= c
->faces_by_id
[i
];
4326 if (face
&& face
->gc
)
4330 font_done_for_face (c
->f
, face
);
4331 x_free_gc (c
->f
, face
->gc
);
4336 #endif /* HAVE_WINDOW_SYSTEM */
4341 /* Free all realized faces in face cache C, including basic faces.
4342 C may be null. If faces are freed, make sure the frame's current
4343 matrix is marked invalid, so that a display caused by an expose
4344 event doesn't try to use faces we destroyed. */
4347 free_realized_faces (struct face_cache
*c
)
4352 struct frame
*f
= c
->f
;
4354 /* We must block input here because we can't process X events
4355 safely while only some faces are freed, or when the frame's
4356 current matrix still references freed faces. */
4359 for (i
= 0; i
< c
->used
; ++i
)
4361 free_realized_face (f
, c
->faces_by_id
[i
]);
4362 c
->faces_by_id
[i
] = NULL
;
4366 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4367 memset (c
->buckets
, 0, size
);
4369 /* Must do a thorough redisplay the next time. Mark current
4370 matrices as invalid because they will reference faces freed
4371 above. This function is also called when a frame is
4372 destroyed. In this case, the root window of F is nil. */
4373 if (WINDOWP (f
->root_window
))
4375 clear_current_matrices (f
);
4376 ++windows_or_buffers_changed
;
4384 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4385 This is done after attributes of a named face have been changed,
4386 because we can't tell which realized faces depend on that face. */
4389 free_all_realized_faces (Lisp_Object frame
)
4394 FOR_EACH_FRAME (rest
, frame
)
4395 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4398 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4402 /* Free face cache C and faces in it, including their X resources. */
4405 free_face_cache (struct face_cache
*c
)
4409 free_realized_faces (c
);
4411 xfree (c
->faces_by_id
);
4417 /* Cache realized face FACE in face cache C. HASH is the hash value
4418 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4419 FACE), insert the new face to the beginning of the collision list
4420 of the face hash table of C. Otherwise, add the new face to the
4421 end of the collision list. This way, lookup_face can quickly find
4422 that a requested face is not cached. */
4425 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4427 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4431 if (face
->ascii_face
!= face
)
4433 struct face
*last
= c
->buckets
[i
];
4444 c
->buckets
[i
] = face
;
4445 face
->prev
= face
->next
= NULL
;
4451 face
->next
= c
->buckets
[i
];
4453 face
->next
->prev
= face
;
4454 c
->buckets
[i
] = face
;
4457 /* Find a free slot in C->faces_by_id and use the index of the free
4458 slot as FACE->id. */
4459 for (i
= 0; i
< c
->used
; ++i
)
4460 if (c
->faces_by_id
[i
] == NULL
)
4465 /* Check that FACE got a unique id. */
4470 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4471 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4477 #endif /* GLYPH_DEBUG */
4479 /* Maybe enlarge C->faces_by_id. */
4482 if (c
->used
== c
->size
)
4483 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4484 sizeof *c
->faces_by_id
);
4488 c
->faces_by_id
[i
] = face
;
4492 /* Remove face FACE from cache C. */
4495 uncache_face (struct face_cache
*c
, struct face
*face
)
4497 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4500 face
->prev
->next
= face
->next
;
4502 c
->buckets
[i
] = face
->next
;
4505 face
->next
->prev
= face
->prev
;
4507 c
->faces_by_id
[face
->id
] = NULL
;
4508 if (face
->id
== c
->used
)
4513 /* Look up a realized face with face attributes ATTR in the face cache
4514 of frame F. The face will be used to display ASCII characters.
4515 Value is the ID of the face found. If no suitable face is found,
4516 realize a new one. */
4519 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4521 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4526 eassert (cache
!= NULL
);
4527 check_lface_attrs (attr
);
4529 /* Look up ATTR in the face cache. */
4530 hash
= lface_hash (attr
);
4531 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4533 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4535 if (face
->ascii_face
!= face
)
4537 /* There's no more ASCII face. */
4541 if (face
->hash
== hash
4542 && lface_equal_p (face
->lface
, attr
))
4546 /* If not found, realize a new face. */
4548 face
= realize_face (cache
, attr
, -1);
4551 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4552 #endif /* GLYPH_DEBUG */
4557 #ifdef HAVE_WINDOW_SYSTEM
4558 /* Look up a realized face that has the same attributes as BASE_FACE
4559 except for the font in the face cache of frame F. If FONT-OBJECT
4560 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4561 the face has no font. Value is the ID of the face found. If no
4562 suitable face is found, realize a new one. */
4565 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4567 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4572 eassert (cache
!= NULL
);
4573 base_face
= base_face
->ascii_face
;
4574 hash
= lface_hash (base_face
->lface
);
4575 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4577 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4579 if (face
->ascii_face
== face
)
4581 if (face
->ascii_face
== base_face
4582 && face
->font
== (NILP (font_object
) ? NULL
4583 : XFONT_OBJECT (font_object
))
4584 && lface_equal_p (face
->lface
, base_face
->lface
))
4588 /* If not found, realize a new face. */
4589 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4592 #endif /* HAVE_WINDOW_SYSTEM */
4594 /* Return the face id of the realized face for named face SYMBOL on
4595 frame F suitable for displaying ASCII characters. Value is -1 if
4596 the face couldn't be determined, which might happen if the default
4597 face isn't realized and cannot be realized. */
4600 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4602 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4603 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4604 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4606 if (default_face
== NULL
)
4608 if (!realize_basic_faces (f
))
4610 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4611 if (default_face
== NULL
)
4612 abort (); /* realize_basic_faces must have set it up */
4615 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4618 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4619 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4621 return lookup_face (f
, attrs
);
4625 /* Return the display face-id of the basic face whose canonical face-id
4626 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4627 basic face has bee remapped via Vface_remapping_alist. This function is
4628 conservative: if something goes wrong, it will simply return FACE_ID
4629 rather than signal an error. */
4632 lookup_basic_face (struct frame
*f
, int face_id
)
4634 Lisp_Object name
, mapping
;
4635 int remapped_face_id
;
4637 if (NILP (Vface_remapping_alist
))
4638 return face_id
; /* Nothing to do. */
4642 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4643 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4644 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4645 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4646 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4647 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4648 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4649 case BORDER_FACE_ID
: name
= Qborder
; break;
4650 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4651 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4652 case MENU_FACE_ID
: name
= Qmenu
; break;
4655 abort (); /* the caller is supposed to pass us a basic face id */
4658 /* Do a quick scan through Vface_remapping_alist, and return immediately
4659 if there is no remapping for face NAME. This is just an optimization
4660 for the very common no-remapping case. */
4661 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4663 return face_id
; /* Give up. */
4665 /* If there is a remapping entry, lookup the face using NAME, which will
4666 handle the remapping too. */
4667 remapped_face_id
= lookup_named_face (f
, name
, 0);
4668 if (remapped_face_id
< 0)
4669 return face_id
; /* Give up. */
4671 return remapped_face_id
;
4675 /* Return a face for charset ASCII that is like the face with id
4676 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4677 STEPS < 0 means larger. Value is the id of the face. */
4680 smaller_face (struct frame
*f
, int face_id
, int steps
)
4682 #ifdef HAVE_WINDOW_SYSTEM
4684 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4685 int pt
, last_pt
, last_height
;
4688 struct face
*new_face
;
4690 /* If not called for an X frame, just return the original face. */
4691 if (FRAME_TERMCAP_P (f
))
4694 /* Try in increments of 1/2 pt. */
4695 delta
= steps
< 0 ? 5 : -5;
4696 steps
= eabs (steps
);
4698 face
= FACE_FROM_ID (f
, face_id
);
4699 memcpy (attrs
, face
->lface
, sizeof attrs
);
4700 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4701 new_face_id
= face_id
;
4702 last_height
= FONT_HEIGHT (face
->font
);
4706 /* Give up if we cannot find a font within 10pt. */
4707 && eabs (last_pt
- pt
) < 100)
4709 /* Look up a face for a slightly smaller/larger font. */
4711 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4712 new_face_id
= lookup_face (f
, attrs
);
4713 new_face
= FACE_FROM_ID (f
, new_face_id
);
4715 /* If height changes, count that as one step. */
4716 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4717 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4720 last_height
= FONT_HEIGHT (new_face
->font
);
4727 #else /* not HAVE_WINDOW_SYSTEM */
4731 #endif /* not HAVE_WINDOW_SYSTEM */
4735 /* Return a face for charset ASCII that is like the face with id
4736 FACE_ID on frame F, but has height HEIGHT. */
4739 face_with_height (struct frame
*f
, int face_id
, int height
)
4741 #ifdef HAVE_WINDOW_SYSTEM
4743 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4745 if (FRAME_TERMCAP_P (f
)
4749 face
= FACE_FROM_ID (f
, face_id
);
4750 memcpy (attrs
, face
->lface
, sizeof attrs
);
4751 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4752 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4753 face_id
= lookup_face (f
, attrs
);
4754 #endif /* HAVE_WINDOW_SYSTEM */
4760 /* Return the face id of the realized face for named face SYMBOL on
4761 frame F suitable for displaying ASCII characters, and use
4762 attributes of the face FACE_ID for attributes that aren't
4763 completely specified by SYMBOL. This is like lookup_named_face,
4764 except that the default attributes come from FACE_ID, not from the
4765 default face. FACE_ID is assumed to be already realized. */
4768 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4771 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4772 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4773 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4778 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4781 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4782 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4783 return lookup_face (f
, attrs
);
4786 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4787 Sface_attributes_as_vector
, 1, 1, 0,
4788 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4792 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4794 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4801 /***********************************************************************
4802 Face capability testing
4803 ***********************************************************************/
4806 /* If the distance (as returned by color_distance) between two colors is
4807 less than this, then they are considered the same, for determining
4808 whether a color is supported or not. The range of values is 0-65535. */
4810 #define TTY_SAME_COLOR_THRESHOLD 10000
4812 #ifdef HAVE_WINDOW_SYSTEM
4814 /* Return non-zero if all the face attributes in ATTRS are supported
4815 on the window-system frame F.
4817 The definition of `supported' is somewhat heuristic, but basically means
4818 that a face containing all the attributes in ATTRS, when merged with the
4819 default face for display, can be represented in a way that's
4821 \(1) different in appearance than the default face, and
4822 \(2) `close in spirit' to what the attributes specify, if not exact. */
4825 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4826 struct face
*def_face
)
4828 Lisp_Object
*def_attrs
= def_face
->lface
;
4830 /* Check that other specified attributes are different that the default
4832 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4833 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4834 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4835 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4836 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4837 def_attrs
[LFACE_INVERSE_INDEX
]))
4838 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4839 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4840 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4841 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4842 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4843 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4844 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4845 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4846 def_attrs
[LFACE_STIPPLE_INDEX
]))
4847 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4848 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4849 def_attrs
[LFACE_OVERLINE_INDEX
]))
4850 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4851 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4852 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4853 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4854 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4855 def_attrs
[LFACE_BOX_INDEX
])))
4858 /* Check font-related attributes, as those are the most commonly
4859 "unsupported" on a window-system (because of missing fonts). */
4860 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4861 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4862 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4863 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4864 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4865 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4869 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4872 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4874 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4876 face_id
= lookup_face (f
, merged_attrs
);
4877 face
= FACE_FROM_ID (f
, face_id
);
4880 error ("Cannot make face");
4882 /* If the font is the same, or no font is found, then not
4884 if (face
->font
== def_face
->font
4887 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4888 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4892 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4893 || face
->font
->driver
->case_sensitive
)
4895 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4896 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4897 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4898 s2
, make_number (0), Qnil
, Qt
), Qt
))
4904 /* Everything checks out, this face is supported. */
4908 #endif /* HAVE_WINDOW_SYSTEM */
4910 /* Return non-zero if all the face attributes in ATTRS are supported
4913 The definition of `supported' is somewhat heuristic, but basically means
4914 that a face containing all the attributes in ATTRS, when merged
4915 with the default face for display, can be represented in a way that's
4917 \(1) different in appearance than the default face, and
4918 \(2) `close in spirit' to what the attributes specify, if not exact.
4920 Point (2) implies that a `:weight black' attribute will be satisfied
4921 by any terminal that can display bold, and a `:foreground "yellow"' as
4922 long as the terminal can display a yellowish color, but `:slant italic'
4923 will _not_ be satisfied by the tty display code's automatic
4924 substitution of a `dim' face for italic. */
4927 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4928 struct face
*def_face
)
4931 Lisp_Object val
, fg
, bg
;
4932 XColor fg_tty_color
, fg_std_color
;
4933 XColor bg_tty_color
, bg_std_color
;
4934 unsigned test_caps
= 0;
4935 Lisp_Object
*def_attrs
= def_face
->lface
;
4937 /* First check some easy-to-check stuff; ttys support none of the
4938 following attributes, so we can just return false if any are requested
4939 (even if `nominal' values are specified, we should still return false,
4940 as that will be the same value that the default face uses). We
4941 consider :slant unsupportable on ttys, even though the face code
4942 actually `fakes' them using a dim attribute if possible. This is
4943 because the faked result is too different from what the face
4945 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4946 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4947 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4948 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4949 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4950 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4951 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4952 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4955 /* Test for terminal `capabilities' (non-color character attributes). */
4957 /* font weight (bold/dim) */
4958 val
= attrs
[LFACE_WEIGHT_INDEX
];
4959 if (!UNSPECIFIEDP (val
)
4960 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4962 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4966 if (def_weight
> 100)
4967 return 0; /* same as default */
4968 test_caps
= TTY_CAP_BOLD
;
4970 else if (weight
< 100)
4972 if (def_weight
< 100)
4973 return 0; /* same as default */
4974 test_caps
= TTY_CAP_DIM
;
4976 else if (def_weight
== 100)
4977 return 0; /* same as default */
4981 val
= attrs
[LFACE_SLANT_INDEX
];
4982 if (!UNSPECIFIEDP (val
)
4983 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4985 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4986 if (slant
== 100 || slant
== def_slant
)
4987 return 0; /* same as default */
4989 test_caps
|= TTY_CAP_ITALIC
;
4993 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4994 if (!UNSPECIFIEDP (val
))
4997 return 0; /* ttys can't use colored underlines */
4998 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4999 return 0; /* same as default */
5001 test_caps
|= TTY_CAP_UNDERLINE
;
5005 val
= attrs
[LFACE_INVERSE_INDEX
];
5006 if (!UNSPECIFIEDP (val
))
5008 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
5009 return 0; /* same as default */
5011 test_caps
|= TTY_CAP_INVERSE
;
5015 /* Color testing. */
5017 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5018 we use them when calling `tty_capable_p' below, even if the face
5019 specifies no colors. */
5020 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5021 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5023 /* Check if foreground color is close enough. */
5024 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5027 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
5029 if (face_attr_equal_p (fg
, def_fg
))
5030 return 0; /* same as default */
5031 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5032 return 0; /* not a valid color */
5033 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5034 > TTY_SAME_COLOR_THRESHOLD
)
5035 return 0; /* displayed color is too different */
5037 /* Make sure the color is really different than the default. */
5039 XColor def_fg_color
;
5040 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5041 && (color_distance (&fg_tty_color
, &def_fg_color
)
5042 <= TTY_SAME_COLOR_THRESHOLD
))
5047 /* Check if background color is close enough. */
5048 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5051 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5053 if (face_attr_equal_p (bg
, def_bg
))
5054 return 0; /* same as default */
5055 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5056 return 0; /* not a valid color */
5057 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5058 > TTY_SAME_COLOR_THRESHOLD
)
5059 return 0; /* displayed color is too different */
5061 /* Make sure the color is really different than the default. */
5063 XColor def_bg_color
;
5064 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5065 && (color_distance (&bg_tty_color
, &def_bg_color
)
5066 <= TTY_SAME_COLOR_THRESHOLD
))
5071 /* If both foreground and background are requested, see if the
5072 distance between them is OK. We just check to see if the distance
5073 between the tty's foreground and background is close enough to the
5074 distance between the standard foreground and background. */
5075 if (STRINGP (fg
) && STRINGP (bg
))
5078 = (color_distance (&fg_std_color
, &bg_std_color
)
5079 - color_distance (&fg_tty_color
, &bg_tty_color
));
5080 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5081 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5086 /* See if the capabilities we selected above are supported, with the
5088 if (test_caps
!= 0 &&
5089 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
5090 bg_tty_color
.pixel
))
5094 /* Hmmm, everything checks out, this terminal must support this face. */
5099 DEFUN ("display-supports-face-attributes-p",
5100 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5102 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5103 The optional argument DISPLAY can be a display name, a frame, or
5104 nil (meaning the selected frame's display).
5106 The definition of `supported' is somewhat heuristic, but basically means
5107 that a face containing all the attributes in ATTRIBUTES, when merged
5108 with the default face for display, can be represented in a way that's
5110 \(1) different in appearance than the default face, and
5111 \(2) `close in spirit' to what the attributes specify, if not exact.
5113 Point (2) implies that a `:weight black' attribute will be satisfied by
5114 any display that can display bold, and a `:foreground \"yellow\"' as long
5115 as it can display a yellowish color, but `:slant italic' will _not_ be
5116 satisfied by the tty display code's automatic substitution of a `dim'
5117 face for italic. */)
5118 (Lisp_Object attributes
, Lisp_Object display
)
5120 int supports
= 0, i
;
5123 struct face
*def_face
;
5124 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5126 if (noninteractive
|| !initialized
)
5127 /* We may not be able to access low-level face information in batch
5128 mode, or before being dumped, and this function is not going to
5129 be very useful in those cases anyway, so just give up. */
5133 frame
= selected_frame
;
5134 else if (FRAMEP (display
))
5138 /* Find any frame on DISPLAY. */
5139 Lisp_Object fl_tail
;
5142 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5144 frame
= XCAR (fl_tail
);
5145 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5146 XFRAME (frame
)->param_alist
)),
5152 CHECK_LIVE_FRAME (frame
);
5155 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5156 attrs
[i
] = Qunspecified
;
5157 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5159 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5160 if (def_face
== NULL
)
5162 if (! realize_basic_faces (f
))
5163 error ("Cannot realize default face");
5164 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5165 if (def_face
== NULL
)
5166 abort (); /* realize_basic_faces must have set it up */
5169 /* Dispatch to the appropriate handler. */
5170 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5171 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5172 #ifdef HAVE_WINDOW_SYSTEM
5174 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5177 return supports
? Qt
: Qnil
;
5181 /***********************************************************************
5183 ***********************************************************************/
5185 DEFUN ("internal-set-font-selection-order",
5186 Finternal_set_font_selection_order
,
5187 Sinternal_set_font_selection_order
, 1, 1, 0,
5188 doc
: /* Set font selection order for face font selection to ORDER.
5189 ORDER must be a list of length 4 containing the symbols `:width',
5190 `:height', `:weight', and `:slant'. Face attributes appearing
5191 first in ORDER are matched first, e.g. if `:height' appears before
5192 `:weight' in ORDER, font selection first tries to find a font with
5193 a suitable height, and then tries to match the font weight.
5199 int indices
[DIM (font_sort_order
)];
5202 memset (indices
, 0, sizeof indices
);
5206 CONSP (list
) && i
< DIM (indices
);
5207 list
= XCDR (list
), ++i
)
5209 Lisp_Object attr
= XCAR (list
);
5212 if (EQ (attr
, QCwidth
))
5214 else if (EQ (attr
, QCheight
))
5215 xlfd
= XLFD_POINT_SIZE
;
5216 else if (EQ (attr
, QCweight
))
5218 else if (EQ (attr
, QCslant
))
5223 if (indices
[i
] != 0)
5228 if (!NILP (list
) || i
!= DIM (indices
))
5229 signal_error ("Invalid font sort order", order
);
5230 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5231 if (indices
[i
] == 0)
5232 signal_error ("Invalid font sort order", order
);
5234 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5236 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5237 free_all_realized_faces (Qnil
);
5240 font_update_sort_order (font_sort_order
);
5246 DEFUN ("internal-set-alternative-font-family-alist",
5247 Finternal_set_alternative_font_family_alist
,
5248 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5249 doc
: /* Define alternative font families to try in face font selection.
5250 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5251 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5252 be found. Value is ALIST. */)
5255 Lisp_Object entry
, tail
, tail2
;
5258 alist
= Fcopy_sequence (alist
);
5259 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5261 entry
= XCAR (tail
);
5263 entry
= Fcopy_sequence (entry
);
5264 XSETCAR (tail
, entry
);
5265 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5266 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5269 Vface_alternative_font_family_alist
= alist
;
5270 free_all_realized_faces (Qnil
);
5275 DEFUN ("internal-set-alternative-font-registry-alist",
5276 Finternal_set_alternative_font_registry_alist
,
5277 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5278 doc
: /* Define alternative font registries to try in face font selection.
5279 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5280 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5281 be found. Value is ALIST. */)
5284 Lisp_Object entry
, tail
, tail2
;
5287 alist
= Fcopy_sequence (alist
);
5288 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5290 entry
= XCAR (tail
);
5292 entry
= Fcopy_sequence (entry
);
5293 XSETCAR (tail
, entry
);
5294 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5295 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5297 Vface_alternative_font_registry_alist
= alist
;
5298 free_all_realized_faces (Qnil
);
5303 #ifdef HAVE_WINDOW_SYSTEM
5305 /* Return the fontset id of the base fontset name or alias name given
5306 by the fontset attribute of ATTRS. Value is -1 if the fontset
5307 attribute of ATTRS doesn't name a fontset. */
5310 face_fontset (Lisp_Object
*attrs
)
5314 name
= attrs
[LFACE_FONTSET_INDEX
];
5315 if (!STRINGP (name
))
5317 return fs_query_fontset (name
, 0);
5320 #endif /* HAVE_WINDOW_SYSTEM */
5324 /***********************************************************************
5326 ***********************************************************************/
5328 /* Realize basic faces on frame F. Value is zero if frame parameters
5329 of F don't contain enough information needed to realize the default
5333 realize_basic_faces (struct frame
*f
)
5336 ptrdiff_t count
= SPECPDL_INDEX ();
5338 /* Block input here so that we won't be surprised by an X expose
5339 event, for instance, without having the faces set up. */
5341 specbind (Qscalable_fonts_allowed
, Qt
);
5343 if (realize_default_face (f
))
5345 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5346 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5347 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5348 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5349 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5350 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5351 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5352 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5353 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5354 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5355 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5357 /* Reflect changes in the `menu' face in menu bars. */
5358 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5360 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5361 #ifdef USE_X_TOOLKIT
5362 if (FRAME_WINDOW_P (f
))
5363 x_update_menu_appearance (f
);
5370 unbind_to (count
, Qnil
);
5376 /* Realize the default face on frame F. If the face is not fully
5377 specified, make it fully-specified. Attributes of the default face
5378 that are not explicitly specified are taken from frame parameters. */
5381 realize_default_face (struct frame
*f
)
5383 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5385 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5388 /* If the `default' face is not yet known, create it. */
5389 lface
= lface_from_face_name (f
, Qdefault
, 0);
5393 XSETFRAME (frame
, f
);
5394 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5397 #ifdef HAVE_WINDOW_SYSTEM
5398 if (FRAME_WINDOW_P (f
))
5400 Lisp_Object font_object
;
5402 XSETFONT (font_object
, FRAME_FONT (f
));
5403 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5404 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5405 f
->default_face_done_p
= 1;
5407 #endif /* HAVE_WINDOW_SYSTEM */
5409 if (!FRAME_WINDOW_P (f
))
5411 LFACE_FAMILY (lface
) = build_string ("default");
5412 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5413 LFACE_SWIDTH (lface
) = Qnormal
;
5414 LFACE_HEIGHT (lface
) = make_number (1);
5415 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5416 LFACE_WEIGHT (lface
) = Qnormal
;
5417 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5418 LFACE_SLANT (lface
) = Qnormal
;
5419 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5420 LFACE_FONTSET (lface
) = Qnil
;
5423 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5424 LFACE_UNDERLINE (lface
) = Qnil
;
5426 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5427 LFACE_OVERLINE (lface
) = Qnil
;
5429 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5430 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5432 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5433 LFACE_BOX (lface
) = Qnil
;
5435 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5436 LFACE_INVERSE (lface
) = Qnil
;
5438 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5440 /* This function is called so early that colors are not yet
5441 set in the frame parameter list. */
5442 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5444 if (CONSP (color
) && STRINGP (XCDR (color
)))
5445 LFACE_FOREGROUND (lface
) = XCDR (color
);
5446 else if (FRAME_WINDOW_P (f
))
5448 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5449 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5454 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5456 /* This function is called so early that colors are not yet
5457 set in the frame parameter list. */
5458 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5459 if (CONSP (color
) && STRINGP (XCDR (color
)))
5460 LFACE_BACKGROUND (lface
) = XCDR (color
);
5461 else if (FRAME_WINDOW_P (f
))
5463 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5464 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5469 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5470 LFACE_STIPPLE (lface
) = Qnil
;
5472 /* Realize the face; it must be fully-specified now. */
5473 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5474 check_lface (lface
);
5475 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5476 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5478 #ifdef HAVE_WINDOW_SYSTEM
5479 #ifdef HAVE_X_WINDOWS
5480 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5482 /* This can happen when making a frame on a display that does
5483 not support the default font. */
5487 /* Otherwise, the font specified for the frame was not
5488 acceptable as a font for the default face (perhaps because
5489 auto-scaled fonts are rejected), so we must adjust the frame
5491 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5493 #endif /* HAVE_X_WINDOWS */
5494 #endif /* HAVE_WINDOW_SYSTEM */
5499 /* Realize basic faces other than the default face in face cache C.
5500 SYMBOL is the face name, ID is the face id the realized face must
5501 have. The default face must have been realized already. */
5504 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5506 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5507 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5508 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5509 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5511 /* The default face must exist and be fully specified. */
5512 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5513 check_lface_attrs (attrs
);
5514 eassert (lface_fully_specified_p (attrs
));
5516 /* If SYMBOL isn't know as a face, create it. */
5520 XSETFRAME (frame
, f
);
5521 lface
= Finternal_make_lisp_face (symbol
, frame
);
5524 /* Merge SYMBOL's face with the default face. */
5525 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5526 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5528 /* Realize the face. */
5529 realize_face (c
, attrs
, id
);
5533 /* Realize the fully-specified face with attributes ATTRS in face
5534 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5535 non-negative, it is an ID of face to remove before caching the new
5536 face. Value is a pointer to the newly created realized face. */
5538 static struct face
*
5539 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5543 /* LFACE must be fully specified. */
5544 eassert (cache
!= NULL
);
5545 check_lface_attrs (attrs
);
5547 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5549 /* Remove the former face. */
5550 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5551 uncache_face (cache
, former_face
);
5552 free_realized_face (cache
->f
, former_face
);
5553 SET_FRAME_GARBAGED (cache
->f
);
5556 if (FRAME_WINDOW_P (cache
->f
))
5557 face
= realize_x_face (cache
, attrs
);
5558 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5559 face
= realize_tty_face (cache
, attrs
);
5560 else if (FRAME_INITIAL_P (cache
->f
))
5562 /* Create a dummy face. */
5563 face
= make_realized_face (attrs
);
5568 /* Insert the new face. */
5569 cache_face (cache
, face
, lface_hash (attrs
));
5574 #ifdef HAVE_WINDOW_SYSTEM
5575 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5576 same attributes as BASE_FACE except for the font on frame F.
5577 FONT-OBJECT may be nil, in which case, realized a face of
5580 static struct face
*
5581 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5582 struct face
*base_face
)
5584 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5587 face
= (struct face
*) xmalloc (sizeof *face
);
5592 = (! NILP (font_object
)
5593 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5594 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5596 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5597 face
->colors_copied_bitwise_p
= 1;
5598 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5601 cache_face (cache
, face
, face
->hash
);
5605 #endif /* HAVE_WINDOW_SYSTEM */
5608 /* Realize the fully-specified face with attributes ATTRS in face
5609 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5610 the new face doesn't share font with the default face, a fontname
5611 is allocated from the heap and set in `font_name' of the new face,
5612 but it is not yet loaded here. Value is a pointer to the newly
5613 created realized face. */
5615 static struct face
*
5616 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5618 struct face
*face
= NULL
;
5619 #ifdef HAVE_WINDOW_SYSTEM
5620 struct face
*default_face
;
5622 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5624 eassert (FRAME_WINDOW_P (cache
->f
));
5626 /* Allocate a new realized face. */
5627 face
= make_realized_face (attrs
);
5628 face
->ascii_face
= face
;
5632 /* Determine the font to use. Most of the time, the font will be
5633 the same as the font of the default face, so try that first. */
5634 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5636 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5638 face
->font
= default_face
->font
;
5640 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5644 /* If the face attribute ATTRS specifies a fontset, use it as
5645 the base of a new realized fontset. Otherwise, use the same
5646 base fontset as of the default face. The base determines
5647 registry and encoding of a font. It may also determine
5648 foundry and family. The other fields of font name pattern
5649 are constructed from ATTRS. */
5650 int fontset
= face_fontset (attrs
);
5652 /* If we are realizing the default face, ATTRS should specify a
5653 fontset. In other words, if FONTSET is -1, we are not
5654 realizing the default face, thus the default face should have
5655 already been realized. */
5659 fontset
= default_face
->fontset
;
5663 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5664 attrs
[LFACE_FONT_INDEX
]
5665 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5666 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5668 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5669 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5679 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5680 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5681 face
->overstrike
= 1;
5683 /* Load colors, and set remaining attributes. */
5685 load_face_colors (f
, face
, attrs
);
5688 box
= attrs
[LFACE_BOX_INDEX
];
5691 /* A simple box of line width 1 drawn in color given by
5693 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5695 face
->box
= FACE_SIMPLE_BOX
;
5696 face
->box_line_width
= 1;
5698 else if (INTEGERP (box
))
5700 /* Simple box of specified line width in foreground color of the
5702 eassert (XINT (box
) != 0);
5703 face
->box
= FACE_SIMPLE_BOX
;
5704 face
->box_line_width
= XINT (box
);
5705 face
->box_color
= face
->foreground
;
5706 face
->box_color_defaulted_p
= 1;
5708 else if (CONSP (box
))
5710 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5711 being one of `raised' or `sunken'. */
5712 face
->box
= FACE_SIMPLE_BOX
;
5713 face
->box_color
= face
->foreground
;
5714 face
->box_color_defaulted_p
= 1;
5715 face
->box_line_width
= 1;
5719 Lisp_Object keyword
, value
;
5721 keyword
= XCAR (box
);
5729 if (EQ (keyword
, QCline_width
))
5731 if (INTEGERP (value
) && XINT (value
) != 0)
5732 face
->box_line_width
= XINT (value
);
5734 else if (EQ (keyword
, QCcolor
))
5736 if (STRINGP (value
))
5738 face
->box_color
= load_color (f
, face
, value
,
5740 face
->use_box_color_for_shadows_p
= 1;
5743 else if (EQ (keyword
, QCstyle
))
5745 if (EQ (value
, Qreleased_button
))
5746 face
->box
= FACE_RAISED_BOX
;
5747 else if (EQ (value
, Qpressed_button
))
5748 face
->box
= FACE_SUNKEN_BOX
;
5753 /* Text underline, overline, strike-through. */
5755 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5756 if (EQ (underline
, Qt
))
5758 /* Use default color (same as foreground color). */
5759 face
->underline_p
= 1;
5760 face
->underline_type
= FACE_UNDER_LINE
;
5761 face
->underline_defaulted_p
= 1;
5762 face
->underline_color
= 0;
5764 else if (STRINGP (underline
))
5766 /* Use specified color. */
5767 face
->underline_p
= 1;
5768 face
->underline_type
= FACE_UNDER_LINE
;
5769 face
->underline_defaulted_p
= 0;
5770 face
->underline_color
5771 = load_color (f
, face
, underline
,
5772 LFACE_UNDERLINE_INDEX
);
5774 else if (NILP (underline
))
5776 face
->underline_p
= 0;
5777 face
->underline_defaulted_p
= 0;
5778 face
->underline_color
= 0;
5780 else if (CONSP (underline
))
5782 /* `(:color COLOR :style STYLE)'.
5783 STYLE being one of `line' or `wave'. */
5784 face
->underline_p
= 1;
5785 face
->underline_color
= 0;
5786 face
->underline_defaulted_p
= 1;
5787 face
->underline_type
= FACE_UNDER_LINE
;
5789 while (CONSP (underline
))
5791 Lisp_Object keyword
, value
;
5793 keyword
= XCAR (underline
);
5794 underline
= XCDR (underline
);
5796 if (!CONSP (underline
))
5798 value
= XCAR (underline
);
5799 underline
= XCDR (underline
);
5801 if (EQ (keyword
, QCcolor
))
5803 if (EQ (value
, Qforeground_color
))
5805 face
->underline_defaulted_p
= 1;
5806 face
->underline_color
= 0;
5808 else if (STRINGP (value
))
5810 face
->underline_defaulted_p
= 0;
5811 face
->underline_color
= load_color (f
, face
, value
,
5812 LFACE_UNDERLINE_INDEX
);
5815 else if (EQ (keyword
, QCstyle
))
5817 if (EQ (value
, Qline
))
5818 face
->underline_type
= FACE_UNDER_LINE
;
5819 else if (EQ (value
, Qwave
))
5820 face
->underline_type
= FACE_UNDER_WAVE
;
5825 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5826 if (STRINGP (overline
))
5828 face
->overline_color
5829 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5830 LFACE_OVERLINE_INDEX
);
5831 face
->overline_p
= 1;
5833 else if (EQ (overline
, Qt
))
5835 face
->overline_color
= face
->foreground
;
5836 face
->overline_color_defaulted_p
= 1;
5837 face
->overline_p
= 1;
5840 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5841 if (STRINGP (strike_through
))
5843 face
->strike_through_color
5844 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5845 LFACE_STRIKE_THROUGH_INDEX
);
5846 face
->strike_through_p
= 1;
5848 else if (EQ (strike_through
, Qt
))
5850 face
->strike_through_color
= face
->foreground
;
5851 face
->strike_through_color_defaulted_p
= 1;
5852 face
->strike_through_p
= 1;
5855 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5856 if (!NILP (stipple
))
5857 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5858 #endif /* HAVE_WINDOW_SYSTEM */
5864 /* Map a specified color of face FACE on frame F to a tty color index.
5865 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5866 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5867 default foreground/background colors. */
5870 map_tty_color (struct frame
*f
, struct face
*face
,
5871 enum lface_attribute_index idx
, int *defaulted
)
5873 Lisp_Object frame
, color
, def
;
5874 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5875 unsigned long default_pixel
=
5876 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5877 unsigned long pixel
= default_pixel
;
5879 unsigned long default_other_pixel
=
5880 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5883 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5885 XSETFRAME (frame
, f
);
5886 color
= face
->lface
[idx
];
5890 && CONSP (Vtty_defined_color_alist
)
5891 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5894 /* Associations in tty-defined-color-alist are of the form
5895 (NAME INDEX R G B). We need the INDEX part. */
5896 pixel
= XINT (XCAR (XCDR (def
)));
5899 if (pixel
== default_pixel
&& STRINGP (color
))
5901 pixel
= load_color (f
, face
, color
, idx
);
5904 /* If the foreground of the default face is the default color,
5905 use the foreground color defined by the frame. */
5906 if (FRAME_MSDOS_P (f
))
5908 if (pixel
== default_pixel
5909 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5912 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5914 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5915 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5918 else if (pixel
== default_other_pixel
)
5921 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5923 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5924 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5932 face
->foreground
= pixel
;
5934 face
->background
= pixel
;
5938 /* Realize the fully-specified face with attributes ATTRS in face
5939 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5940 Value is a pointer to the newly created realized face. */
5942 static struct face
*
5943 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5947 int face_colors_defaulted
= 0;
5948 struct frame
*f
= cache
->f
;
5950 /* Frame must be a termcap frame. */
5951 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5953 /* Allocate a new realized face. */
5954 face
= make_realized_face (attrs
);
5956 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5959 /* Map face attributes to TTY appearances. */
5960 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5961 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5963 face
->tty_bold_p
= 1;
5965 face
->tty_italic_p
= 1;
5966 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5967 face
->tty_underline_p
= 1;
5968 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5969 face
->tty_reverse_p
= 1;
5971 /* Map color names to color indices. */
5972 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5973 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5975 /* Swap colors if face is inverse-video. If the colors are taken
5976 from the frame colors, they are already inverted, since the
5977 frame-creation function calls x-handle-reverse-video. */
5978 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5980 unsigned long tem
= face
->foreground
;
5981 face
->foreground
= face
->background
;
5982 face
->background
= tem
;
5985 if (tty_suppress_bold_inverse_default_colors_p
5987 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5988 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5989 face
->tty_bold_p
= 0;
5995 DEFUN ("tty-suppress-bold-inverse-default-colors",
5996 Ftty_suppress_bold_inverse_default_colors
,
5997 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5998 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5999 SUPPRESS non-nil means suppress it.
6000 This affects bold faces on TTYs whose foreground is the default background
6001 color of the display and whose background is the default foreground color.
6002 For such faces, the bold face attribute is ignored if this variable
6004 (Lisp_Object suppress
)
6006 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6007 ++face_change_count
;
6013 /***********************************************************************
6015 ***********************************************************************/
6017 /* Return the ID of the face to use to display character CH with face
6018 property PROP on frame F in current_buffer. */
6021 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
6025 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
6030 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6031 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6035 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6036 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6037 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6038 merge_face_ref (f
, prop
, attrs
, 1, 0);
6039 face_id
= lookup_face (f
, attrs
);
6045 /* Return the face ID associated with buffer position POS for
6046 displaying ASCII characters. Return in *ENDPTR the position at
6047 which a different face is needed, as far as text properties and
6048 overlays are concerned. W is a window displaying current_buffer.
6050 REGION_BEG, REGION_END delimit the region, so it can be
6053 LIMIT is a position not to scan beyond. That is to limit the time
6054 this function can take.
6056 If MOUSE is non-zero, use the character's mouse-face, not its face.
6058 BASE_FACE_ID, if non-negative, specifies a base face id to use
6059 instead of DEFAULT_FACE_ID.
6061 The face returned is suitable for displaying ASCII characters. */
6064 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
6065 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6066 ptrdiff_t *endptr
, ptrdiff_t limit
,
6067 int mouse
, int base_face_id
)
6069 struct frame
*f
= XFRAME (w
->frame
);
6070 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6071 Lisp_Object prop
, position
;
6072 ptrdiff_t i
, noverlays
;
6073 Lisp_Object
*overlay_vec
;
6076 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6077 Lisp_Object limit1
, end
;
6078 struct face
*default_face
;
6080 /* W must display the current buffer. We could write this function
6081 to use the frame and buffer of W, but right now it doesn't. */
6082 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6084 XSETFRAME (frame
, f
);
6085 XSETFASTINT (position
, pos
);
6088 if (pos
< region_beg
&& region_beg
< endpos
)
6089 endpos
= region_beg
;
6091 /* Get the `face' or `mouse_face' text property at POS, and
6092 determine the next position at which the property changes. */
6093 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6094 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6095 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6097 endpos
= XINT (end
);
6099 /* Look at properties from overlays. */
6101 ptrdiff_t next_overlay
;
6103 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6104 if (next_overlay
< endpos
)
6105 endpos
= next_overlay
;
6113 if (base_face_id
>= 0)
6114 face_id
= base_face_id
;
6115 else if (NILP (Vface_remapping_alist
))
6116 face_id
= DEFAULT_FACE_ID
;
6118 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6120 default_face
= FACE_FROM_ID (f
, face_id
);
6123 /* Optimize common cases where we can use the default face. */
6126 && !(pos
>= region_beg
&& pos
< region_end
))
6127 return default_face
->id
;
6129 /* Begin with attributes from the default face. */
6130 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6132 /* Merge in attributes specified via text properties. */
6134 merge_face_ref (f
, prop
, attrs
, 1, 0);
6136 /* Now merge the overlay data. */
6137 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6138 for (i
= 0; i
< noverlays
; i
++)
6143 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6145 merge_face_ref (f
, prop
, attrs
, 1, 0);
6147 oend
= OVERLAY_END (overlay_vec
[i
]);
6148 oendpos
= OVERLAY_POSITION (oend
);
6149 if (oendpos
< endpos
)
6153 /* If in the region, merge in the region face. */
6154 if (pos
>= region_beg
&& pos
< region_end
)
6156 merge_named_face (f
, Qregion
, attrs
, 0);
6158 if (region_end
< endpos
)
6159 endpos
= region_end
;
6164 /* Look up a realized face with the given face attributes,
6165 or realize a new one for ASCII characters. */
6166 return lookup_face (f
, attrs
);
6169 /* Return the face ID at buffer position POS for displaying ASCII
6170 characters associated with overlay strings for overlay OVERLAY.
6172 Like face_at_buffer_position except for OVERLAY. Currently it
6173 simply disregards the `face' properties of all overlays. */
6176 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6177 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6178 ptrdiff_t *endptr
, ptrdiff_t limit
,
6179 int mouse
, Lisp_Object overlay
)
6181 struct frame
*f
= XFRAME (w
->frame
);
6182 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6183 Lisp_Object prop
, position
;
6186 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6187 Lisp_Object limit1
, end
;
6188 struct face
*default_face
;
6190 /* W must display the current buffer. We could write this function
6191 to use the frame and buffer of W, but right now it doesn't. */
6192 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6194 XSETFRAME (frame
, f
);
6195 XSETFASTINT (position
, pos
);
6198 if (pos
< region_beg
&& region_beg
< endpos
)
6199 endpos
= region_beg
;
6201 /* Get the `face' or `mouse_face' text property at POS, and
6202 determine the next position at which the property changes. */
6203 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6204 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6205 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6207 endpos
= XINT (end
);
6211 /* Optimize common case where we can use the default face. */
6213 && !(pos
>= region_beg
&& pos
< region_end
)
6214 && NILP (Vface_remapping_alist
))
6215 return DEFAULT_FACE_ID
;
6217 /* Begin with attributes from the default face. */
6218 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6219 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6221 /* Merge in attributes specified via text properties. */
6223 merge_face_ref (f
, prop
, attrs
, 1, 0);
6225 /* If in the region, merge in the region face. */
6226 if (pos
>= region_beg
&& pos
< region_end
)
6228 merge_named_face (f
, Qregion
, attrs
, 0);
6230 if (region_end
< endpos
)
6231 endpos
= region_end
;
6236 /* Look up a realized face with the given face attributes,
6237 or realize a new one for ASCII characters. */
6238 return lookup_face (f
, attrs
);
6242 /* Compute the face at character position POS in Lisp string STRING on
6243 window W, for ASCII characters.
6245 If STRING is an overlay string, it comes from position BUFPOS in
6246 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6247 not an overlay string. W must display the current buffer.
6248 REGION_BEG and REGION_END give the start and end positions of the
6249 region; both are -1 if no region is visible.
6251 BASE_FACE_ID is the id of a face to merge with. For strings coming
6252 from overlays or the `display' property it is the face at BUFPOS.
6254 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6256 Set *ENDPTR to the next position where to check for faces in
6257 STRING; -1 if the face is constant from POS to the end of the
6260 Value is the id of the face to use. The face returned is suitable
6261 for displaying ASCII characters. */
6264 face_at_string_position (struct window
*w
, Lisp_Object string
,
6265 ptrdiff_t pos
, ptrdiff_t bufpos
,
6266 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6267 ptrdiff_t *endptr
, enum face_id base_face_id
,
6270 Lisp_Object prop
, position
, end
, limit
;
6271 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6272 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6273 struct face
*base_face
;
6274 int multibyte_p
= STRING_MULTIBYTE (string
);
6275 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6277 /* Get the value of the face property at the current position within
6278 STRING. Value is nil if there is no face property. */
6279 XSETFASTINT (position
, pos
);
6280 prop
= Fget_text_property (position
, prop_name
, string
);
6282 /* Get the next position at which to check for faces. Value of end
6283 is nil if face is constant all the way to the end of the string.
6284 Otherwise it is a string position where to check faces next.
6285 Limit is the maximum position up to which to check for property
6286 changes in Fnext_single_property_change. Strings are usually
6287 short, so set the limit to the end of the string. */
6288 XSETFASTINT (limit
, SCHARS (string
));
6289 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6291 *endptr
= XFASTINT (end
);
6295 base_face
= FACE_FROM_ID (f
, base_face_id
);
6296 eassert (base_face
);
6298 /* Optimize the default case that there is no face property and we
6299 are not in the region. */
6301 && (base_face_id
!= DEFAULT_FACE_ID
6302 /* BUFPOS <= 0 means STRING is not an overlay string, so
6303 that the region doesn't have to be taken into account. */
6305 || bufpos
< region_beg
6306 || bufpos
>= region_end
)
6308 /* We can't realize faces for different charsets differently
6309 if we don't have fonts, so we can stop here if not working
6310 on a window-system frame. */
6311 || !FRAME_WINDOW_P (f
)
6312 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6313 return base_face
->id
;
6315 /* Begin with attributes from the base face. */
6316 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6318 /* Merge in attributes specified via text properties. */
6320 merge_face_ref (f
, prop
, attrs
, 1, 0);
6322 /* If in the region, merge in the region face. */
6324 && bufpos
>= region_beg
6325 && bufpos
< region_end
)
6326 merge_named_face (f
, Qregion
, attrs
, 0);
6328 /* Look up a realized face with the given face attributes,
6329 or realize a new one for ASCII characters. */
6330 return lookup_face (f
, attrs
);
6334 /* Merge a face into a realized face.
6336 F is frame where faces are (to be) realized.
6338 FACE_NAME is named face to merge.
6340 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6342 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6344 BASE_FACE_ID is realized face to merge into.
6350 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6353 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6354 struct face
*base_face
;
6356 base_face
= FACE_FROM_ID (f
, base_face_id
);
6358 return base_face_id
;
6360 if (EQ (face_name
, Qt
))
6362 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6363 return base_face_id
;
6364 face_name
= lface_id_to_name
[face_id
];
6365 /* When called during make-frame, lookup_derived_face may fail
6366 if the faces are uninitialized. Don't signal an error. */
6367 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6368 return (face_id
>= 0 ? face_id
: base_face_id
);
6371 /* Begin with attributes from the base face. */
6372 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6374 if (!NILP (face_name
))
6376 if (!merge_named_face (f
, face_name
, attrs
, 0))
6377 return base_face_id
;
6383 return base_face_id
;
6384 face
= FACE_FROM_ID (f
, face_id
);
6386 return base_face_id
;
6387 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6390 /* Look up a realized face with the given face attributes,
6391 or realize a new one for ASCII characters. */
6392 return lookup_face (f
, attrs
);
6397 #ifndef HAVE_X_WINDOWS
6398 DEFUN ("x-load-color-file", Fx_load_color_file
,
6399 Sx_load_color_file
, 1, 1, 0,
6400 doc
: /* Create an alist of color entries from an external file.
6402 The file should define one named RGB color per line like so:
6404 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6405 (Lisp_Object filename
)
6408 Lisp_Object cmap
= Qnil
;
6409 Lisp_Object abspath
;
6411 CHECK_STRING (filename
);
6412 abspath
= Fexpand_file_name (filename
, Qnil
);
6414 fp
= fopen (SDATA (abspath
), "rt");
6418 int red
, green
, blue
;
6423 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6424 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6426 char *name
= buf
+ num
;
6427 num
= strlen (name
) - 1;
6428 if (num
>= 0 && name
[num
] == '\n')
6430 cmap
= Fcons (Fcons (build_string (name
),
6432 make_number (RGB (red
, green
, blue
))),
6434 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6449 /***********************************************************************
6451 ***********************************************************************/
6455 /* Print the contents of the realized face FACE to stderr. */
6458 dump_realized_face (struct face
*face
)
6460 fprintf (stderr
, "ID: %d\n", face
->id
);
6461 #ifdef HAVE_X_WINDOWS
6462 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6464 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6466 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6467 fprintf (stderr
, "background: 0x%lx (%s)\n",
6469 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6471 fprintf (stderr
, "font_name: %s (%s)\n",
6472 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6473 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6474 #ifdef HAVE_X_WINDOWS
6475 fprintf (stderr
, "font = %p\n", face
->font
);
6477 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6478 fprintf (stderr
, "underline: %d (%s)\n",
6480 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6481 fprintf (stderr
, "hash: %d\n", face
->hash
);
6485 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6492 fprintf (stderr
, "font selection order: ");
6493 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6494 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6495 fprintf (stderr
, "\n");
6497 fprintf (stderr
, "alternative fonts: ");
6498 debug_print (Vface_alternative_font_family_alist
);
6499 fprintf (stderr
, "\n");
6501 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6502 Fdump_face (make_number (i
));
6508 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6510 error ("Not a valid face");
6511 dump_realized_face (face
);
6518 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6519 0, 0, 0, doc
: /* */)
6522 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6523 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6524 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6528 #endif /* GLYPH_DEBUG != 0 */
6532 /***********************************************************************
6534 ***********************************************************************/
6537 syms_of_xfaces (void)
6539 DEFSYM (Qface
, "face");
6540 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6541 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6542 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6544 /* Lisp face attribute keywords. */
6545 DEFSYM (QCfamily
, ":family");
6546 DEFSYM (QCheight
, ":height");
6547 DEFSYM (QCweight
, ":weight");
6548 DEFSYM (QCslant
, ":slant");
6549 DEFSYM (QCunderline
, ":underline");
6550 DEFSYM (QCinverse_video
, ":inverse-video");
6551 DEFSYM (QCreverse_video
, ":reverse-video");
6552 DEFSYM (QCforeground
, ":foreground");
6553 DEFSYM (QCbackground
, ":background");
6554 DEFSYM (QCstipple
, ":stipple");
6555 DEFSYM (QCwidth
, ":width");
6556 DEFSYM (QCfont
, ":font");
6557 DEFSYM (QCfontset
, ":fontset");
6558 DEFSYM (QCbold
, ":bold");
6559 DEFSYM (QCitalic
, ":italic");
6560 DEFSYM (QCoverline
, ":overline");
6561 DEFSYM (QCstrike_through
, ":strike-through");
6562 DEFSYM (QCbox
, ":box");
6563 DEFSYM (QCinherit
, ":inherit");
6565 /* Symbols used for Lisp face attribute values. */
6566 DEFSYM (QCcolor
, ":color");
6567 DEFSYM (QCline_width
, ":line-width");
6568 DEFSYM (QCstyle
, ":style");
6569 DEFSYM (Qline
, "line");
6570 DEFSYM (Qwave
, "wave");
6571 DEFSYM (Qreleased_button
, "released-button");
6572 DEFSYM (Qpressed_button
, "pressed-button");
6573 DEFSYM (Qnormal
, "normal");
6574 DEFSYM (Qultra_light
, "ultra-light");
6575 DEFSYM (Qextra_light
, "extra-light");
6576 DEFSYM (Qlight
, "light");
6577 DEFSYM (Qsemi_light
, "semi-light");
6578 DEFSYM (Qsemi_bold
, "semi-bold");
6579 DEFSYM (Qbold
, "bold");
6580 DEFSYM (Qextra_bold
, "extra-bold");
6581 DEFSYM (Qultra_bold
, "ultra-bold");
6582 DEFSYM (Qoblique
, "oblique");
6583 DEFSYM (Qitalic
, "italic");
6584 DEFSYM (Qreverse_oblique
, "reverse-oblique");
6585 DEFSYM (Qreverse_italic
, "reverse-italic");
6586 DEFSYM (Qultra_condensed
, "ultra-condensed");
6587 DEFSYM (Qextra_condensed
, "extra-condensed");
6588 DEFSYM (Qcondensed
, "condensed");
6589 DEFSYM (Qsemi_condensed
, "semi-condensed");
6590 DEFSYM (Qsemi_expanded
, "semi-expanded");
6591 DEFSYM (Qexpanded
, "expanded");
6592 DEFSYM (Qextra_expanded
, "extra-expanded");
6593 DEFSYM (Qultra_expanded
, "ultra-expanded");
6594 DEFSYM (Qbackground_color
, "background-color");
6595 DEFSYM (Qforeground_color
, "foreground-color");
6596 DEFSYM (Qunspecified
, "unspecified");
6597 DEFSYM (QCignore_defface
, ":ignore-defface");
6599 DEFSYM (Qface_alias
, "face-alias");
6600 DEFSYM (Qdefault
, "default");
6601 DEFSYM (Qtool_bar
, "tool-bar");
6602 DEFSYM (Qregion
, "region");
6603 DEFSYM (Qfringe
, "fringe");
6604 DEFSYM (Qheader_line
, "header-line");
6605 DEFSYM (Qscroll_bar
, "scroll-bar");
6606 DEFSYM (Qmenu
, "menu");
6607 DEFSYM (Qcursor
, "cursor");
6608 DEFSYM (Qborder
, "border");
6609 DEFSYM (Qmouse
, "mouse");
6610 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6611 DEFSYM (Qvertical_border
, "vertical-border");
6612 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6613 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6614 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6615 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6616 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6618 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6619 staticpro (&Vparam_value_alist
);
6620 Vface_alternative_font_family_alist
= Qnil
;
6621 staticpro (&Vface_alternative_font_family_alist
);
6622 Vface_alternative_font_registry_alist
= Qnil
;
6623 staticpro (&Vface_alternative_font_registry_alist
);
6625 defsubr (&Sinternal_make_lisp_face
);
6626 defsubr (&Sinternal_lisp_face_p
);
6627 defsubr (&Sinternal_set_lisp_face_attribute
);
6628 #ifdef HAVE_WINDOW_SYSTEM
6629 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6631 defsubr (&Scolor_gray_p
);
6632 defsubr (&Scolor_supported_p
);
6633 #ifndef HAVE_X_WINDOWS
6634 defsubr (&Sx_load_color_file
);
6636 defsubr (&Sface_attribute_relative_p
);
6637 defsubr (&Smerge_face_attribute
);
6638 defsubr (&Sinternal_get_lisp_face_attribute
);
6639 defsubr (&Sinternal_lisp_face_attribute_values
);
6640 defsubr (&Sinternal_lisp_face_equal_p
);
6641 defsubr (&Sinternal_lisp_face_empty_p
);
6642 defsubr (&Sinternal_copy_lisp_face
);
6643 defsubr (&Sinternal_merge_in_global_face
);
6644 defsubr (&Sface_font
);
6645 defsubr (&Sframe_face_alist
);
6646 defsubr (&Sdisplay_supports_face_attributes_p
);
6647 defsubr (&Scolor_distance
);
6648 defsubr (&Sinternal_set_font_selection_order
);
6649 defsubr (&Sinternal_set_alternative_font_family_alist
);
6650 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6651 defsubr (&Sface_attributes_as_vector
);
6653 defsubr (&Sdump_face
);
6654 defsubr (&Sshow_face_resources
);
6655 #endif /* GLYPH_DEBUG */
6656 defsubr (&Sclear_face_cache
);
6657 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6659 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6660 defsubr (&Sdump_colors
);
6663 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6664 doc
: /* Limit for font matching.
6665 If an integer > 0, font matching functions won't load more than
6666 that number of fonts when searching for a matching font. */);
6667 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6669 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6670 doc
: /* List of global face definitions (for internal use only.) */);
6671 Vface_new_frame_defaults
= Qnil
;
6673 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6674 doc
: /* Default stipple pattern used on monochrome displays.
6675 This stipple pattern is used on monochrome displays
6676 instead of shades of gray for a face background color.
6677 See `set-face-stipple' for possible values for this variable. */);
6678 Vface_default_stipple
= make_pure_c_string ("gray3");
6680 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6681 doc
: /* An alist of defined terminal colors and their RGB values.
6682 See the docstring of `tty-color-alist' for the details. */);
6683 Vtty_defined_color_alist
= Qnil
;
6685 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6686 doc
: /* Allowed scalable fonts.
6687 A value of nil means don't allow any scalable fonts.
6688 A value of t means allow any scalable font.
6689 Otherwise, value must be a list of regular expressions. A font may be
6690 scaled if its name matches a regular expression in the list.
6691 Note that if value is nil, a scalable font might still be used, if no
6692 other font of the appropriate family and registry is available. */);
6693 Vscalable_fonts_allowed
= Qnil
;
6695 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6696 doc
: /* List of ignored fonts.
6697 Each element is a regular expression that matches names of fonts to
6699 Vface_ignored_fonts
= Qnil
;
6701 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6702 doc
: /* Alist of face remappings.
6703 Each element is of the form:
6705 (FACE . REPLACEMENT),
6707 which causes display of the face FACE to use REPLACEMENT instead.
6708 REPLACEMENT is a face specification, i.e. one of the following:
6711 (2) a property list of attribute/value pairs, or
6712 (3) a list in which each element has the form of (1) or (2).
6714 List values for REPLACEMENT are merged to form the final face
6715 specification, with earlier entries taking precedence, in the same as
6716 as in the `face' text property.
6718 Face-name remapping cycles are suppressed; recursive references use
6719 the underlying face instead of the remapped face. So a remapping of
6722 (FACE EXTRA-FACE... FACE)
6726 (FACE (FACE-ATTR VAL ...) FACE)
6728 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6729 existing definition of FACE. Note that this isn't necessary for the
6730 default face, since every face inherits from the default face.
6732 If this variable is made buffer-local, the face remapping takes effect
6733 only in that buffer. For instance, the mode my-mode could define a
6734 face `my-mode-default', and then in the mode setup function, do:
6736 (set (make-local-variable 'face-remapping-alist)
6737 '((default my-mode-default)))).
6739 Because Emacs normally only redraws screen areas when the underlying
6740 buffer contents change, you may need to call `redraw-display' after
6741 changing this variable for it to take effect. */);
6742 Vface_remapping_alist
= Qnil
;
6744 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6745 doc
: /* Alist of fonts vs the rescaling factors.
6746 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6747 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6748 RESCALE-RATIO is a floating point number to specify how much larger
6749 \(or smaller) font we should use. For instance, if a face requests
6750 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6751 Vface_font_rescale_alist
= Qnil
;
6753 #ifdef HAVE_WINDOW_SYSTEM
6754 defsubr (&Sbitmap_spec_p
);
6755 defsubr (&Sx_list_fonts
);
6756 defsubr (&Sinternal_face_x_get_resource
);
6757 defsubr (&Sx_family_fonts
);