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 check_x check_w32
237 #define GCGraphicsExposures 0
238 #endif /* WINDOWSNT */
242 #undef FRAME_X_DISPLAY_INFO
243 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
244 #define x_display_info ns_display_info
245 #define check_x check_ns
246 #define GCGraphicsExposures 0
250 #include "dispextern.h"
251 #include "blockinput.h"
253 #include "intervals.h"
254 #include "termchar.h"
257 #ifdef HAVE_WINDOW_SYSTEM
259 #endif /* HAVE_WINDOW_SYSTEM */
261 #ifdef HAVE_X_WINDOWS
263 /* Compensate for a bug in Xos.h on some systems, on which it requires
264 time.h. On some such systems, Xos.h tries to redefine struct
265 timeval and struct timezone if USG is #defined while it is
268 #ifdef XOS_NEEDS_TIME_H
274 #if defined USG || defined __TIMEVAL__ /* Don't warn about unused macros. */
276 #else /* not XOS_NEEDS_TIME_H */
278 #endif /* not XOS_NEEDS_TIME_H */
280 #endif /* HAVE_X_WINDOWS */
284 /* Number of pt per inch (from the TeXbook). */
286 #define PT_PER_INCH 72.27
288 /* Non-zero if face attribute ATTR is unspecified. */
290 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
292 /* Non-zero if face attribute ATTR is `ignore-defface'. */
294 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), QCignore_defface)
296 /* Value is the number of elements of VECTOR. */
298 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
300 /* Size of hash table of realized faces in face caches (should be a
303 #define FACE_CACHE_BUCKETS_SIZE 1001
305 /* Keyword symbols used for face attribute names. */
307 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
;
308 static Lisp_Object QCunderline
;
309 static Lisp_Object QCinverse_video
, QCstipple
;
310 Lisp_Object QCforeground
, QCbackground
;
312 static Lisp_Object QCfont
, QCbold
, QCitalic
;
313 static Lisp_Object QCreverse_video
;
314 static Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
315 static Lisp_Object QCfontset
;
317 /* Symbols used for attribute values. */
321 static Lisp_Object Qline
, Qwave
;
322 static Lisp_Object Qultra_light
, Qextra_light
, Qlight
;
323 static Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
324 static Lisp_Object Qoblique
, Qreverse_oblique
, Qreverse_italic
;
326 static Lisp_Object Qultra_condensed
, Qextra_condensed
;
327 Lisp_Object Qcondensed
;
328 static Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qextra_expanded
;
329 Lisp_Object Qexpanded
;
330 static Lisp_Object Qultra_expanded
;
331 static Lisp_Object Qreleased_button
, Qpressed_button
;
332 static Lisp_Object QCstyle
, QCcolor
, QCline_width
;
333 Lisp_Object Qunspecified
; /* used in dosfns.c */
334 static Lisp_Object QCignore_defface
;
336 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
338 /* The name of the function to call when the background of the frame
339 has changed, frame_set_background_mode. */
341 static Lisp_Object Qframe_set_background_mode
;
343 /* Names of basic faces. */
345 Lisp_Object Qdefault
, Qtool_bar
, Qfringe
;
346 static Lisp_Object Qregion
;
347 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
;
348 static Lisp_Object Qborder
, Qmouse
, Qmenu
;
349 Lisp_Object Qmode_line_inactive
;
350 static Lisp_Object Qvertical_border
;
352 /* The symbol `face-alias'. A symbols having that property is an
353 alias for another face. Value of the property is the name of
356 static Lisp_Object Qface_alias
;
358 /* Alist of alternative font families. Each element is of the form
359 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
360 try FAMILY1, then FAMILY2, ... */
362 Lisp_Object Vface_alternative_font_family_alist
;
364 /* Alist of alternative font registries. Each element is of the form
365 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
366 loaded, try REGISTRY1, then REGISTRY2, ... */
368 Lisp_Object Vface_alternative_font_registry_alist
;
370 /* Allowed scalable fonts. A value of nil means don't allow any
371 scalable fonts. A value of t means allow the use of any scalable
372 font. Otherwise, value must be a list of regular expressions. A
373 font may be scaled if its name matches a regular expression in the
376 static Lisp_Object Qscalable_fonts_allowed
;
378 #define DEFAULT_FONT_LIST_LIMIT 100
380 /* The symbols `foreground-color' and `background-color' which can be
381 used as part of a `face' property. This is for compatibility with
384 Lisp_Object Qforeground_color
, Qbackground_color
;
386 /* The symbols `face' and `mouse-face' used as text properties. */
390 /* Property for basic faces which other faces cannot inherit. */
392 static Lisp_Object Qface_no_inherit
;
394 /* Error symbol for wrong_type_argument in load_pixmap. */
396 static Lisp_Object Qbitmap_spec_p
;
398 /* The next ID to assign to Lisp faces. */
400 static int next_lface_id
;
402 /* A vector mapping Lisp face Id's to face names. */
404 static Lisp_Object
*lface_id_to_name
;
405 static ptrdiff_t lface_id_to_name_size
;
407 /* TTY color-related functions (defined in tty-colors.el). */
409 static Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
411 /* The name of the function used to compute colors on TTYs. */
413 static Lisp_Object Qtty_color_alist
;
415 /* Counter for calls to clear_face_cache. If this counter reaches
416 CLEAR_FONT_TABLE_COUNT, and a frame has more than
417 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
419 static int clear_font_table_count
;
420 #define CLEAR_FONT_TABLE_COUNT 100
421 #define CLEAR_FONT_TABLE_NFONTS 10
423 /* Non-zero means face attributes have been changed since the last
424 redisplay. Used in redisplay_internal. */
426 int face_change_count
;
428 /* Non-zero means don't display bold text if a face's foreground
429 and background colors are the inverse of the default colors of the
430 display. This is a kluge to suppress `bold black' foreground text
431 which is hard to read on an LCD monitor. */
433 static int tty_suppress_bold_inverse_default_colors_p
;
435 /* A list of the form `((x . y))' used to avoid consing in
436 Finternal_set_lisp_face_attribute. */
438 static Lisp_Object Vparam_value_alist
;
440 /* The total number of colors currently allocated. */
443 static int ncolors_allocated
;
444 static int npixmaps_allocated
;
448 /* Non-zero means the definition of the `menu' face for new frames has
451 static int menu_face_changed_default
;
454 /* Function prototypes. */
457 struct named_merge_point
;
459 static void map_tty_color (struct frame
*, struct face
*,
460 enum lface_attribute_index
, int *);
461 static Lisp_Object
resolve_face_name (Lisp_Object
, int);
462 static void set_font_frame_param (Lisp_Object
, Lisp_Object
);
463 static int get_lface_attributes (struct frame
*, Lisp_Object
, Lisp_Object
*,
464 int, struct named_merge_point
*);
465 static ptrdiff_t load_pixmap (struct frame
*, Lisp_Object
,
466 unsigned *, unsigned *);
467 static struct frame
*frame_or_selected_frame (Lisp_Object
, int);
468 static void load_face_colors (struct frame
*, struct face
*, Lisp_Object
*);
469 static void free_face_colors (struct frame
*, struct face
*);
470 static int face_color_gray_p (struct frame
*, const char *);
471 static struct face
*realize_face (struct face_cache
*, Lisp_Object
*,
473 static struct face
*realize_non_ascii_face (struct frame
*, Lisp_Object
,
475 static struct face
*realize_x_face (struct face_cache
*, Lisp_Object
*);
476 static struct face
*realize_tty_face (struct face_cache
*, Lisp_Object
*);
477 static int realize_basic_faces (struct frame
*);
478 static int realize_default_face (struct frame
*);
479 static void realize_named_face (struct frame
*, Lisp_Object
, int);
480 static int lface_fully_specified_p (Lisp_Object
*);
481 static int lface_equal_p (Lisp_Object
*, Lisp_Object
*);
482 static unsigned hash_string_case_insensitive (Lisp_Object
);
483 static unsigned lface_hash (Lisp_Object
*);
484 static int lface_same_font_attributes_p (Lisp_Object
*, Lisp_Object
*);
485 static struct face_cache
*make_face_cache (struct frame
*);
486 static void clear_face_gcs (struct face_cache
*);
487 static void free_face_cache (struct face_cache
*);
488 static int face_fontset (Lisp_Object
*);
489 static void merge_face_vectors (struct frame
*, Lisp_Object
*, Lisp_Object
*,
490 struct named_merge_point
*);
491 static int merge_face_ref (struct frame
*, Lisp_Object
, Lisp_Object
*,
492 int, struct named_merge_point
*);
493 static int set_lface_from_font (struct frame
*, Lisp_Object
, Lisp_Object
,
495 static Lisp_Object
lface_from_face_name (struct frame
*, Lisp_Object
, int);
496 static struct face
*make_realized_face (Lisp_Object
*);
497 static void cache_face (struct face_cache
*, struct face
*, unsigned);
498 static void uncache_face (struct face_cache
*, struct face
*);
500 #ifdef HAVE_WINDOW_SYSTEM
502 static GC
x_create_gc (struct frame
*, unsigned long, XGCValues
*);
503 static void x_free_gc (struct frame
*, GC
);
506 static void x_update_menu_appearance (struct frame
*);
508 extern void free_frame_menubar (struct frame
*);
509 #endif /* USE_X_TOOLKIT */
511 #endif /* HAVE_WINDOW_SYSTEM */
514 /***********************************************************************
516 ***********************************************************************/
518 #ifdef HAVE_X_WINDOWS
520 #ifdef DEBUG_X_COLORS
522 /* The following is a poor mans infrastructure for debugging X color
523 allocation problems on displays with PseudoColor-8. Some X servers
524 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
525 color reference counts completely so that they don't signal an
526 error when a color is freed whose reference count is already 0.
527 Other X servers do. To help me debug this, the following code
528 implements a simple reference counting schema of its own, for a
529 single display/screen. --gerd. */
531 /* Reference counts for pixel colors. */
533 int color_count
[256];
535 /* Register color PIXEL as allocated. */
538 register_color (unsigned long pixel
)
540 eassert (pixel
< 256);
541 ++color_count
[pixel
];
545 /* Register color PIXEL as deallocated. */
548 unregister_color (unsigned long pixel
)
550 eassert (pixel
< 256);
551 if (color_count
[pixel
] > 0)
552 --color_count
[pixel
];
558 /* Register N colors from PIXELS as deallocated. */
561 unregister_colors (unsigned long *pixels
, int n
)
564 for (i
= 0; i
< n
; ++i
)
565 unregister_color (pixels
[i
]);
569 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
570 doc
: /* Dump currently allocated colors to stderr. */)
575 fputc ('\n', stderr
);
577 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
580 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
583 fputc ('\n', stderr
);
585 fputc ('\t', stderr
);
589 fputc ('\n', stderr
);
593 #endif /* DEBUG_X_COLORS */
596 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
597 color values. Interrupt input must be blocked when this function
601 x_free_colors (struct frame
*f
, long unsigned int *pixels
, int npixels
)
603 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
605 /* If display has an immutable color map, freeing colors is not
606 necessary and some servers don't allow it. So don't do it. */
607 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
609 #ifdef DEBUG_X_COLORS
610 unregister_colors (pixels
, npixels
);
612 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
620 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
621 color values. Interrupt input must be blocked when this function
625 x_free_dpy_colors (Display
*dpy
, Screen
*screen
, Colormap cmap
,
626 long unsigned int *pixels
, int npixels
)
628 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
629 int class = dpyinfo
->visual
->class;
631 /* If display has an immutable color map, freeing colors is not
632 necessary and some servers don't allow it. So don't do it. */
633 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
635 #ifdef DEBUG_X_COLORS
636 unregister_colors (pixels
, npixels
);
638 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
641 #endif /* USE_X_TOOLKIT */
643 /* Create and return a GC for use on frame F. GC values and mask
644 are given by XGCV and MASK. */
647 x_create_gc (struct frame
*f
, long unsigned int mask
, XGCValues
*xgcv
)
651 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
658 /* Free GC which was used on frame F. */
661 x_free_gc (struct frame
*f
, GC gc
)
663 eassert (interrupt_input_blocked
);
664 IF_DEBUG (eassert (--ngcs
>= 0));
665 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
668 #endif /* HAVE_X_WINDOWS */
671 /* W32 emulation of GCs */
674 x_create_gc (struct frame
*f
, unsigned long mask
, XGCValues
*xgcv
)
678 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
685 /* Free GC which was used on frame F. */
688 x_free_gc (struct frame
*f
, GC gc
)
690 IF_DEBUG (eassert (--ngcs
>= 0));
694 #endif /* WINDOWSNT */
697 /* NS emulation of GCs */
700 x_create_gc (struct frame
*f
,
704 GC gc
= xmalloc (sizeof *gc
);
705 memcpy (gc
, xgcv
, sizeof (XGCValues
));
710 x_free_gc (struct frame
*f
, GC gc
)
716 /* If FRAME is nil, return a pointer to the selected frame.
717 Otherwise, check that FRAME is a live frame, and return a pointer
718 to it. NPARAM is the parameter number of FRAME, for
719 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
720 Lisp function definitions. */
722 static inline struct frame
*
723 frame_or_selected_frame (Lisp_Object frame
, int nparam
)
726 frame
= selected_frame
;
728 CHECK_LIVE_FRAME (frame
);
729 return XFRAME (frame
);
733 /***********************************************************************
735 ***********************************************************************/
737 /* Initialize face cache and basic faces for frame F. */
740 init_frame_faces (struct frame
*f
)
742 /* Make a face cache, if F doesn't have one. */
743 if (FRAME_FACE_CACHE (f
) == NULL
)
744 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
746 #ifdef HAVE_WINDOW_SYSTEM
747 /* Make the image cache. */
748 if (FRAME_WINDOW_P (f
))
750 /* We initialize the image cache when creating the first frame
751 on a terminal, and not during terminal creation. This way,
752 `x-open-connection' on a tty won't create an image cache. */
753 if (FRAME_IMAGE_CACHE (f
) == NULL
)
754 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
755 ++FRAME_IMAGE_CACHE (f
)->refcount
;
757 #endif /* HAVE_WINDOW_SYSTEM */
759 /* Realize basic faces. Must have enough information in frame
760 parameters to realize basic faces at this point. */
761 #ifdef HAVE_X_WINDOWS
762 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
765 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
768 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
770 if (!realize_basic_faces (f
))
775 /* Free face cache of frame F. Called from delete_frame. */
778 free_frame_faces (struct frame
*f
)
780 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
784 free_face_cache (face_cache
);
785 FRAME_FACE_CACHE (f
) = NULL
;
788 #ifdef HAVE_WINDOW_SYSTEM
789 if (FRAME_WINDOW_P (f
))
791 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
794 --image_cache
->refcount
;
795 if (image_cache
->refcount
== 0)
796 free_image_cache (f
);
799 #endif /* HAVE_WINDOW_SYSTEM */
803 /* Clear face caches, and recompute basic faces for frame F. Call
804 this after changing frame parameters on which those faces depend,
805 or when realized faces have been freed due to changing attributes
809 recompute_basic_faces (struct frame
*f
)
811 if (FRAME_FACE_CACHE (f
))
813 clear_face_cache (0);
814 if (!realize_basic_faces (f
))
820 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
821 try to free unused fonts, too. */
824 clear_face_cache (int clear_fonts_p
)
826 #ifdef HAVE_WINDOW_SYSTEM
827 Lisp_Object tail
, frame
;
830 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
833 /* Not yet implemented. */
834 clear_font_cache (frame
);
837 /* From time to time see if we can unload some fonts. This also
838 frees all realized faces on all frames. Fonts needed by
839 faces will be loaded again when faces are realized again. */
840 clear_font_table_count
= 0;
842 FOR_EACH_FRAME (tail
, frame
)
844 struct frame
*f
= XFRAME (frame
);
845 if (FRAME_WINDOW_P (f
)
846 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
847 free_all_realized_faces (frame
);
852 /* Clear GCs of realized faces. */
853 FOR_EACH_FRAME (tail
, frame
)
855 struct frame
*f
= XFRAME (frame
);
856 if (FRAME_WINDOW_P (f
))
857 clear_face_gcs (FRAME_FACE_CACHE (f
));
859 clear_image_caches (Qnil
);
861 #endif /* HAVE_WINDOW_SYSTEM */
865 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
866 doc
: /* Clear face caches on all frames.
867 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
868 (Lisp_Object thoroughly
)
870 clear_face_cache (!NILP (thoroughly
));
872 ++windows_or_buffers_changed
;
877 /***********************************************************************
879 ***********************************************************************/
881 #ifdef HAVE_WINDOW_SYSTEM
883 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
884 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
885 A bitmap specification is either a string, a file name, or a list
886 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
887 HEIGHT is its height, and DATA is a string containing the bits of
888 the pixmap. Bits are stored row by row, each row occupies
889 \(WIDTH + 7)/8 bytes. */)
894 if (STRINGP (object
))
895 /* If OBJECT is a string, it's a file name. */
897 else if (CONSP (object
))
899 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
900 HEIGHT must be ints > 0, and DATA must be string large
901 enough to hold a bitmap of the specified size. */
902 Lisp_Object width
, height
, data
;
904 height
= width
= data
= Qnil
;
908 width
= XCAR (object
);
909 object
= XCDR (object
);
912 height
= XCAR (object
);
913 object
= XCDR (object
);
915 data
= XCAR (object
);
920 && RANGED_INTEGERP (1, width
, INT_MAX
)
921 && RANGED_INTEGERP (1, height
, INT_MAX
))
923 int bytes_per_row
= ((XINT (width
) + BITS_PER_CHAR
- 1)
925 if (XINT (height
) <= SBYTES (data
) / bytes_per_row
)
930 return pixmap_p
? Qt
: Qnil
;
934 /* Load a bitmap according to NAME (which is either a file name or a
935 pixmap spec) for use on frame F. Value is the bitmap_id (see
936 xfns.c). If NAME is nil, return with a bitmap id of zero. If
937 bitmap cannot be loaded, display a message saying so, and return
938 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
939 if these pointers are not null. */
942 load_pixmap (FRAME_PTR f
, Lisp_Object name
, unsigned int *w_ptr
,
950 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
955 /* Decode a bitmap spec into a bitmap. */
960 w
= XINT (Fcar (name
));
961 h
= XINT (Fcar (Fcdr (name
)));
962 bits
= Fcar (Fcdr (Fcdr (name
)));
964 bitmap_id
= x_create_bitmap_from_data (f
, SSDATA (bits
),
969 /* It must be a string -- a file name. */
970 bitmap_id
= x_create_bitmap_from_file (f
, name
);
976 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
987 ++npixmaps_allocated
;
990 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
993 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
999 #endif /* HAVE_WINDOW_SYSTEM */
1003 /***********************************************************************
1005 ***********************************************************************/
1007 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1008 RGB_LIST should contain (at least) 3 lisp integers.
1009 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1012 parse_rgb_list (Lisp_Object rgb_list
, XColor
*color
)
1014 #define PARSE_RGB_LIST_FIELD(field) \
1015 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1017 color->field = XINT (XCAR (rgb_list)); \
1018 rgb_list = XCDR (rgb_list); \
1023 PARSE_RGB_LIST_FIELD (red
);
1024 PARSE_RGB_LIST_FIELD (green
);
1025 PARSE_RGB_LIST_FIELD (blue
);
1031 /* Lookup on frame F the color described by the lisp string COLOR.
1032 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1033 non-zero, then the `standard' definition of the same color is
1037 tty_lookup_color (struct frame
*f
, Lisp_Object color
, XColor
*tty_color
,
1040 Lisp_Object frame
, color_desc
;
1042 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1045 XSETFRAME (frame
, f
);
1047 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1048 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1052 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1055 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1057 rgb
= XCDR (XCDR (color_desc
));
1058 if (! parse_rgb_list (rgb
, tty_color
))
1061 /* Should we fill in STD_COLOR too? */
1064 /* Default STD_COLOR to the same as TTY_COLOR. */
1065 *std_color
= *tty_color
;
1067 /* Do a quick check to see if the returned descriptor is
1068 actually _exactly_ equal to COLOR, otherwise we have to
1069 lookup STD_COLOR separately. If it's impossible to lookup
1070 a standard color, we just give up and use TTY_COLOR. */
1071 if ((!STRINGP (XCAR (color_desc
))
1072 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1073 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1075 /* Look up STD_COLOR separately. */
1076 rgb
= call1 (Qtty_color_standard_values
, color
);
1077 if (! parse_rgb_list (rgb
, std_color
))
1084 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1085 /* We were called early during startup, and the colors are not
1086 yet set up in tty-defined-color-alist. Don't return a failure
1087 indication, since this produces the annoying "Unable to
1088 load color" messages in the *Messages* buffer. */
1091 /* tty-color-desc seems to have returned a bad value. */
1095 /* A version of defined_color for non-X frames. */
1098 tty_defined_color (struct frame
*f
, const char *color_name
,
1099 XColor
*color_def
, int alloc
)
1104 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1106 color_def
->blue
= 0;
1107 color_def
->green
= 0;
1110 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1112 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1114 if (strcmp (color_name
, "unspecified-fg") == 0)
1115 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1116 else if (strcmp (color_name
, "unspecified-bg") == 0)
1117 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1120 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1127 /* Decide if color named COLOR_NAME is valid for the display
1128 associated with the frame F; if so, return the rgb values in
1129 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1131 This does the right thing for any type of frame. */
1134 defined_color (struct frame
*f
, const char *color_name
, XColor
*color_def
,
1137 if (!FRAME_WINDOW_P (f
))
1138 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1139 #ifdef HAVE_X_WINDOWS
1140 else if (FRAME_X_P (f
))
1141 return x_defined_color (f
, color_name
, color_def
, alloc
);
1144 else if (FRAME_W32_P (f
))
1145 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1148 else if (FRAME_NS_P (f
))
1149 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1156 /* Given the index IDX of a tty color on frame F, return its name, a
1160 tty_color_name (struct frame
*f
, int idx
)
1162 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1165 Lisp_Object coldesc
;
1167 XSETFRAME (frame
, f
);
1168 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1170 if (!NILP (coldesc
))
1171 return XCAR (coldesc
);
1174 /* We can have an MSDOG frame under -nw for a short window of
1175 opportunity before internal_terminal_init is called. DTRT. */
1176 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1177 return msdos_stdcolor_name (idx
);
1180 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1181 return build_string (unspecified_fg
);
1182 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1183 return build_string (unspecified_bg
);
1185 return Qunspecified
;
1189 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1192 The criterion implemented here is not a terribly sophisticated one. */
1195 face_color_gray_p (struct frame
*f
, const char *color_name
)
1200 if (defined_color (f
, color_name
, &color
, 0))
1201 gray_p
= (/* Any color sufficiently close to black counts as gray. */
1202 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1204 ((eabs (color
.red
- color
.green
)
1205 < max (color
.red
, color
.green
) / 20)
1206 && (eabs (color
.green
- color
.blue
)
1207 < max (color
.green
, color
.blue
) / 20)
1208 && (eabs (color
.blue
- color
.red
)
1209 < max (color
.blue
, color
.red
) / 20)));
1217 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1218 BACKGROUND_P non-zero means the color will be used as background
1222 face_color_supported_p (struct frame
*f
, const char *color_name
,
1228 XSETFRAME (frame
, f
);
1230 #ifdef HAVE_WINDOW_SYSTEM
1232 ? (!NILP (Fxw_display_color_p (frame
))
1233 || xstrcasecmp (color_name
, "black") == 0
1234 || xstrcasecmp (color_name
, "white") == 0
1236 && face_color_gray_p (f
, color_name
))
1237 || (!NILP (Fx_display_grayscale_p (frame
))
1238 && face_color_gray_p (f
, color_name
)))
1241 tty_defined_color (f
, color_name
, ¬_used
, 0);
1245 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1246 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1247 FRAME specifies the frame and thus the display for interpreting COLOR.
1248 If FRAME is nil or omitted, use the selected frame. */)
1249 (Lisp_Object color
, Lisp_Object frame
)
1253 CHECK_STRING (color
);
1255 frame
= selected_frame
;
1257 CHECK_FRAME (frame
);
1259 return face_color_gray_p (f
, SSDATA (color
)) ? Qt
: Qnil
;
1263 DEFUN ("color-supported-p", Fcolor_supported_p
,
1264 Scolor_supported_p
, 1, 3, 0,
1265 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1266 BACKGROUND-P non-nil means COLOR is used as a background.
1267 Otherwise, this function tells whether it can be used as a foreground.
1268 If FRAME is nil or omitted, use the selected frame.
1269 COLOR must be a valid color name. */)
1270 (Lisp_Object color
, Lisp_Object frame
, Lisp_Object background_p
)
1274 CHECK_STRING (color
);
1276 frame
= selected_frame
;
1278 CHECK_FRAME (frame
);
1280 if (face_color_supported_p (f
, SSDATA (color
), !NILP (background_p
)))
1286 /* Load color with name NAME for use by face FACE on frame F.
1287 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1288 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1289 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1290 pixel color. If color cannot be loaded, display a message, and
1291 return the foreground, background or underline color of F, but
1292 record that fact in flags of the face so that we don't try to free
1296 load_color (struct frame
*f
, struct face
*face
, Lisp_Object name
,
1297 enum lface_attribute_index target_index
)
1301 eassert (STRINGP (name
));
1302 eassert (target_index
== LFACE_FOREGROUND_INDEX
1303 || target_index
== LFACE_BACKGROUND_INDEX
1304 || target_index
== LFACE_UNDERLINE_INDEX
1305 || target_index
== LFACE_OVERLINE_INDEX
1306 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1307 || target_index
== LFACE_BOX_INDEX
);
1309 /* if the color map is full, defined_color will return a best match
1310 to the values in an existing cell. */
1311 if (!defined_color (f
, SSDATA (name
), &color
, 1))
1313 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1315 switch (target_index
)
1317 case LFACE_FOREGROUND_INDEX
:
1318 face
->foreground_defaulted_p
= 1;
1319 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1322 case LFACE_BACKGROUND_INDEX
:
1323 face
->background_defaulted_p
= 1;
1324 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1327 case LFACE_UNDERLINE_INDEX
:
1328 face
->underline_defaulted_p
= 1;
1329 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1332 case LFACE_OVERLINE_INDEX
:
1333 face
->overline_color_defaulted_p
= 1;
1334 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1337 case LFACE_STRIKE_THROUGH_INDEX
:
1338 face
->strike_through_color_defaulted_p
= 1;
1339 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1342 case LFACE_BOX_INDEX
:
1343 face
->box_color_defaulted_p
= 1;
1344 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1353 ++ncolors_allocated
;
1360 #ifdef HAVE_WINDOW_SYSTEM
1362 /* Load colors for face FACE which is used on frame F. Colors are
1363 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1364 of ATTRS. If the background color specified is not supported on F,
1365 try to emulate gray colors with a stipple from Vface_default_stipple. */
1368 load_face_colors (struct frame
*f
, struct face
*face
, Lisp_Object
*attrs
)
1372 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1373 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1375 /* Swap colors if face is inverse-video. */
1376 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1384 /* Check for support for foreground, not for background because
1385 face_color_supported_p is smart enough to know that grays are
1386 "supported" as background because we are supposed to use stipple
1388 if (!face_color_supported_p (f
, SSDATA (bg
), 0)
1389 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1391 x_destroy_bitmap (f
, face
->stipple
);
1392 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1393 &face
->pixmap_w
, &face
->pixmap_h
);
1396 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1397 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1401 /* Free color PIXEL on frame F. */
1404 unload_color (struct frame
*f
, long unsigned int pixel
)
1406 #ifdef HAVE_X_WINDOWS
1410 x_free_colors (f
, &pixel
, 1);
1417 /* Free colors allocated for FACE. */
1420 free_face_colors (struct frame
*f
, struct face
*face
)
1422 /* PENDING(NS): need to do something here? */
1423 #ifdef HAVE_X_WINDOWS
1424 if (face
->colors_copied_bitwise_p
)
1429 if (!face
->foreground_defaulted_p
)
1431 x_free_colors (f
, &face
->foreground
, 1);
1432 IF_DEBUG (--ncolors_allocated
);
1435 if (!face
->background_defaulted_p
)
1437 x_free_colors (f
, &face
->background
, 1);
1438 IF_DEBUG (--ncolors_allocated
);
1441 if (face
->underline_p
1442 && !face
->underline_defaulted_p
)
1444 x_free_colors (f
, &face
->underline_color
, 1);
1445 IF_DEBUG (--ncolors_allocated
);
1448 if (face
->overline_p
1449 && !face
->overline_color_defaulted_p
)
1451 x_free_colors (f
, &face
->overline_color
, 1);
1452 IF_DEBUG (--ncolors_allocated
);
1455 if (face
->strike_through_p
1456 && !face
->strike_through_color_defaulted_p
)
1458 x_free_colors (f
, &face
->strike_through_color
, 1);
1459 IF_DEBUG (--ncolors_allocated
);
1462 if (face
->box
!= FACE_NO_BOX
1463 && !face
->box_color_defaulted_p
)
1465 x_free_colors (f
, &face
->box_color
, 1);
1466 IF_DEBUG (--ncolors_allocated
);
1470 #endif /* HAVE_X_WINDOWS */
1473 #endif /* HAVE_WINDOW_SYSTEM */
1477 /***********************************************************************
1479 ***********************************************************************/
1481 /* An enumerator for each field of an XLFD font name. */
1502 /* An enumerator for each possible slant value of a font. Taken from
1503 the XLFD specification. */
1511 XLFD_SLANT_REVERSE_ITALIC
,
1512 XLFD_SLANT_REVERSE_OBLIQUE
,
1516 /* Relative font weight according to XLFD documentation. */
1520 XLFD_WEIGHT_UNKNOWN
,
1521 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1522 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1523 XLFD_WEIGHT_LIGHT
, /* 30 */
1524 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1525 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1526 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1527 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1528 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1529 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1532 /* Relative proportionate width. */
1536 XLFD_SWIDTH_UNKNOWN
,
1537 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1538 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1539 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1540 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1541 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1542 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1543 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1544 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1545 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1548 /* Order by which font selection chooses fonts. The default values
1549 mean `first, find a best match for the font width, then for the
1550 font height, then for weight, then for slant.' This variable can be
1551 set via set-face-font-sort-order. */
1553 static int font_sort_order
[4];
1555 #ifdef HAVE_WINDOW_SYSTEM
1557 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1560 compare_fonts_by_sort_order (const void *v1
, const void *v2
)
1562 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1563 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1566 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1568 enum font_property_index idx
= font_props_for_sorting
[i
];
1569 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1572 if (idx
<= FONT_REGISTRY_INDEX
)
1575 result
= STRINGP (val2
) ? strcmp (SSDATA (val1
), SSDATA (val2
)) : -1;
1577 result
= STRINGP (val2
) ? 1 : 0;
1581 if (INTEGERP (val1
))
1582 result
= (INTEGERP (val2
) && XINT (val1
) >= XINT (val2
)
1583 ? XINT (val1
) > XINT (val2
)
1586 result
= INTEGERP (val2
) ? 1 : 0;
1594 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1595 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1596 If FAMILY is omitted or nil, list all families.
1597 Otherwise, FAMILY must be a string, possibly containing wildcards
1599 If FRAME is omitted or nil, use the selected frame.
1600 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1601 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1602 FAMILY is the font family name. POINT-SIZE is the size of the
1603 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1604 width, weight and slant of the font. These symbols are the same as for
1605 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1606 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1607 giving the registry and encoding of the font.
1608 The result list is sorted according to the current setting of
1609 the face font sort order. */)
1610 (Lisp_Object family
, Lisp_Object frame
)
1612 Lisp_Object font_spec
, list
, *drivers
, vec
;
1613 ptrdiff_t i
, nfonts
;
1619 frame
= selected_frame
;
1620 CHECK_LIVE_FRAME (frame
);
1622 font_spec
= Ffont_spec (0, NULL
);
1625 CHECK_STRING (family
);
1626 font_parse_family_registry (family
, Qnil
, font_spec
);
1629 list
= font_list_entities (frame
, font_spec
);
1633 /* Sort the font entities. */
1634 for (i
= 0; i
< 4; i
++)
1635 switch (font_sort_order
[i
])
1638 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1639 case XLFD_POINT_SIZE
:
1640 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1642 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1644 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1646 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1647 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1648 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1649 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1651 ndrivers
= XINT (Flength (list
));
1652 SAFE_ALLOCA_LISP (drivers
, ndrivers
);
1653 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1654 drivers
[i
] = XCAR (list
);
1655 vec
= Fvconcat (ndrivers
, drivers
);
1656 nfonts
= ASIZE (vec
);
1658 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1659 compare_fonts_by_sort_order
);
1662 for (i
= nfonts
- 1; i
>= 0; --i
)
1664 Lisp_Object font
= AREF (vec
, i
);
1665 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1667 Lisp_Object spacing
;
1669 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1670 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1671 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1672 XFRAME (frame
)->resy
);
1673 ASET (v
, 2, make_number (point
));
1674 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1675 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1676 spacing
= Ffont_get (font
, QCspacing
);
1677 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1678 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1679 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1681 result
= Fcons (v
, result
);
1688 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1689 doc
: /* Return a list of the names of available fonts matching PATTERN.
1690 If optional arguments FACE and FRAME are specified, return only fonts
1691 the same size as FACE on FRAME.
1693 PATTERN should be a string containing a font name in the XLFD,
1694 Fontconfig, or GTK format. A font name given in the XLFD format may
1695 contain wildcard characters:
1696 the * character matches any substring, and
1697 the ? character matches any single character.
1698 PATTERN is case-insensitive.
1700 The return value is a list of strings, suitable as arguments to
1703 Fonts Emacs can't use may or may not be excluded
1704 even if they match PATTERN and FACE.
1705 The optional fourth argument MAXIMUM sets a limit on how many
1706 fonts to match. The first MAXIMUM fonts are reported.
1707 The optional fifth argument WIDTH, if specified, is a number of columns
1708 occupied by a character of a font. In that case, return only fonts
1709 the WIDTH times as wide as FACE on FRAME. */)
1710 (Lisp_Object pattern
, Lisp_Object face
, Lisp_Object frame
,
1711 Lisp_Object maximum
, Lisp_Object width
)
1714 int size
, avgwidth
IF_LINT (= 0);
1717 CHECK_STRING (pattern
);
1719 if (! NILP (maximum
))
1720 CHECK_NATNUM (maximum
);
1723 CHECK_NUMBER (width
);
1725 /* We can't simply call check_x_frame because this function may be
1726 called before any frame is created. */
1728 frame
= selected_frame
;
1729 f
= frame_or_selected_frame (frame
, 2);
1730 if (! FRAME_WINDOW_P (f
))
1732 /* Perhaps we have not yet created any frame. */
1738 /* Determine the width standard for comparison with the fonts we find. */
1744 /* This is of limited utility since it works with character
1745 widths. Keep it for compatibility. --gerd. */
1746 int face_id
= lookup_named_face (f
, face
, 0);
1747 struct face
*width_face
= (face_id
< 0
1749 : FACE_FROM_ID (f
, face_id
));
1751 if (width_face
&& width_face
->font
)
1753 size
= width_face
->font
->pixel_size
;
1754 avgwidth
= width_face
->font
->average_width
;
1758 size
= FRAME_FONT (f
)->pixel_size
;
1759 avgwidth
= FRAME_FONT (f
)->average_width
;
1762 avgwidth
*= XINT (width
);
1766 Lisp_Object font_spec
;
1767 Lisp_Object args
[2], tail
;
1769 font_spec
= font_spec_from_name (pattern
);
1770 if (!FONTP (font_spec
))
1771 signal_error ("Invalid font name", pattern
);
1775 Ffont_put (font_spec
, QCsize
, make_number (size
));
1776 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1778 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1779 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1781 Lisp_Object font_entity
;
1783 font_entity
= XCAR (tail
);
1784 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1785 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1786 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1788 /* This is a scalable font. For backward compatibility,
1789 we set the specified size. */
1790 font_entity
= copy_font_spec (font_entity
);
1791 ASET (font_entity
, FONT_SIZE_INDEX
,
1792 AREF (font_spec
, FONT_SIZE_INDEX
));
1794 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1797 /* We don't have to check fontsets. */
1799 args
[1] = list_fontsets (f
, pattern
, size
);
1800 return Fnconc (2, args
);
1804 #endif /* HAVE_WINDOW_SYSTEM */
1807 /***********************************************************************
1809 ***********************************************************************/
1811 /* Access face attributes of face LFACE, a Lisp vector. */
1813 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1814 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1815 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1816 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1817 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1818 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1819 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1820 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1821 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1822 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1823 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1824 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1825 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1826 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1827 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1828 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1829 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1831 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1832 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1834 #define LFACEP(LFACE) \
1836 && ASIZE (LFACE) == LFACE_VECTOR_SIZE \
1837 && EQ (AREF (LFACE, 0), Qface))
1842 /* Check consistency of Lisp face attribute vector ATTRS. */
1845 check_lface_attrs (Lisp_Object
*attrs
)
1847 eassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1848 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1849 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1850 eassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1851 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1852 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1853 eassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1854 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1855 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1856 eassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1857 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1858 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1859 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1860 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1861 eassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1862 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1863 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1864 eassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1865 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
1866 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
1867 eassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
1868 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
1869 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
1870 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
])
1871 || CONSP (attrs
[LFACE_UNDERLINE_INDEX
]));
1872 eassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
1873 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
1874 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
1875 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
1876 eassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1877 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1878 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
1879 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
1880 eassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
1881 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
1882 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
1883 || STRINGP (attrs
[LFACE_BOX_INDEX
])
1884 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
1885 || CONSP (attrs
[LFACE_BOX_INDEX
]));
1886 eassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
1887 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
1888 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
1889 eassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
1890 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
1891 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
1892 eassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
1893 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
1894 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
1895 eassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
1896 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
1897 || NILP (attrs
[LFACE_INHERIT_INDEX
])
1898 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
1899 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
1900 #ifdef HAVE_WINDOW_SYSTEM
1901 eassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
1902 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
1903 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
1904 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
1905 eassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
1906 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
1907 || FONTP (attrs
[LFACE_FONT_INDEX
]));
1908 eassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
1909 || STRINGP (attrs
[LFACE_FONTSET_INDEX
])
1910 || NILP (attrs
[LFACE_FONTSET_INDEX
]));
1915 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
1918 check_lface (Lisp_Object lface
)
1922 eassert (LFACEP (lface
));
1923 check_lface_attrs (XVECTOR (lface
)->contents
);
1927 #else /* not GLYPH_DEBUG */
1929 #define check_lface_attrs(attrs) (void) 0
1930 #define check_lface(lface) (void) 0
1932 #endif /* GLYPH_DEBUG */
1936 /* Face-merge cycle checking. */
1938 enum named_merge_point_kind
1940 NAMED_MERGE_POINT_NORMAL
,
1941 NAMED_MERGE_POINT_REMAP
1944 /* A `named merge point' is simply a point during face-merging where we
1945 look up a face by name. We keep a stack of which named lookups we're
1946 currently processing so that we can easily detect cycles, using a
1947 linked- list of struct named_merge_point structures, typically
1948 allocated on the stack frame of the named lookup functions which are
1949 active (so no consing is required). */
1950 struct named_merge_point
1952 Lisp_Object face_name
;
1953 enum named_merge_point_kind named_merge_point_kind
;
1954 struct named_merge_point
*prev
;
1958 /* If a face merging cycle is detected for FACE_NAME, return 0,
1959 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
1960 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
1961 pointed to by NAMED_MERGE_POINTS, and return 1. */
1964 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
1965 Lisp_Object face_name
,
1966 enum named_merge_point_kind named_merge_point_kind
,
1967 struct named_merge_point
**named_merge_points
)
1969 struct named_merge_point
*prev
;
1971 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
1972 if (EQ (face_name
, prev
->face_name
))
1974 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
1975 /* A cycle, so fail. */
1977 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
1978 /* A remap `hides ' any previous normal merge points
1979 (because the remap means that it's actually different face),
1980 so as we know the current merge point must be normal, we
1981 can just assume it's OK. */
1985 new_named_merge_point
->face_name
= face_name
;
1986 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
1987 new_named_merge_point
->prev
= *named_merge_points
;
1989 *named_merge_points
= new_named_merge_point
;
1995 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
1996 to make it a symbol. If FACE_NAME is an alias for another face,
1997 return that face's name.
1999 Return default face in case of errors. */
2002 resolve_face_name (Lisp_Object face_name
, int signal_p
)
2004 Lisp_Object orig_face
;
2005 Lisp_Object tortoise
, hare
;
2007 if (STRINGP (face_name
))
2008 face_name
= intern (SSDATA (face_name
));
2010 if (NILP (face_name
) || !SYMBOLP (face_name
))
2013 orig_face
= face_name
;
2014 tortoise
= hare
= face_name
;
2019 hare
= Fget (hare
, Qface_alias
);
2020 if (NILP (hare
) || !SYMBOLP (hare
))
2024 hare
= Fget (hare
, Qface_alias
);
2025 if (NILP (hare
) || !SYMBOLP (hare
))
2028 tortoise
= Fget (tortoise
, Qface_alias
);
2029 if (EQ (hare
, tortoise
))
2032 xsignal1 (Qcircular_list
, orig_face
);
2041 /* Return the face definition of FACE_NAME on frame F. F null means
2042 return the definition for new frames. FACE_NAME may be a string or
2043 a symbol (apparently Emacs 20.2 allowed strings as face names in
2044 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2045 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2046 is zero, value is nil if FACE_NAME is not a valid face name. */
2047 static inline Lisp_Object
2048 lface_from_face_name_no_resolve (struct frame
*f
, Lisp_Object face_name
,
2054 lface
= assq_no_quit (face_name
, f
->face_alist
);
2056 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2059 lface
= XCDR (lface
);
2061 signal_error ("Invalid face", face_name
);
2063 check_lface (lface
);
2068 /* Return the face definition of FACE_NAME on frame F. F null means
2069 return the definition for new frames. FACE_NAME may be a string or
2070 a symbol (apparently Emacs 20.2 allowed strings as face names in
2071 face text properties; Ediff uses that). If FACE_NAME is an alias
2072 for another face, return that face's definition. If SIGNAL_P is
2073 non-zero, signal an error if FACE_NAME is not a valid face name.
2074 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2076 static inline Lisp_Object
2077 lface_from_face_name (struct frame
*f
, Lisp_Object face_name
, int signal_p
)
2079 face_name
= resolve_face_name (face_name
, signal_p
);
2080 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2084 /* Get face attributes of face FACE_NAME from frame-local faces on
2085 frame F. Store the resulting attributes in ATTRS which must point
2086 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2087 is non-zero, signal an error if FACE_NAME does not name a face.
2088 Otherwise, value is zero if FACE_NAME is not a face. */
2091 get_lface_attributes_no_remap (struct frame
*f
, Lisp_Object face_name
,
2092 Lisp_Object
*attrs
, int signal_p
)
2096 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2099 memcpy (attrs
, XVECTOR (lface
)->contents
,
2100 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2102 return !NILP (lface
);
2105 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2106 F. Store the resulting attributes in ATTRS which must point to a
2107 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2108 alias for another face, use that face's definition. If SIGNAL_P is
2109 non-zero, signal an error if FACE_NAME does not name a face.
2110 Otherwise, value is zero if FACE_NAME is not a face. */
2113 get_lface_attributes (struct frame
*f
, Lisp_Object face_name
,
2114 Lisp_Object
*attrs
, int signal_p
,
2115 struct named_merge_point
*named_merge_points
)
2117 Lisp_Object face_remapping
;
2119 face_name
= resolve_face_name (face_name
, signal_p
);
2121 /* See if SYMBOL has been remapped to some other face (usually this
2122 is done buffer-locally). */
2123 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2124 if (CONSP (face_remapping
))
2126 struct named_merge_point named_merge_point
;
2128 if (push_named_merge_point (&named_merge_point
,
2129 face_name
, NAMED_MERGE_POINT_REMAP
,
2130 &named_merge_points
))
2134 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2135 attrs
[i
] = Qunspecified
;
2137 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2138 signal_p
, named_merge_points
);
2142 /* Default case, no remapping. */
2143 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2147 /* Non-zero if all attributes in face attribute vector ATTRS are
2148 specified, i.e. are non-nil. */
2151 lface_fully_specified_p (Lisp_Object
*attrs
)
2155 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2156 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2157 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2160 return i
== LFACE_VECTOR_SIZE
;
2163 #ifdef HAVE_WINDOW_SYSTEM
2165 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2166 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2167 exception is `font' attribute. It is set to FONT_OBJECT regardless
2171 set_lface_from_font (struct frame
*f
, Lisp_Object lface
,
2172 Lisp_Object font_object
, int force_p
)
2175 struct font
*font
= XFONT_OBJECT (font_object
);
2177 /* Set attributes only if unspecified, otherwise face defaults for
2178 new frames would never take effect. If the font doesn't have a
2179 specific property, set a normal value for that. */
2181 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2183 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2185 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2188 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2190 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2192 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2195 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2197 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2200 LFACE_HEIGHT (lface
) = make_number (pt
);
2203 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2205 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2206 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2208 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2210 val
= FONT_SLANT_FOR_FACE (font_object
);
2211 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2213 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2215 val
= FONT_WIDTH_FOR_FACE (font_object
);
2216 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2219 LFACE_FONT (lface
) = font_object
;
2223 #endif /* HAVE_WINDOW_SYSTEM */
2226 /* Merges the face height FROM with the face height TO, and returns the
2227 merged height. If FROM is an invalid height, then INVALID is
2228 returned instead. FROM and TO may be either absolute face heights or
2229 `relative' heights; the returned value is always an absolute height
2230 unless both FROM and TO are relative. */
2233 merge_face_heights (Lisp_Object from
, Lisp_Object to
, Lisp_Object invalid
)
2235 Lisp_Object result
= invalid
;
2237 if (INTEGERP (from
))
2238 /* FROM is absolute, just use it as is. */
2240 else if (FLOATP (from
))
2241 /* FROM is a scale, use it to adjust TO. */
2244 /* relative X absolute => absolute */
2245 result
= make_number (XFLOAT_DATA (from
) * XINT (to
));
2246 else if (FLOATP (to
))
2247 /* relative X relative => relative */
2248 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2249 else if (UNSPECIFIEDP (to
))
2252 else if (FUNCTIONP (from
))
2253 /* FROM is a function, which use to adjust TO. */
2255 /* Call function with current height as argument.
2256 From is the new height. */
2257 result
= safe_call1 (from
, to
);
2259 /* Ensure that if TO was absolute, so is the result. */
2260 if (INTEGERP (to
) && !INTEGERP (result
))
2268 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2269 store the resulting attributes in TO, which must be already be
2270 completely specified and contain only absolute attributes. Every
2271 specified attribute of FROM overrides the corresponding attribute of
2272 TO; relative attributes in FROM are merged with the absolute value in
2273 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2274 loops in face inheritance/remapping; it should be 0 when called from
2278 merge_face_vectors (struct frame
*f
, Lisp_Object
*from
, Lisp_Object
*to
,
2279 struct named_merge_point
*named_merge_points
)
2283 /* If FROM inherits from some other faces, merge their attributes into
2284 TO before merging FROM's direct attributes. Note that an :inherit
2285 attribute of `unspecified' is the same as one of nil; we never
2286 merge :inherit attributes, so nil is more correct, but lots of
2287 other code uses `unspecified' as a generic value for face attributes. */
2288 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2289 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2290 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2292 i
= LFACE_FONT_INDEX
;
2293 if (!UNSPECIFIEDP (from
[i
]))
2295 if (!UNSPECIFIEDP (to
[i
]))
2296 to
[i
] = merge_font_spec (from
[i
], to
[i
]);
2298 to
[i
] = copy_font_spec (from
[i
]);
2299 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2300 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2301 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2302 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2303 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2304 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2305 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2306 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2307 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2308 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2309 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2312 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2313 if (!UNSPECIFIEDP (from
[i
]))
2315 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2317 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2318 font_clear_prop (to
, FONT_SIZE_INDEX
);
2320 else if (i
!= LFACE_FONT_INDEX
2321 && ! EQ (to
[i
], from
[i
]))
2324 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2325 font_clear_prop (to
,
2326 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2327 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2328 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2329 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2330 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2331 : FONT_SLANT_INDEX
));
2335 /* TO is always an absolute face, which should inherit from nothing.
2336 We blindly copy the :inherit attribute above and fix it up here. */
2337 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2340 /* Merge the named face FACE_NAME on frame F, into the vector of face
2341 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2342 inheritance. Returns true if FACE_NAME is a valid face name and
2343 merging succeeded. */
2346 merge_named_face (struct frame
*f
, Lisp_Object face_name
, Lisp_Object
*to
,
2347 struct named_merge_point
*named_merge_points
)
2349 struct named_merge_point named_merge_point
;
2351 if (push_named_merge_point (&named_merge_point
,
2352 face_name
, NAMED_MERGE_POINT_NORMAL
,
2353 &named_merge_points
))
2355 struct gcpro gcpro1
;
2356 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2357 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2361 GCPRO1 (named_merge_point
.face_name
);
2362 merge_face_vectors (f
, from
, to
, named_merge_points
);
2373 /* Merge face attributes from the lisp `face reference' FACE_REF on
2374 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2375 problems with FACE_REF cause an error message to be shown. Return
2376 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2377 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2378 list structure; it may be 0 for most callers.
2380 FACE_REF may be a single face specification or a list of such
2381 specifications. Each face specification can be:
2383 1. A symbol or string naming a Lisp face.
2385 2. A property list of the form (KEYWORD VALUE ...) where each
2386 KEYWORD is a face attribute name, and value is an appropriate value
2389 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2390 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2391 for compatibility with 20.2.
2393 Face specifications earlier in lists take precedence over later
2397 merge_face_ref (struct frame
*f
, Lisp_Object face_ref
, Lisp_Object
*to
,
2398 int err_msgs
, struct named_merge_point
*named_merge_points
)
2400 int ok
= 1; /* Succeed without an error? */
2402 if (CONSP (face_ref
))
2404 Lisp_Object first
= XCAR (face_ref
);
2406 if (EQ (first
, Qforeground_color
)
2407 || EQ (first
, Qbackground_color
))
2409 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2410 . COLOR). COLOR must be a string. */
2411 Lisp_Object color_name
= XCDR (face_ref
);
2412 Lisp_Object color
= first
;
2414 if (STRINGP (color_name
))
2416 if (EQ (color
, Qforeground_color
))
2417 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2419 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2424 add_to_log ("Invalid face color", color_name
, Qnil
);
2428 else if (SYMBOLP (first
)
2429 && *SDATA (SYMBOL_NAME (first
)) == ':')
2431 /* Assume this is the property list form. */
2432 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2434 Lisp_Object keyword
= XCAR (face_ref
);
2435 Lisp_Object value
= XCAR (XCDR (face_ref
));
2438 /* Specifying `unspecified' is a no-op. */
2439 if (EQ (value
, Qunspecified
))
2441 else if (EQ (keyword
, QCfamily
))
2443 if (STRINGP (value
))
2445 to
[LFACE_FAMILY_INDEX
] = value
;
2446 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2451 else if (EQ (keyword
, QCfoundry
))
2453 if (STRINGP (value
))
2455 to
[LFACE_FOUNDRY_INDEX
] = value
;
2456 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2461 else if (EQ (keyword
, QCheight
))
2463 Lisp_Object new_height
=
2464 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2466 if (! NILP (new_height
))
2468 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2469 font_clear_prop (to
, FONT_SIZE_INDEX
);
2474 else if (EQ (keyword
, QCweight
))
2476 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2478 to
[LFACE_WEIGHT_INDEX
] = value
;
2479 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2484 else if (EQ (keyword
, QCslant
))
2486 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2488 to
[LFACE_SLANT_INDEX
] = value
;
2489 font_clear_prop (to
, FONT_SLANT_INDEX
);
2494 else if (EQ (keyword
, QCunderline
))
2500 to
[LFACE_UNDERLINE_INDEX
] = value
;
2504 else if (EQ (keyword
, QCoverline
))
2509 to
[LFACE_OVERLINE_INDEX
] = value
;
2513 else if (EQ (keyword
, QCstrike_through
))
2518 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2522 else if (EQ (keyword
, QCbox
))
2525 value
= make_number (1);
2526 if (INTEGERP (value
)
2530 to
[LFACE_BOX_INDEX
] = value
;
2534 else if (EQ (keyword
, QCinverse_video
)
2535 || EQ (keyword
, QCreverse_video
))
2537 if (EQ (value
, Qt
) || NILP (value
))
2538 to
[LFACE_INVERSE_INDEX
] = value
;
2542 else if (EQ (keyword
, QCforeground
))
2544 if (STRINGP (value
))
2545 to
[LFACE_FOREGROUND_INDEX
] = value
;
2549 else if (EQ (keyword
, QCbackground
))
2551 if (STRINGP (value
))
2552 to
[LFACE_BACKGROUND_INDEX
] = value
;
2556 else if (EQ (keyword
, QCstipple
))
2558 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
2559 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2560 if (!NILP (pixmap_p
))
2561 to
[LFACE_STIPPLE_INDEX
] = value
;
2566 else if (EQ (keyword
, QCwidth
))
2568 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2570 to
[LFACE_SWIDTH_INDEX
] = value
;
2571 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2576 else if (EQ (keyword
, QCinherit
))
2578 /* This is not really very useful; it's just like a
2579 normal face reference. */
2580 if (! merge_face_ref (f
, value
, to
,
2581 err_msgs
, named_merge_points
))
2589 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2593 face_ref
= XCDR (XCDR (face_ref
));
2598 /* This is a list of face refs. Those at the beginning of the
2599 list take precedence over what follows, so we have to merge
2600 from the end backwards. */
2601 Lisp_Object next
= XCDR (face_ref
);
2604 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2606 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2612 /* FACE_REF ought to be a face name. */
2613 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2614 if (!ok
&& err_msgs
)
2615 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2622 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2623 Sinternal_make_lisp_face
, 1, 2, 0,
2624 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2625 If FACE was not known as a face before, create a new one.
2626 If optional argument FRAME is specified, make a frame-local face
2627 for that frame. Otherwise operate on the global face definition.
2628 Value is a vector of face attributes. */)
2629 (Lisp_Object face
, Lisp_Object frame
)
2631 Lisp_Object global_lface
, lface
;
2635 CHECK_SYMBOL (face
);
2636 global_lface
= lface_from_face_name (NULL
, face
, 0);
2640 CHECK_LIVE_FRAME (frame
);
2642 lface
= lface_from_face_name (f
, face
, 0);
2645 f
= NULL
, lface
= Qnil
;
2647 /* Add a global definition if there is none. */
2648 if (NILP (global_lface
))
2650 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2652 ASET (global_lface
, 0, Qface
);
2653 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2654 Vface_new_frame_defaults
);
2656 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2657 face id to Lisp face is given by the vector lface_id_to_name.
2658 The mapping from Lisp face to Lisp face id is given by the
2659 property `face' of the Lisp face name. */
2660 if (next_lface_id
== lface_id_to_name_size
)
2662 xpalloc (lface_id_to_name
, &lface_id_to_name_size
, 1, MAX_FACE_ID
,
2663 sizeof *lface_id_to_name
);
2665 lface_id_to_name
[next_lface_id
] = face
;
2666 Fput (face
, Qface
, make_number (next_lface_id
));
2670 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2671 ASET (global_lface
, i
, Qunspecified
);
2673 /* Add a frame-local definition. */
2678 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2680 ASET (lface
, 0, Qface
);
2681 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2684 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2685 ASET (lface
, i
, Qunspecified
);
2688 lface
= global_lface
;
2690 /* Changing a named face means that all realized faces depending on
2691 that face are invalid. Since we cannot tell which realized faces
2692 depend on the face, make sure they are all removed. This is done
2693 by incrementing face_change_count. The next call to
2694 init_iterator will then free realized faces. */
2695 if (NILP (Fget (face
, Qface_no_inherit
)))
2697 ++face_change_count
;
2698 ++windows_or_buffers_changed
;
2701 eassert (LFACEP (lface
));
2702 check_lface (lface
);
2707 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2708 Sinternal_lisp_face_p
, 1, 2, 0,
2709 doc
: /* Return non-nil if FACE names a face.
2710 FACE should be a symbol or string.
2711 If optional second argument FRAME is non-nil, check for the
2712 existence of a frame-local face with name FACE on that frame.
2713 Otherwise check for the existence of a global face. */)
2714 (Lisp_Object face
, Lisp_Object frame
)
2718 face
= resolve_face_name (face
, 1);
2722 CHECK_LIVE_FRAME (frame
);
2723 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2726 lface
= lface_from_face_name (NULL
, face
, 0);
2732 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2733 Sinternal_copy_lisp_face
, 4, 4, 0,
2734 doc
: /* Copy face FROM to TO.
2735 If FRAME is t, copy the global face definition of FROM.
2736 Otherwise, copy the frame-local definition of FROM on FRAME.
2737 If NEW-FRAME is a frame, copy that data into the frame-local
2738 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2739 FRAME controls where the data is copied to.
2741 The value is TO. */)
2742 (Lisp_Object from
, Lisp_Object to
, Lisp_Object frame
, Lisp_Object new_frame
)
2744 Lisp_Object lface
, copy
;
2746 CHECK_SYMBOL (from
);
2751 /* Copy global definition of FROM. We don't make copies of
2752 strings etc. because 20.2 didn't do it either. */
2753 lface
= lface_from_face_name (NULL
, from
, 1);
2754 copy
= Finternal_make_lisp_face (to
, Qnil
);
2758 /* Copy frame-local definition of FROM. */
2759 if (NILP (new_frame
))
2761 CHECK_LIVE_FRAME (frame
);
2762 CHECK_LIVE_FRAME (new_frame
);
2763 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2764 copy
= Finternal_make_lisp_face (to
, new_frame
);
2767 memcpy (XVECTOR (copy
)->contents
, XVECTOR (lface
)->contents
,
2768 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2770 /* Changing a named face means that all realized faces depending on
2771 that face are invalid. Since we cannot tell which realized faces
2772 depend on the face, make sure they are all removed. This is done
2773 by incrementing face_change_count. The next call to
2774 init_iterator will then free realized faces. */
2775 if (NILP (Fget (to
, Qface_no_inherit
)))
2777 ++face_change_count
;
2778 ++windows_or_buffers_changed
;
2785 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2786 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2787 doc
: /* Set attribute ATTR of FACE to VALUE.
2788 FRAME being a frame means change the face on that frame.
2789 FRAME nil means change the face of the selected frame.
2790 FRAME t means change the default for new frames.
2791 FRAME 0 means change the face on all frames, and change the default
2793 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
2796 Lisp_Object old_value
= Qnil
;
2797 /* Set one of enum font_property_index (> 0) if ATTR is one of
2798 font-related attributes other than QCfont and QCfontset. */
2799 enum font_property_index prop_index
= 0;
2801 CHECK_SYMBOL (face
);
2802 CHECK_SYMBOL (attr
);
2804 face
= resolve_face_name (face
, 1);
2806 /* If FRAME is 0, change face on all frames, and change the
2807 default for new frames. */
2808 if (INTEGERP (frame
) && XINT (frame
) == 0)
2811 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2812 FOR_EACH_FRAME (tail
, frame
)
2813 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
2817 /* Set lface to the Lisp attribute vector of FACE. */
2820 lface
= lface_from_face_name (NULL
, face
, 1);
2822 /* When updating face-new-frame-defaults, we put :ignore-defface
2823 where the caller wants `unspecified'. This forces the frame
2824 defaults to ignore the defface value. Otherwise, the defface
2825 will take effect, which is generally not what is intended.
2826 The value of that attribute will be inherited from some other
2827 face during face merging. See internal_merge_in_global_face. */
2828 if (UNSPECIFIEDP (value
))
2829 value
= QCignore_defface
;
2834 frame
= selected_frame
;
2836 CHECK_LIVE_FRAME (frame
);
2837 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2839 /* If a frame-local face doesn't exist yet, create one. */
2841 lface
= Finternal_make_lisp_face (face
, frame
);
2844 if (EQ (attr
, QCfamily
))
2846 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2848 CHECK_STRING (value
);
2849 if (SCHARS (value
) == 0)
2850 signal_error ("Invalid face family", value
);
2852 old_value
= LFACE_FAMILY (lface
);
2853 LFACE_FAMILY (lface
) = value
;
2854 prop_index
= FONT_FAMILY_INDEX
;
2856 else if (EQ (attr
, QCfoundry
))
2858 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2860 CHECK_STRING (value
);
2861 if (SCHARS (value
) == 0)
2862 signal_error ("Invalid face foundry", value
);
2864 old_value
= LFACE_FOUNDRY (lface
);
2865 LFACE_FOUNDRY (lface
) = value
;
2866 prop_index
= FONT_FOUNDRY_INDEX
;
2868 else if (EQ (attr
, QCheight
))
2870 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2872 if (EQ (face
, Qdefault
))
2874 /* The default face must have an absolute size. */
2875 if (!INTEGERP (value
) || XINT (value
) <= 0)
2876 signal_error ("Default face height not absolute and positive",
2881 /* For non-default faces, do a test merge with a random
2882 height to see if VALUE's ok. */
2883 Lisp_Object test
= merge_face_heights (value
,
2886 if (!INTEGERP (test
) || XINT (test
) <= 0)
2887 signal_error ("Face height does not produce a positive integer",
2892 old_value
= LFACE_HEIGHT (lface
);
2893 LFACE_HEIGHT (lface
) = value
;
2894 prop_index
= FONT_SIZE_INDEX
;
2896 else if (EQ (attr
, QCweight
))
2898 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2900 CHECK_SYMBOL (value
);
2901 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
2902 signal_error ("Invalid face weight", value
);
2904 old_value
= LFACE_WEIGHT (lface
);
2905 LFACE_WEIGHT (lface
) = value
;
2906 prop_index
= FONT_WEIGHT_INDEX
;
2908 else if (EQ (attr
, QCslant
))
2910 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2912 CHECK_SYMBOL (value
);
2913 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
2914 signal_error ("Invalid face slant", value
);
2916 old_value
= LFACE_SLANT (lface
);
2917 LFACE_SLANT (lface
) = value
;
2918 prop_index
= FONT_SLANT_INDEX
;
2920 else if (EQ (attr
, QCunderline
))
2924 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
2926 else if (NILP (value
) || EQ (value
, Qt
))
2928 else if (STRINGP (value
) && SCHARS (value
) > 0)
2930 else if (CONSP (value
))
2932 Lisp_Object key
, val
, list
;
2937 while (!NILP (CAR_SAFE(list
)))
2939 key
= CAR_SAFE (list
);
2940 list
= CDR_SAFE (list
);
2941 val
= CAR_SAFE (list
);
2942 list
= CDR_SAFE (list
);
2944 if (NILP (key
) || NILP (val
))
2950 else if (EQ (key
, QCcolor
)
2951 && !(EQ (val
, Qforeground_color
)
2952 || (STRINGP (val
) && SCHARS (val
) > 0)))
2958 else if (EQ (key
, QCstyle
)
2959 && !(EQ (val
, Qline
) || EQ (val
, Qwave
)))
2968 signal_error ("Invalid face underline", value
);
2970 old_value
= LFACE_UNDERLINE (lface
);
2971 LFACE_UNDERLINE (lface
) = value
;
2973 else if (EQ (attr
, QCoverline
))
2975 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2976 if ((SYMBOLP (value
)
2978 && !EQ (value
, Qnil
))
2979 /* Overline color. */
2981 && SCHARS (value
) == 0))
2982 signal_error ("Invalid face overline", value
);
2984 old_value
= LFACE_OVERLINE (lface
);
2985 LFACE_OVERLINE (lface
) = value
;
2987 else if (EQ (attr
, QCstrike_through
))
2989 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
2990 if ((SYMBOLP (value
)
2992 && !EQ (value
, Qnil
))
2993 /* Strike-through color. */
2995 && SCHARS (value
) == 0))
2996 signal_error ("Invalid face strike-through", value
);
2998 old_value
= LFACE_STRIKE_THROUGH (lface
);
2999 LFACE_STRIKE_THROUGH (lface
) = value
;
3001 else if (EQ (attr
, QCbox
))
3005 /* Allow t meaning a simple box of width 1 in foreground color
3008 value
= make_number (1);
3010 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3012 else if (NILP (value
))
3014 else if (INTEGERP (value
))
3015 valid_p
= XINT (value
) != 0;
3016 else if (STRINGP (value
))
3017 valid_p
= SCHARS (value
) > 0;
3018 else if (CONSP (value
))
3034 if (EQ (k
, QCline_width
))
3036 if (!INTEGERP (v
) || XINT (v
) == 0)
3039 else if (EQ (k
, QCcolor
))
3041 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3044 else if (EQ (k
, QCstyle
))
3046 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3053 valid_p
= NILP (tem
);
3059 signal_error ("Invalid face box", value
);
3061 old_value
= LFACE_BOX (lface
);
3062 LFACE_BOX (lface
) = value
;
3064 else if (EQ (attr
, QCinverse_video
)
3065 || EQ (attr
, QCreverse_video
))
3067 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3069 CHECK_SYMBOL (value
);
3070 if (!EQ (value
, Qt
) && !NILP (value
))
3071 signal_error ("Invalid inverse-video face attribute value", value
);
3073 old_value
= LFACE_INVERSE (lface
);
3074 LFACE_INVERSE (lface
) = value
;
3076 else if (EQ (attr
, QCforeground
))
3078 /* Compatibility with 20.x. */
3080 value
= Qunspecified
;
3081 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3083 /* Don't check for valid color names here because it depends
3084 on the frame (display) whether the color will be valid
3085 when the face is realized. */
3086 CHECK_STRING (value
);
3087 if (SCHARS (value
) == 0)
3088 signal_error ("Empty foreground color value", value
);
3090 old_value
= LFACE_FOREGROUND (lface
);
3091 LFACE_FOREGROUND (lface
) = value
;
3093 else if (EQ (attr
, QCbackground
))
3095 /* Compatibility with 20.x. */
3097 value
= Qunspecified
;
3098 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3100 /* Don't check for valid color names here because it depends
3101 on the frame (display) whether the color will be valid
3102 when the face is realized. */
3103 CHECK_STRING (value
);
3104 if (SCHARS (value
) == 0)
3105 signal_error ("Empty background color value", value
);
3107 old_value
= LFACE_BACKGROUND (lface
);
3108 LFACE_BACKGROUND (lface
) = value
;
3110 else if (EQ (attr
, QCstipple
))
3112 #if defined (HAVE_X_WINDOWS) || defined (HAVE_NS)
3113 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3115 && NILP (Fbitmap_spec_p (value
)))
3116 signal_error ("Invalid stipple attribute", value
);
3117 old_value
= LFACE_STIPPLE (lface
);
3118 LFACE_STIPPLE (lface
) = value
;
3119 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3121 else if (EQ (attr
, QCwidth
))
3123 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3125 CHECK_SYMBOL (value
);
3126 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3127 signal_error ("Invalid face width", value
);
3129 old_value
= LFACE_SWIDTH (lface
);
3130 LFACE_SWIDTH (lface
) = value
;
3131 prop_index
= FONT_WIDTH_INDEX
;
3133 else if (EQ (attr
, QCfont
))
3135 #ifdef HAVE_WINDOW_SYSTEM
3136 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3138 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3142 old_value
= LFACE_FONT (lface
);
3143 if (! FONTP (value
))
3145 if (STRINGP (value
))
3147 Lisp_Object name
= value
;
3148 int fontset
= fs_query_fontset (name
, 0);
3151 name
= fontset_ascii (fontset
);
3152 value
= font_spec_from_name (name
);
3154 signal_error ("Invalid font name", name
);
3157 signal_error ("Invalid font or font-spec", value
);
3160 f
= XFRAME (selected_frame
);
3163 if (! FONT_OBJECT_P (value
))
3165 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3166 Lisp_Object font_object
;
3168 font_object
= font_load_for_lface (f
, attrs
, value
);
3169 if (NILP (font_object
))
3170 signal_error ("Font not available", value
);
3171 value
= font_object
;
3173 set_lface_from_font (f
, lface
, value
, 1);
3176 LFACE_FONT (lface
) = value
;
3178 #endif /* HAVE_WINDOW_SYSTEM */
3180 else if (EQ (attr
, QCfontset
))
3182 #ifdef HAVE_WINDOW_SYSTEM
3183 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3187 old_value
= LFACE_FONTSET (lface
);
3188 tmp
= Fquery_fontset (value
, Qnil
);
3190 signal_error ("Invalid fontset name", value
);
3191 LFACE_FONTSET (lface
) = value
= tmp
;
3193 #endif /* HAVE_WINDOW_SYSTEM */
3195 else if (EQ (attr
, QCinherit
))
3198 if (SYMBOLP (value
))
3201 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3202 if (!SYMBOLP (XCAR (tail
)))
3205 LFACE_INHERIT (lface
) = value
;
3207 signal_error ("Invalid face inheritance", value
);
3209 else if (EQ (attr
, QCbold
))
3211 old_value
= LFACE_WEIGHT (lface
);
3212 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3213 prop_index
= FONT_WEIGHT_INDEX
;
3215 else if (EQ (attr
, QCitalic
))
3218 old_value
= LFACE_SLANT (lface
);
3219 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3220 prop_index
= FONT_SLANT_INDEX
;
3223 signal_error ("Invalid face attribute name", attr
);
3227 /* If a font-related attribute other than QCfont and QCfontset
3228 is specified, and if the original QCfont attribute has a font
3229 (font-spec or font-object), set the corresponding property in
3230 the font to nil so that the font selector doesn't think that
3231 the attribute is mandatory. Also, clear the average
3233 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3236 /* Changing a named face means that all realized faces depending on
3237 that face are invalid. Since we cannot tell which realized faces
3238 depend on the face, make sure they are all removed. This is done
3239 by incrementing face_change_count. The next call to
3240 init_iterator will then free realized faces. */
3242 && NILP (Fget (face
, Qface_no_inherit
))
3243 && NILP (Fequal (old_value
, value
)))
3245 ++face_change_count
;
3246 ++windows_or_buffers_changed
;
3249 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3250 && NILP (Fequal (old_value
, value
)))
3256 if (EQ (face
, Qdefault
))
3258 #ifdef HAVE_WINDOW_SYSTEM
3259 /* Changed font-related attributes of the `default' face are
3260 reflected in changed `font' frame parameters. */
3262 && (prop_index
|| EQ (attr
, QCfont
))
3263 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3264 set_font_frame_param (frame
, lface
);
3266 #endif /* HAVE_WINDOW_SYSTEM */
3268 if (EQ (attr
, QCforeground
))
3269 param
= Qforeground_color
;
3270 else if (EQ (attr
, QCbackground
))
3271 param
= Qbackground_color
;
3273 #ifdef HAVE_WINDOW_SYSTEM
3275 else if (EQ (face
, Qscroll_bar
))
3277 /* Changing the colors of `scroll-bar' sets frame parameters
3278 `scroll-bar-foreground' and `scroll-bar-background'. */
3279 if (EQ (attr
, QCforeground
))
3280 param
= Qscroll_bar_foreground
;
3281 else if (EQ (attr
, QCbackground
))
3282 param
= Qscroll_bar_background
;
3284 #endif /* not WINDOWSNT */
3285 else if (EQ (face
, Qborder
))
3287 /* Changing background color of `border' sets frame parameter
3289 if (EQ (attr
, QCbackground
))
3290 param
= Qborder_color
;
3292 else if (EQ (face
, Qcursor
))
3294 /* Changing background color of `cursor' sets frame parameter
3296 if (EQ (attr
, QCbackground
))
3297 param
= Qcursor_color
;
3299 else if (EQ (face
, Qmouse
))
3301 /* Changing background color of `mouse' sets frame parameter
3303 if (EQ (attr
, QCbackground
))
3304 param
= Qmouse_color
;
3306 #endif /* HAVE_WINDOW_SYSTEM */
3307 else if (EQ (face
, Qmenu
))
3309 /* Indicate that we have to update the menu bar when
3310 realizing faces on FRAME. FRAME t change the
3311 default for new frames. We do this by setting
3312 setting the flag in new face caches */
3315 struct frame
*f
= XFRAME (frame
);
3316 if (FRAME_FACE_CACHE (f
) == NULL
)
3317 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3318 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3321 menu_face_changed_default
= 1;
3327 /* Update `default-frame-alist', which is used for new frames. */
3329 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3332 /* Update the current frame's parameters. */
3335 cons
= XCAR (Vparam_value_alist
);
3336 XSETCAR (cons
, param
);
3337 XSETCDR (cons
, value
);
3338 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3347 /* Update the corresponding face when frame parameter PARAM on frame F
3348 has been assigned the value NEW_VALUE. */
3351 update_face_from_frame_parameter (struct frame
*f
, Lisp_Object param
,
3352 Lisp_Object new_value
)
3354 Lisp_Object face
= Qnil
;
3357 /* If there are no faces yet, give up. This is the case when called
3358 from Fx_create_frame, and we do the necessary things later in
3359 face-set-after-frame-defaults. */
3360 if (NILP (f
->face_alist
))
3363 if (EQ (param
, Qforeground_color
))
3366 lface
= lface_from_face_name (f
, face
, 1);
3367 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3368 ? new_value
: Qunspecified
);
3369 realize_basic_faces (f
);
3371 else if (EQ (param
, Qbackground_color
))
3375 /* Changing the background color might change the background
3376 mode, so that we have to load new defface specs.
3377 Call frame-set-background-mode to do that. */
3378 XSETFRAME (frame
, f
);
3379 call1 (Qframe_set_background_mode
, frame
);
3382 lface
= lface_from_face_name (f
, face
, 1);
3383 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3384 ? new_value
: Qunspecified
);
3385 realize_basic_faces (f
);
3387 #ifdef HAVE_WINDOW_SYSTEM
3388 else if (EQ (param
, Qborder_color
))
3391 lface
= lface_from_face_name (f
, face
, 1);
3392 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3393 ? new_value
: Qunspecified
);
3395 else if (EQ (param
, Qcursor_color
))
3398 lface
= lface_from_face_name (f
, face
, 1);
3399 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3400 ? new_value
: Qunspecified
);
3402 else if (EQ (param
, Qmouse_color
))
3405 lface
= lface_from_face_name (f
, face
, 1);
3406 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3407 ? new_value
: Qunspecified
);
3411 /* Changing a named face means that all realized faces depending on
3412 that face are invalid. Since we cannot tell which realized faces
3413 depend on the face, make sure they are all removed. This is done
3414 by incrementing face_change_count. The next call to
3415 init_iterator will then free realized faces. */
3417 && NILP (Fget (face
, Qface_no_inherit
)))
3419 ++face_change_count
;
3420 ++windows_or_buffers_changed
;
3425 #ifdef HAVE_WINDOW_SYSTEM
3427 /* Set the `font' frame parameter of FRAME determined from the
3428 font-object set in `default' face attributes LFACE. */
3431 set_font_frame_param (Lisp_Object frame
, Lisp_Object lface
)
3433 struct frame
*f
= XFRAME (frame
);
3436 if (FRAME_WINDOW_P (f
)
3437 /* Don't do anything if the font is `unspecified'. This can
3438 happen during frame creation. */
3439 && (font
= LFACE_FONT (lface
),
3440 ! UNSPECIFIEDP (font
)))
3442 if (FONT_SPEC_P (font
))
3444 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3447 LFACE_FONT (lface
) = font
;
3449 f
->default_face_done_p
= 0;
3450 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3455 /* Get the value of X resource RESOURCE, class CLASS for the display
3456 of frame FRAME. This is here because ordinary `x-get-resource'
3457 doesn't take a frame argument. */
3459 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3460 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3461 (Lisp_Object resource
, Lisp_Object
class, Lisp_Object frame
)
3463 Lisp_Object value
= Qnil
;
3464 CHECK_STRING (resource
);
3465 CHECK_STRING (class);
3466 CHECK_LIVE_FRAME (frame
);
3468 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3469 resource
, class, Qnil
, Qnil
);
3475 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3476 If VALUE is "on" or "true", return t. If VALUE is "off" or
3477 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3478 error; if SIGNAL_P is zero, return 0. */
3481 face_boolean_x_resource_value (Lisp_Object value
, int signal_p
)
3483 Lisp_Object result
= make_number (0);
3485 eassert (STRINGP (value
));
3487 if (xstrcasecmp (SSDATA (value
), "on") == 0
3488 || xstrcasecmp (SSDATA (value
), "true") == 0)
3490 else if (xstrcasecmp (SSDATA (value
), "off") == 0
3491 || xstrcasecmp (SSDATA (value
), "false") == 0)
3493 else if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3494 result
= Qunspecified
;
3496 signal_error ("Invalid face attribute value from X resource", value
);
3502 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3503 Finternal_set_lisp_face_attribute_from_resource
,
3504 Sinternal_set_lisp_face_attribute_from_resource
,
3505 3, 4, 0, doc
: /* */)
3506 (Lisp_Object face
, Lisp_Object attr
, Lisp_Object value
, Lisp_Object frame
)
3508 CHECK_SYMBOL (face
);
3509 CHECK_SYMBOL (attr
);
3510 CHECK_STRING (value
);
3512 if (xstrcasecmp (SSDATA (value
), "unspecified") == 0)
3513 value
= Qunspecified
;
3514 else if (EQ (attr
, QCheight
))
3516 value
= Fstring_to_number (value
, make_number (10));
3517 if (XINT (value
) <= 0)
3518 signal_error ("Invalid face height from X resource", value
);
3520 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3521 value
= face_boolean_x_resource_value (value
, 1);
3522 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3523 value
= intern (SSDATA (value
));
3524 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3525 value
= face_boolean_x_resource_value (value
, 1);
3526 else if (EQ (attr
, QCunderline
)
3527 || EQ (attr
, QCoverline
)
3528 || EQ (attr
, QCstrike_through
))
3530 Lisp_Object boolean_value
;
3532 /* If the result of face_boolean_x_resource_value is t or nil,
3533 VALUE does NOT specify a color. */
3534 boolean_value
= face_boolean_x_resource_value (value
, 0);
3535 if (SYMBOLP (boolean_value
))
3536 value
= boolean_value
;
3538 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3539 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3541 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3544 #endif /* HAVE_WINDOW_SYSTEM */
3547 /***********************************************************************
3549 ***********************************************************************/
3551 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3553 /* Make menus on frame F appear as specified by the `menu' face. */
3556 x_update_menu_appearance (struct frame
*f
)
3558 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3562 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3567 ptrdiff_t bufsize
= sizeof line
;
3568 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3569 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3570 const char *myname
= SSDATA (Vx_resource_name
);
3573 const char *popup_path
= "popup_menu";
3575 const char *popup_path
= "menu.popup";
3578 if (STRINGP (LFACE_FOREGROUND (lface
)))
3580 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*foreground: %s",
3582 SDATA (LFACE_FOREGROUND (lface
)));
3583 XrmPutLineResource (&rdb
, line
);
3584 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*foreground: %s",
3585 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3586 XrmPutLineResource (&rdb
, line
);
3590 if (STRINGP (LFACE_BACKGROUND (lface
)))
3592 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*background: %s",
3594 SDATA (LFACE_BACKGROUND (lface
)));
3595 XrmPutLineResource (&rdb
, line
);
3597 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*background: %s",
3598 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3599 XrmPutLineResource (&rdb
, line
);
3604 /* On Solaris 5.8, it's been reported that the `menu' face
3605 can be unspecified here, during startup. Why this
3606 happens remains unknown. -- cyd */
3607 && FONTP (LFACE_FONT (lface
))
3608 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3609 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3610 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3611 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3612 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3613 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3615 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3617 const char *suffix
= "List";
3620 #if defined HAVE_X_I18N
3622 const char *suffix
= "Set";
3624 const char *suffix
= "";
3631 #if defined HAVE_X_I18N
3632 char *fontsetname
= xic_create_fontsetname (SSDATA (xlfd
), motif
);
3634 char *fontsetname
= SSDATA (xlfd
);
3636 exprintf (&buf
, &bufsize
, line
, -1, "%s.pane.menubar*font%s: %s",
3637 myname
, suffix
, fontsetname
);
3638 XrmPutLineResource (&rdb
, line
);
3640 exprintf (&buf
, &bufsize
, line
, -1, "%s.%s*font%s: %s",
3641 myname
, popup_path
, suffix
, fontsetname
);
3642 XrmPutLineResource (&rdb
, line
);
3644 if (fontsetname
!= SSDATA (xlfd
))
3645 xfree (fontsetname
);
3649 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3650 free_frame_menubar (f
);
3657 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3660 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3661 Sface_attribute_relative_p
,
3663 doc
: /* Check whether a face attribute value is relative.
3664 Specifically, this function returns t if the attribute ATTRIBUTE
3665 with the value VALUE is relative.
3667 A relative value is one that doesn't entirely override whatever is
3668 inherited from another face. For most possible attributes,
3669 the only relative value that users see is `unspecified'.
3670 However, for :height, floating point values are also relative. */)
3671 (Lisp_Object attribute
, Lisp_Object value
)
3673 if (EQ (value
, Qunspecified
) || (EQ (value
, QCignore_defface
)))
3675 else if (EQ (attribute
, QCheight
))
3676 return INTEGERP (value
) ? Qnil
: Qt
;
3681 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3683 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3684 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3685 the result will be absolute, otherwise it will be relative. */)
3686 (Lisp_Object attribute
, Lisp_Object value1
, Lisp_Object value2
)
3688 if (EQ (value1
, Qunspecified
) || EQ (value1
, QCignore_defface
))
3690 else if (EQ (attribute
, QCheight
))
3691 return merge_face_heights (value1
, value2
, value1
);
3697 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3698 Sinternal_get_lisp_face_attribute
,
3700 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3701 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3702 face attribute name, signal an error.
3703 If the optional argument FRAME is given, report on face SYMBOL in that
3704 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3705 frames). If FRAME is omitted or nil, use the selected frame. */)
3706 (Lisp_Object symbol
, Lisp_Object keyword
, Lisp_Object frame
)
3708 Lisp_Object lface
, value
= Qnil
;
3710 CHECK_SYMBOL (symbol
);
3711 CHECK_SYMBOL (keyword
);
3714 lface
= lface_from_face_name (NULL
, symbol
, 1);
3718 frame
= selected_frame
;
3719 CHECK_LIVE_FRAME (frame
);
3720 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3723 if (EQ (keyword
, QCfamily
))
3724 value
= LFACE_FAMILY (lface
);
3725 else if (EQ (keyword
, QCfoundry
))
3726 value
= LFACE_FOUNDRY (lface
);
3727 else if (EQ (keyword
, QCheight
))
3728 value
= LFACE_HEIGHT (lface
);
3729 else if (EQ (keyword
, QCweight
))
3730 value
= LFACE_WEIGHT (lface
);
3731 else if (EQ (keyword
, QCslant
))
3732 value
= LFACE_SLANT (lface
);
3733 else if (EQ (keyword
, QCunderline
))
3734 value
= LFACE_UNDERLINE (lface
);
3735 else if (EQ (keyword
, QCoverline
))
3736 value
= LFACE_OVERLINE (lface
);
3737 else if (EQ (keyword
, QCstrike_through
))
3738 value
= LFACE_STRIKE_THROUGH (lface
);
3739 else if (EQ (keyword
, QCbox
))
3740 value
= LFACE_BOX (lface
);
3741 else if (EQ (keyword
, QCinverse_video
)
3742 || EQ (keyword
, QCreverse_video
))
3743 value
= LFACE_INVERSE (lface
);
3744 else if (EQ (keyword
, QCforeground
))
3745 value
= LFACE_FOREGROUND (lface
);
3746 else if (EQ (keyword
, QCbackground
))
3747 value
= LFACE_BACKGROUND (lface
);
3748 else if (EQ (keyword
, QCstipple
))
3749 value
= LFACE_STIPPLE (lface
);
3750 else if (EQ (keyword
, QCwidth
))
3751 value
= LFACE_SWIDTH (lface
);
3752 else if (EQ (keyword
, QCinherit
))
3753 value
= LFACE_INHERIT (lface
);
3754 else if (EQ (keyword
, QCfont
))
3755 value
= LFACE_FONT (lface
);
3756 else if (EQ (keyword
, QCfontset
))
3757 value
= LFACE_FONTSET (lface
);
3759 signal_error ("Invalid face attribute name", keyword
);
3761 if (IGNORE_DEFFACE_P (value
))
3762 return Qunspecified
;
3768 DEFUN ("internal-lisp-face-attribute-values",
3769 Finternal_lisp_face_attribute_values
,
3770 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3771 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3772 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3775 Lisp_Object result
= Qnil
;
3777 CHECK_SYMBOL (attr
);
3779 if (EQ (attr
, QCunderline
))
3780 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3781 else if (EQ (attr
, QCoverline
))
3782 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3783 else if (EQ (attr
, QCstrike_through
))
3784 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3785 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3786 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3792 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3793 Sinternal_merge_in_global_face
, 2, 2, 0,
3794 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3795 Default face attributes override any local face attributes. */)
3796 (Lisp_Object face
, Lisp_Object frame
)
3799 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3800 struct frame
*f
= XFRAME (frame
);
3802 CHECK_LIVE_FRAME (frame
);
3803 global_lface
= lface_from_face_name (NULL
, face
, 1);
3804 local_lface
= lface_from_face_name (f
, face
, 0);
3805 if (NILP (local_lface
))
3806 local_lface
= Finternal_make_lisp_face (face
, frame
);
3808 /* Make every specified global attribute override the local one.
3809 BEWARE!! This is only used from `face-set-after-frame-default' where
3810 the local frame is defined from default specs in `face-defface-spec'
3811 and those should be overridden by global settings. Hence the strange
3812 "global before local" priority. */
3813 lvec
= XVECTOR (local_lface
)->contents
;
3814 gvec
= XVECTOR (global_lface
)->contents
;
3815 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3816 if (IGNORE_DEFFACE_P (gvec
[i
]))
3817 lvec
[i
] = Qunspecified
;
3818 else if (! UNSPECIFIEDP (gvec
[i
]))
3821 /* If the default face was changed, update the face cache and the
3822 `font' frame parameter. */
3823 if (EQ (face
, Qdefault
))
3825 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3826 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3827 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3829 /* This can be NULL (e.g., in batch mode). */
3832 /* Ensure that the face vector is fully specified by merging
3833 the previously-cached vector. */
3834 memcpy (attrs
, oldface
->lface
, sizeof attrs
);
3835 merge_face_vectors (f
, lvec
, attrs
, 0);
3836 memcpy (lvec
, attrs
, sizeof attrs
);
3837 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3839 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3840 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3841 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3842 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3843 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3844 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3845 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
3848 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
3849 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
3853 if (STRINGP (gvec
[LFACE_FOREGROUND_INDEX
]))
3854 Fmodify_frame_parameters (frame
,
3855 Fcons (Fcons (Qforeground_color
,
3856 gvec
[LFACE_FOREGROUND_INDEX
]),
3859 if (STRINGP (gvec
[LFACE_BACKGROUND_INDEX
]))
3860 Fmodify_frame_parameters (frame
,
3861 Fcons (Fcons (Qbackground_color
,
3862 gvec
[LFACE_BACKGROUND_INDEX
]),
3871 /* The following function is implemented for compatibility with 20.2.
3872 The function is used in x-resolve-fonts when it is asked to
3873 return fonts with the same size as the font of a face. This is
3874 done in fontset.el. */
3876 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3877 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3878 The font name is, by default, for ASCII characters.
3879 If the optional argument FRAME is given, report on face FACE in that frame.
3880 If FRAME is t, report on the defaults for face FACE (for new frames).
3881 The font default for a face is either nil, or a list
3882 of the form (bold), (italic) or (bold italic).
3883 If FRAME is omitted or nil, use the selected frame. And, in this case,
3884 if the optional third argument CHARACTER is given,
3885 return the font name used for CHARACTER. */)
3886 (Lisp_Object face
, Lisp_Object frame
, Lisp_Object character
)
3890 Lisp_Object result
= Qnil
;
3891 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3893 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3894 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3895 result
= Fcons (Qbold
, result
);
3897 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
3898 && !EQ (LFACE_SLANT (lface
), Qnormal
))
3899 result
= Fcons (Qitalic
, result
);
3905 struct frame
*f
= frame_or_selected_frame (frame
, 1);
3906 int face_id
= lookup_named_face (f
, face
, 1);
3907 struct face
*fface
= FACE_FROM_ID (f
, face_id
);
3911 #ifdef HAVE_WINDOW_SYSTEM
3912 if (FRAME_WINDOW_P (f
) && !NILP (character
))
3914 CHECK_CHARACTER (character
);
3915 face_id
= FACE_FOR_CHAR (f
, fface
, XINT (character
), -1, Qnil
);
3916 fface
= FACE_FROM_ID (f
, face_id
);
3919 ? fface
->font
->props
[FONT_NAME_INDEX
]
3921 #else /* !HAVE_WINDOW_SYSTEM */
3922 return build_string (FRAME_MSDOS_P (f
)
3924 : FRAME_W32_P (f
) ? "w32term"
3931 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
3932 all attributes are `equal'. Tries to be fast because this function
3933 is called quite often. */
3936 face_attr_equal_p (Lisp_Object v1
, Lisp_Object v2
)
3938 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
3939 and the other is specified. */
3940 if (XTYPE (v1
) != XTYPE (v2
))
3949 if (SBYTES (v1
) != SBYTES (v2
))
3952 return memcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
3959 return !NILP (Fequal (v1
, v2
));
3964 /* Compare face vectors 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 lface_equal_p (Lisp_Object
*v1
, Lisp_Object
*v2
)
3973 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
3974 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
3980 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
3981 Sinternal_lisp_face_equal_p
, 2, 3, 0,
3982 doc
: /* True if FACE1 and FACE2 are equal.
3983 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
3984 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
3985 If FRAME is omitted or nil, use the selected frame. */)
3986 (Lisp_Object face1
, Lisp_Object face2
, Lisp_Object frame
)
3990 Lisp_Object lface1
, lface2
;
3995 /* Don't use check_x_frame here because this function is called
3996 before X frames exist. At that time, if FRAME is nil,
3997 selected_frame will be used which is the frame dumped with
3998 Emacs. That frame is not an X frame. */
3999 f
= frame_or_selected_frame (frame
, 2);
4001 lface1
= lface_from_face_name (f
, face1
, 1);
4002 lface2
= lface_from_face_name (f
, face2
, 1);
4003 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4004 XVECTOR (lface2
)->contents
);
4005 return equal_p
? Qt
: Qnil
;
4009 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4010 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4011 doc
: /* True if FACE has no attribute specified.
4012 If the optional argument FRAME is given, report on face FACE in that frame.
4013 If FRAME is t, report on the defaults for face FACE (for new frames).
4014 If FRAME is omitted or nil, use the selected frame. */)
4015 (Lisp_Object face
, Lisp_Object frame
)
4022 frame
= selected_frame
;
4023 CHECK_LIVE_FRAME (frame
);
4027 lface
= lface_from_face_name (NULL
, face
, 1);
4029 lface
= lface_from_face_name (f
, face
, 1);
4031 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4032 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4035 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4039 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4041 doc
: /* Return an alist of frame-local faces defined on FRAME.
4042 For internal use only. */)
4045 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4046 return f
->face_alist
;
4050 /* Return a hash code for Lisp string STRING with case ignored. Used
4051 below in computing a hash value for a Lisp face. */
4053 static inline unsigned
4054 hash_string_case_insensitive (Lisp_Object string
)
4056 const unsigned char *s
;
4058 eassert (STRINGP (string
));
4059 for (s
= SDATA (string
); *s
; ++s
)
4060 hash
= (hash
<< 1) ^ tolower (*s
);
4065 /* Return a hash code for face attribute vector V. */
4067 static inline unsigned
4068 lface_hash (Lisp_Object
*v
)
4070 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4071 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4072 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4073 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4074 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4075 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4076 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4077 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4081 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4082 considering charsets/registries). They do if they specify the same
4083 family, point size, weight, width, slant, and font. Both
4084 LFACE1 and LFACE2 must be fully-specified. */
4087 lface_same_font_attributes_p (Lisp_Object
*lface1
, Lisp_Object
*lface2
)
4089 eassert (lface_fully_specified_p (lface1
)
4090 && lface_fully_specified_p (lface2
));
4091 return (xstrcasecmp (SSDATA (lface1
[LFACE_FAMILY_INDEX
]),
4092 SSDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4093 && xstrcasecmp (SSDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4094 SSDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4095 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4096 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4097 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4098 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4099 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4100 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4101 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4102 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4103 && ! xstrcasecmp (SSDATA (lface1
[LFACE_FONTSET_INDEX
]),
4104 SSDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4110 /***********************************************************************
4112 ***********************************************************************/
4114 /* Allocate and return a new realized face for Lisp face attribute
4117 static struct face
*
4118 make_realized_face (Lisp_Object
*attr
)
4120 struct face
*face
= xzalloc (sizeof *face
);
4121 face
->ascii_face
= face
;
4122 memcpy (face
->lface
, attr
, sizeof face
->lface
);
4127 /* Free realized face FACE, including its X resources. FACE may
4131 free_realized_face (struct frame
*f
, struct face
*face
)
4135 #ifdef HAVE_WINDOW_SYSTEM
4136 if (FRAME_WINDOW_P (f
))
4138 /* Free fontset of FACE if it is ASCII face. */
4139 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4140 free_face_fontset (f
, face
);
4145 font_done_for_face (f
, face
);
4146 x_free_gc (f
, face
->gc
);
4151 free_face_colors (f
, face
);
4152 x_destroy_bitmap (f
, face
->stipple
);
4154 #endif /* HAVE_WINDOW_SYSTEM */
4161 /* Prepare face FACE for subsequent display on frame F. This
4162 allocated GCs if they haven't been allocated yet or have been freed
4163 by clearing the face cache. */
4166 prepare_face_for_display (struct frame
*f
, struct face
*face
)
4168 #ifdef HAVE_WINDOW_SYSTEM
4169 eassert (FRAME_WINDOW_P (f
));
4174 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4176 xgcv
.foreground
= face
->foreground
;
4177 xgcv
.background
= face
->background
;
4178 #ifdef HAVE_X_WINDOWS
4179 xgcv
.graphics_exposures
= False
;
4183 #ifdef HAVE_X_WINDOWS
4186 xgcv
.fill_style
= FillOpaqueStippled
;
4187 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4188 mask
|= GCFillStyle
| GCStipple
;
4191 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4193 font_prepare_for_face (f
, face
);
4196 #endif /* HAVE_WINDOW_SYSTEM */
4200 /* Returns the `distance' between the colors X and Y. */
4203 color_distance (XColor
*x
, XColor
*y
)
4205 /* This formula is from a paper titled `Colour metric' by Thiadmer Riemersma.
4206 Quoting from that paper:
4208 This formula has results that are very close to L*u*v* (with the
4209 modified lightness curve) and, more importantly, it is a more even
4210 algorithm: it does not have a range of colors where it suddenly
4211 gives far from optimal results.
4213 See <http://www.compuphase.com/cmetric.htm> for more info. */
4215 long r
= (x
->red
- y
->red
) >> 8;
4216 long g
= (x
->green
- y
->green
) >> 8;
4217 long b
= (x
->blue
- y
->blue
) >> 8;
4218 long r_mean
= (x
->red
+ y
->red
) >> 9;
4221 (((512 + r_mean
) * r
* r
) >> 8)
4223 + (((767 - r_mean
) * b
* b
) >> 8);
4227 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4228 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4229 COLOR1 and COLOR2 may be either strings containing the color name,
4230 or lists of the form (RED GREEN BLUE).
4231 If FRAME is unspecified or nil, the current frame is used. */)
4232 (Lisp_Object color1
, Lisp_Object color2
, Lisp_Object frame
)
4235 XColor cdef1
, cdef2
;
4238 frame
= selected_frame
;
4239 CHECK_LIVE_FRAME (frame
);
4242 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4243 && !(STRINGP (color1
) && defined_color (f
, SSDATA (color1
), &cdef1
, 0)))
4244 signal_error ("Invalid color", color1
);
4245 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4246 && !(STRINGP (color2
) && defined_color (f
, SSDATA (color2
), &cdef2
, 0)))
4247 signal_error ("Invalid color", color2
);
4249 return make_number (color_distance (&cdef1
, &cdef2
));
4253 /***********************************************************************
4255 ***********************************************************************/
4257 /* Return a new face cache for frame F. */
4259 static struct face_cache
*
4260 make_face_cache (struct frame
*f
)
4262 struct face_cache
*c
;
4265 c
= xzalloc (sizeof *c
);
4266 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4267 c
->buckets
= xzalloc (size
);
4269 c
->faces_by_id
= xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4271 c
->menu_face_changed_p
= menu_face_changed_default
;
4276 /* Clear out all graphics contexts for all realized faces, except for
4277 the basic faces. This should be done from time to time just to avoid
4278 keeping too many graphics contexts that are no longer needed. */
4281 clear_face_gcs (struct face_cache
*c
)
4283 if (c
&& FRAME_WINDOW_P (c
->f
))
4285 #ifdef HAVE_WINDOW_SYSTEM
4287 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4289 struct face
*face
= c
->faces_by_id
[i
];
4290 if (face
&& face
->gc
)
4294 font_done_for_face (c
->f
, face
);
4295 x_free_gc (c
->f
, face
->gc
);
4300 #endif /* HAVE_WINDOW_SYSTEM */
4305 /* Free all realized faces in face cache C, including basic faces.
4306 C may be null. If faces are freed, make sure the frame's current
4307 matrix is marked invalid, so that a display caused by an expose
4308 event doesn't try to use faces we destroyed. */
4311 free_realized_faces (struct face_cache
*c
)
4316 struct frame
*f
= c
->f
;
4318 /* We must block input here because we can't process X events
4319 safely while only some faces are freed, or when the frame's
4320 current matrix still references freed faces. */
4323 for (i
= 0; i
< c
->used
; ++i
)
4325 free_realized_face (f
, c
->faces_by_id
[i
]);
4326 c
->faces_by_id
[i
] = NULL
;
4330 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4331 memset (c
->buckets
, 0, size
);
4333 /* Must do a thorough redisplay the next time. Mark current
4334 matrices as invalid because they will reference faces freed
4335 above. This function is also called when a frame is
4336 destroyed. In this case, the root window of F is nil. */
4337 if (WINDOWP (f
->root_window
))
4339 clear_current_matrices (f
);
4340 ++windows_or_buffers_changed
;
4348 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4349 This is done after attributes of a named face have been changed,
4350 because we can't tell which realized faces depend on that face. */
4353 free_all_realized_faces (Lisp_Object frame
)
4358 FOR_EACH_FRAME (rest
, frame
)
4359 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4362 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4366 /* Free face cache C and faces in it, including their X resources. */
4369 free_face_cache (struct face_cache
*c
)
4373 free_realized_faces (c
);
4375 xfree (c
->faces_by_id
);
4381 /* Cache realized face FACE in face cache C. HASH is the hash value
4382 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4383 FACE), insert the new face to the beginning of the collision list
4384 of the face hash table of C. Otherwise, add the new face to the
4385 end of the collision list. This way, lookup_face can quickly find
4386 that a requested face is not cached. */
4389 cache_face (struct face_cache
*c
, struct face
*face
, unsigned int hash
)
4391 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4395 if (face
->ascii_face
!= face
)
4397 struct face
*last
= c
->buckets
[i
];
4408 c
->buckets
[i
] = face
;
4409 face
->prev
= face
->next
= NULL
;
4415 face
->next
= c
->buckets
[i
];
4417 face
->next
->prev
= face
;
4418 c
->buckets
[i
] = face
;
4421 /* Find a free slot in C->faces_by_id and use the index of the free
4422 slot as FACE->id. */
4423 for (i
= 0; i
< c
->used
; ++i
)
4424 if (c
->faces_by_id
[i
] == NULL
)
4429 /* Check that FACE got a unique id. */
4434 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4435 for (face1
= c
->buckets
[j
]; face1
; face1
= face1
->next
)
4441 #endif /* GLYPH_DEBUG */
4443 /* Maybe enlarge C->faces_by_id. */
4446 if (c
->used
== c
->size
)
4447 c
->faces_by_id
= xpalloc (c
->faces_by_id
, &c
->size
, 1, MAX_FACE_ID
,
4448 sizeof *c
->faces_by_id
);
4452 c
->faces_by_id
[i
] = face
;
4456 /* Remove face FACE from cache C. */
4459 uncache_face (struct face_cache
*c
, struct face
*face
)
4461 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4464 face
->prev
->next
= face
->next
;
4466 c
->buckets
[i
] = face
->next
;
4469 face
->next
->prev
= face
->prev
;
4471 c
->faces_by_id
[face
->id
] = NULL
;
4472 if (face
->id
== c
->used
)
4477 /* Look up a realized face with face attributes ATTR in the face cache
4478 of frame F. The face will be used to display ASCII characters.
4479 Value is the ID of the face found. If no suitable face is found,
4480 realize a new one. */
4483 lookup_face (struct frame
*f
, Lisp_Object
*attr
)
4485 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4490 eassert (cache
!= NULL
);
4491 check_lface_attrs (attr
);
4493 /* Look up ATTR in the face cache. */
4494 hash
= lface_hash (attr
);
4495 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4497 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4499 if (face
->ascii_face
!= face
)
4501 /* There's no more ASCII face. */
4505 if (face
->hash
== hash
4506 && lface_equal_p (face
->lface
, attr
))
4510 /* If not found, realize a new face. */
4512 face
= realize_face (cache
, attr
, -1);
4515 eassert (face
== FACE_FROM_ID (f
, face
->id
));
4516 #endif /* GLYPH_DEBUG */
4521 #ifdef HAVE_WINDOW_SYSTEM
4522 /* Look up a realized face that has the same attributes as BASE_FACE
4523 except for the font in the face cache of frame F. If FONT-OBJECT
4524 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4525 the face has no font. Value is the ID of the face found. If no
4526 suitable face is found, realize a new one. */
4529 face_for_font (struct frame
*f
, Lisp_Object font_object
, struct face
*base_face
)
4531 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4536 eassert (cache
!= NULL
);
4537 base_face
= base_face
->ascii_face
;
4538 hash
= lface_hash (base_face
->lface
);
4539 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4541 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4543 if (face
->ascii_face
== face
)
4545 if (face
->ascii_face
== base_face
4546 && face
->font
== (NILP (font_object
) ? NULL
4547 : XFONT_OBJECT (font_object
))
4548 && lface_equal_p (face
->lface
, base_face
->lface
))
4552 /* If not found, realize a new face. */
4553 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4556 #endif /* HAVE_WINDOW_SYSTEM */
4558 /* Return the face id of the realized face for named face SYMBOL on
4559 frame F suitable for displaying ASCII characters. Value is -1 if
4560 the face couldn't be determined, which might happen if the default
4561 face isn't realized and cannot be realized. */
4564 lookup_named_face (struct frame
*f
, Lisp_Object symbol
, int signal_p
)
4566 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4567 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4568 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4570 if (default_face
== NULL
)
4572 if (!realize_basic_faces (f
))
4574 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4575 if (default_face
== NULL
)
4576 abort (); /* realize_basic_faces must have set it up */
4579 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4582 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4583 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4585 return lookup_face (f
, attrs
);
4589 /* Return the display face-id of the basic face whose canonical face-id
4590 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4591 basic face has bee remapped via Vface_remapping_alist. This function is
4592 conservative: if something goes wrong, it will simply return FACE_ID
4593 rather than signal an error. */
4596 lookup_basic_face (struct frame
*f
, int face_id
)
4598 Lisp_Object name
, mapping
;
4599 int remapped_face_id
;
4601 if (NILP (Vface_remapping_alist
))
4602 return face_id
; /* Nothing to do. */
4606 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4607 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4608 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4609 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4610 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4611 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4612 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4613 case BORDER_FACE_ID
: name
= Qborder
; break;
4614 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4615 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4616 case MENU_FACE_ID
: name
= Qmenu
; break;
4619 abort (); /* the caller is supposed to pass us a basic face id */
4622 /* Do a quick scan through Vface_remapping_alist, and return immediately
4623 if there is no remapping for face NAME. This is just an optimization
4624 for the very common no-remapping case. */
4625 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4627 return face_id
; /* Give up. */
4629 /* If there is a remapping entry, lookup the face using NAME, which will
4630 handle the remapping too. */
4631 remapped_face_id
= lookup_named_face (f
, name
, 0);
4632 if (remapped_face_id
< 0)
4633 return face_id
; /* Give up. */
4635 return remapped_face_id
;
4639 /* Return a face for charset ASCII that is like the face with id
4640 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4641 STEPS < 0 means larger. Value is the id of the face. */
4644 smaller_face (struct frame
*f
, int face_id
, int steps
)
4646 #ifdef HAVE_WINDOW_SYSTEM
4648 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4649 int pt
, last_pt
, last_height
;
4652 struct face
*new_face
;
4654 /* If not called for an X frame, just return the original face. */
4655 if (FRAME_TERMCAP_P (f
))
4658 /* Try in increments of 1/2 pt. */
4659 delta
= steps
< 0 ? 5 : -5;
4660 steps
= eabs (steps
);
4662 face
= FACE_FROM_ID (f
, face_id
);
4663 memcpy (attrs
, face
->lface
, sizeof attrs
);
4664 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4665 new_face_id
= face_id
;
4666 last_height
= FONT_HEIGHT (face
->font
);
4670 /* Give up if we cannot find a font within 10pt. */
4671 && eabs (last_pt
- pt
) < 100)
4673 /* Look up a face for a slightly smaller/larger font. */
4675 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4676 new_face_id
= lookup_face (f
, attrs
);
4677 new_face
= FACE_FROM_ID (f
, new_face_id
);
4679 /* If height changes, count that as one step. */
4680 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4681 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4684 last_height
= FONT_HEIGHT (new_face
->font
);
4691 #else /* not HAVE_WINDOW_SYSTEM */
4695 #endif /* not HAVE_WINDOW_SYSTEM */
4699 /* Return a face for charset ASCII that is like the face with id
4700 FACE_ID on frame F, but has height HEIGHT. */
4703 face_with_height (struct frame
*f
, int face_id
, int height
)
4705 #ifdef HAVE_WINDOW_SYSTEM
4707 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4709 if (FRAME_TERMCAP_P (f
)
4713 face
= FACE_FROM_ID (f
, face_id
);
4714 memcpy (attrs
, face
->lface
, sizeof attrs
);
4715 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4716 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4717 face_id
= lookup_face (f
, attrs
);
4718 #endif /* HAVE_WINDOW_SYSTEM */
4724 /* Return the face id of the realized face for named face SYMBOL on
4725 frame F suitable for displaying ASCII characters, and use
4726 attributes of the face FACE_ID for attributes that aren't
4727 completely specified by SYMBOL. This is like lookup_named_face,
4728 except that the default attributes come from FACE_ID, not from the
4729 default face. FACE_ID is assumed to be already realized. */
4732 lookup_derived_face (struct frame
*f
, Lisp_Object symbol
, int face_id
,
4735 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4736 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4737 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4742 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4745 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
4746 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4747 return lookup_face (f
, attrs
);
4750 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4751 Sface_attributes_as_vector
, 1, 1, 0,
4752 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4756 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4758 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4765 /***********************************************************************
4766 Face capability testing
4767 ***********************************************************************/
4770 /* If the distance (as returned by color_distance) between two colors is
4771 less than this, then they are considered the same, for determining
4772 whether a color is supported or not. The range of values is 0-65535. */
4774 #define TTY_SAME_COLOR_THRESHOLD 10000
4776 #ifdef HAVE_WINDOW_SYSTEM
4778 /* Return non-zero if all the face attributes in ATTRS are supported
4779 on the window-system frame F.
4781 The definition of `supported' is somewhat heuristic, but basically means
4782 that a face containing all the attributes in ATTRS, when merged with the
4783 default face for display, can be represented in a way that's
4785 \(1) different in appearance than the default face, and
4786 \(2) `close in spirit' to what the attributes specify, if not exact. */
4789 x_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4790 struct face
*def_face
)
4792 Lisp_Object
*def_attrs
= def_face
->lface
;
4794 /* Check that other specified attributes are different that the default
4796 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4797 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4798 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4799 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4800 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4801 def_attrs
[LFACE_INVERSE_INDEX
]))
4802 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4803 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4804 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4805 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4806 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4807 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4808 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4809 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4810 def_attrs
[LFACE_STIPPLE_INDEX
]))
4811 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4812 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4813 def_attrs
[LFACE_OVERLINE_INDEX
]))
4814 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4815 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4816 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4817 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4818 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4819 def_attrs
[LFACE_BOX_INDEX
])))
4822 /* Check font-related attributes, as those are the most commonly
4823 "unsupported" on a window-system (because of missing fonts). */
4824 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4825 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4826 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4827 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4828 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4829 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4833 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4836 memcpy (merged_attrs
, def_attrs
, sizeof merged_attrs
);
4838 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4840 face_id
= lookup_face (f
, merged_attrs
);
4841 face
= FACE_FROM_ID (f
, face_id
);
4844 error ("Cannot make face");
4846 /* If the font is the same, or no font is found, then not
4848 if (face
->font
== def_face
->font
4851 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
4852 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
4856 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
4857 || face
->font
->driver
->case_sensitive
)
4859 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
4860 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
4861 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
4862 s2
, make_number (0), Qnil
, Qt
), Qt
))
4868 /* Everything checks out, this face is supported. */
4872 #endif /* HAVE_WINDOW_SYSTEM */
4874 /* Return non-zero if all the face attributes in ATTRS are supported
4877 The definition of `supported' is somewhat heuristic, but basically means
4878 that a face containing all the attributes in ATTRS, when merged
4879 with the default face for display, can be represented in a way that's
4881 \(1) different in appearance than the default face, and
4882 \(2) `close in spirit' to what the attributes specify, if not exact.
4884 Point (2) implies that a `:weight black' attribute will be satisfied
4885 by any terminal that can display bold, and a `:foreground "yellow"' as
4886 long as the terminal can display a yellowish color, but `:slant italic'
4887 will _not_ be satisfied by the tty display code's automatic
4888 substitution of a `dim' face for italic. */
4891 tty_supports_face_attributes_p (struct frame
*f
, Lisp_Object
*attrs
,
4892 struct face
*def_face
)
4895 Lisp_Object val
, fg
, bg
;
4896 XColor fg_tty_color
, fg_std_color
;
4897 XColor bg_tty_color
, bg_std_color
;
4898 unsigned test_caps
= 0;
4899 Lisp_Object
*def_attrs
= def_face
->lface
;
4901 /* First check some easy-to-check stuff; ttys support none of the
4902 following attributes, so we can just return false if any are requested
4903 (even if `nominal' values are specified, we should still return false,
4904 as that will be the same value that the default face uses). We
4905 consider :slant unsupportable on ttys, even though the face code
4906 actually `fakes' them using a dim attribute if possible. This is
4907 because the faked result is too different from what the face
4909 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4910 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
4911 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4912 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4913 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
4914 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4915 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4916 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
]))
4919 /* Test for terminal `capabilities' (non-color character attributes). */
4921 /* font weight (bold/dim) */
4922 val
= attrs
[LFACE_WEIGHT_INDEX
];
4923 if (!UNSPECIFIEDP (val
)
4924 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
4926 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
4930 if (def_weight
> 100)
4931 return 0; /* same as default */
4932 test_caps
= TTY_CAP_BOLD
;
4934 else if (weight
< 100)
4936 if (def_weight
< 100)
4937 return 0; /* same as default */
4938 test_caps
= TTY_CAP_DIM
;
4940 else if (def_weight
== 100)
4941 return 0; /* same as default */
4945 val
= attrs
[LFACE_SLANT_INDEX
];
4946 if (!UNSPECIFIEDP (val
)
4947 && (slant
= FONT_SLANT_NAME_NUMERIC (val
), slant
>= 0))
4949 int def_slant
= FONT_SLANT_NAME_NUMERIC (def_attrs
[LFACE_SLANT_INDEX
]);
4950 if (slant
== 100 || slant
== def_slant
)
4951 return 0; /* same as default */
4953 test_caps
|= TTY_CAP_ITALIC
;
4957 val
= attrs
[LFACE_UNDERLINE_INDEX
];
4958 if (!UNSPECIFIEDP (val
))
4961 return 0; /* ttys can't use colored underlines */
4962 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
4963 return 0; /* same as default */
4965 test_caps
|= TTY_CAP_UNDERLINE
;
4969 val
= attrs
[LFACE_INVERSE_INDEX
];
4970 if (!UNSPECIFIEDP (val
))
4972 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
4973 return 0; /* same as default */
4975 test_caps
|= TTY_CAP_INVERSE
;
4979 /* Color testing. */
4981 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
4982 we use them when calling `tty_capable_p' below, even if the face
4983 specifies no colors. */
4984 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
4985 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
4987 /* Check if foreground color is close enough. */
4988 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
4991 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
4993 if (face_attr_equal_p (fg
, def_fg
))
4994 return 0; /* same as default */
4995 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
4996 return 0; /* not a valid color */
4997 else if (color_distance (&fg_tty_color
, &fg_std_color
)
4998 > TTY_SAME_COLOR_THRESHOLD
)
4999 return 0; /* displayed color is too different */
5001 /* Make sure the color is really different than the default. */
5003 XColor def_fg_color
;
5004 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5005 && (color_distance (&fg_tty_color
, &def_fg_color
)
5006 <= TTY_SAME_COLOR_THRESHOLD
))
5011 /* Check if background color is close enough. */
5012 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5015 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5017 if (face_attr_equal_p (bg
, def_bg
))
5018 return 0; /* same as default */
5019 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5020 return 0; /* not a valid color */
5021 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5022 > TTY_SAME_COLOR_THRESHOLD
)
5023 return 0; /* displayed color is too different */
5025 /* Make sure the color is really different than the default. */
5027 XColor def_bg_color
;
5028 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5029 && (color_distance (&bg_tty_color
, &def_bg_color
)
5030 <= TTY_SAME_COLOR_THRESHOLD
))
5035 /* If both foreground and background are requested, see if the
5036 distance between them is OK. We just check to see if the distance
5037 between the tty's foreground and background is close enough to the
5038 distance between the standard foreground and background. */
5039 if (STRINGP (fg
) && STRINGP (bg
))
5042 = (color_distance (&fg_std_color
, &bg_std_color
)
5043 - color_distance (&fg_tty_color
, &bg_tty_color
));
5044 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5045 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5050 /* See if the capabilities we selected above are supported, with the
5052 if (test_caps
!= 0 &&
5053 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
,
5054 bg_tty_color
.pixel
))
5058 /* Hmmm, everything checks out, this terminal must support this face. */
5063 DEFUN ("display-supports-face-attributes-p",
5064 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5066 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5067 The optional argument DISPLAY can be a display name, a frame, or
5068 nil (meaning the selected frame's display).
5070 The definition of `supported' is somewhat heuristic, but basically means
5071 that a face containing all the attributes in ATTRIBUTES, when merged
5072 with the default face for display, can be represented in a way that's
5074 \(1) different in appearance than the default face, and
5075 \(2) `close in spirit' to what the attributes specify, if not exact.
5077 Point (2) implies that a `:weight black' attribute will be satisfied by
5078 any display that can display bold, and a `:foreground \"yellow\"' as long
5079 as it can display a yellowish color, but `:slant italic' will _not_ be
5080 satisfied by the tty display code's automatic substitution of a `dim'
5081 face for italic. */)
5082 (Lisp_Object attributes
, Lisp_Object display
)
5084 int supports
= 0, i
;
5087 struct face
*def_face
;
5088 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5090 if (noninteractive
|| !initialized
)
5091 /* We may not be able to access low-level face information in batch
5092 mode, or before being dumped, and this function is not going to
5093 be very useful in those cases anyway, so just give up. */
5097 frame
= selected_frame
;
5098 else if (FRAMEP (display
))
5102 /* Find any frame on DISPLAY. */
5103 Lisp_Object fl_tail
;
5106 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5108 frame
= XCAR (fl_tail
);
5109 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5110 XFRAME (frame
)->param_alist
)),
5116 CHECK_LIVE_FRAME (frame
);
5119 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5120 attrs
[i
] = Qunspecified
;
5121 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5123 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5124 if (def_face
== NULL
)
5126 if (! realize_basic_faces (f
))
5127 error ("Cannot realize default face");
5128 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5129 if (def_face
== NULL
)
5130 abort (); /* realize_basic_faces must have set it up */
5133 /* Dispatch to the appropriate handler. */
5134 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5135 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5136 #ifdef HAVE_WINDOW_SYSTEM
5138 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5141 return supports
? Qt
: Qnil
;
5145 /***********************************************************************
5147 ***********************************************************************/
5149 DEFUN ("internal-set-font-selection-order",
5150 Finternal_set_font_selection_order
,
5151 Sinternal_set_font_selection_order
, 1, 1, 0,
5152 doc
: /* Set font selection order for face font selection to ORDER.
5153 ORDER must be a list of length 4 containing the symbols `:width',
5154 `:height', `:weight', and `:slant'. Face attributes appearing
5155 first in ORDER are matched first, e.g. if `:height' appears before
5156 `:weight' in ORDER, font selection first tries to find a font with
5157 a suitable height, and then tries to match the font weight.
5163 int indices
[DIM (font_sort_order
)];
5166 memset (indices
, 0, sizeof indices
);
5170 CONSP (list
) && i
< DIM (indices
);
5171 list
= XCDR (list
), ++i
)
5173 Lisp_Object attr
= XCAR (list
);
5176 if (EQ (attr
, QCwidth
))
5178 else if (EQ (attr
, QCheight
))
5179 xlfd
= XLFD_POINT_SIZE
;
5180 else if (EQ (attr
, QCweight
))
5182 else if (EQ (attr
, QCslant
))
5187 if (indices
[i
] != 0)
5192 if (!NILP (list
) || i
!= DIM (indices
))
5193 signal_error ("Invalid font sort order", order
);
5194 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5195 if (indices
[i
] == 0)
5196 signal_error ("Invalid font sort order", order
);
5198 if (memcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5200 memcpy (font_sort_order
, indices
, sizeof font_sort_order
);
5201 free_all_realized_faces (Qnil
);
5204 font_update_sort_order (font_sort_order
);
5210 DEFUN ("internal-set-alternative-font-family-alist",
5211 Finternal_set_alternative_font_family_alist
,
5212 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5213 doc
: /* Define alternative font families to try in face font selection.
5214 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5215 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5216 be found. Value is ALIST. */)
5219 Lisp_Object entry
, tail
, tail2
;
5222 alist
= Fcopy_sequence (alist
);
5223 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5225 entry
= XCAR (tail
);
5227 entry
= Fcopy_sequence (entry
);
5228 XSETCAR (tail
, entry
);
5229 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5230 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5233 Vface_alternative_font_family_alist
= alist
;
5234 free_all_realized_faces (Qnil
);
5239 DEFUN ("internal-set-alternative-font-registry-alist",
5240 Finternal_set_alternative_font_registry_alist
,
5241 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5242 doc
: /* Define alternative font registries to try in face font selection.
5243 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5244 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5245 be found. Value is ALIST. */)
5248 Lisp_Object entry
, tail
, tail2
;
5251 alist
= Fcopy_sequence (alist
);
5252 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5254 entry
= XCAR (tail
);
5256 entry
= Fcopy_sequence (entry
);
5257 XSETCAR (tail
, entry
);
5258 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5259 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5261 Vface_alternative_font_registry_alist
= alist
;
5262 free_all_realized_faces (Qnil
);
5267 #ifdef HAVE_WINDOW_SYSTEM
5269 /* Return the fontset id of the base fontset name or alias name given
5270 by the fontset attribute of ATTRS. Value is -1 if the fontset
5271 attribute of ATTRS doesn't name a fontset. */
5274 face_fontset (Lisp_Object
*attrs
)
5278 name
= attrs
[LFACE_FONTSET_INDEX
];
5279 if (!STRINGP (name
))
5281 return fs_query_fontset (name
, 0);
5284 #endif /* HAVE_WINDOW_SYSTEM */
5288 /***********************************************************************
5290 ***********************************************************************/
5292 /* Realize basic faces on frame F. Value is zero if frame parameters
5293 of F don't contain enough information needed to realize the default
5297 realize_basic_faces (struct frame
*f
)
5300 ptrdiff_t count
= SPECPDL_INDEX ();
5302 /* Block input here so that we won't be surprised by an X expose
5303 event, for instance, without having the faces set up. */
5305 specbind (Qscalable_fonts_allowed
, Qt
);
5307 if (realize_default_face (f
))
5309 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5310 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5311 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5312 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5313 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5314 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5315 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5316 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5317 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5318 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5319 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5321 /* Reflect changes in the `menu' face in menu bars. */
5322 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5324 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5325 #ifdef USE_X_TOOLKIT
5326 if (FRAME_WINDOW_P (f
))
5327 x_update_menu_appearance (f
);
5334 unbind_to (count
, Qnil
);
5340 /* Realize the default face on frame F. If the face is not fully
5341 specified, make it fully-specified. Attributes of the default face
5342 that are not explicitly specified are taken from frame parameters. */
5345 realize_default_face (struct frame
*f
)
5347 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5349 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5352 /* If the `default' face is not yet known, create it. */
5353 lface
= lface_from_face_name (f
, Qdefault
, 0);
5357 XSETFRAME (frame
, f
);
5358 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5361 #ifdef HAVE_WINDOW_SYSTEM
5362 if (FRAME_WINDOW_P (f
))
5364 Lisp_Object font_object
;
5366 XSETFONT (font_object
, FRAME_FONT (f
));
5367 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5368 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5369 f
->default_face_done_p
= 1;
5371 #endif /* HAVE_WINDOW_SYSTEM */
5373 if (!FRAME_WINDOW_P (f
))
5375 LFACE_FAMILY (lface
) = build_string ("default");
5376 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5377 LFACE_SWIDTH (lface
) = Qnormal
;
5378 LFACE_HEIGHT (lface
) = make_number (1);
5379 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5380 LFACE_WEIGHT (lface
) = Qnormal
;
5381 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5382 LFACE_SLANT (lface
) = Qnormal
;
5383 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5384 LFACE_FONTSET (lface
) = Qnil
;
5387 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5388 LFACE_UNDERLINE (lface
) = Qnil
;
5390 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5391 LFACE_OVERLINE (lface
) = Qnil
;
5393 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5394 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5396 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5397 LFACE_BOX (lface
) = Qnil
;
5399 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5400 LFACE_INVERSE (lface
) = Qnil
;
5402 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5404 /* This function is called so early that colors are not yet
5405 set in the frame parameter list. */
5406 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5408 if (CONSP (color
) && STRINGP (XCDR (color
)))
5409 LFACE_FOREGROUND (lface
) = XCDR (color
);
5410 else if (FRAME_WINDOW_P (f
))
5412 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5413 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5418 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5420 /* This function is called so early that colors are not yet
5421 set in the frame parameter list. */
5422 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5423 if (CONSP (color
) && STRINGP (XCDR (color
)))
5424 LFACE_BACKGROUND (lface
) = XCDR (color
);
5425 else if (FRAME_WINDOW_P (f
))
5427 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5428 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5433 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5434 LFACE_STIPPLE (lface
) = Qnil
;
5436 /* Realize the face; it must be fully-specified now. */
5437 eassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5438 check_lface (lface
);
5439 memcpy (attrs
, XVECTOR (lface
)->contents
, sizeof attrs
);
5440 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5442 #ifdef HAVE_WINDOW_SYSTEM
5443 #ifdef HAVE_X_WINDOWS
5444 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5446 /* This can happen when making a frame on a display that does
5447 not support the default font. */
5451 /* Otherwise, the font specified for the frame was not
5452 acceptable as a font for the default face (perhaps because
5453 auto-scaled fonts are rejected), so we must adjust the frame
5455 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5457 #endif /* HAVE_X_WINDOWS */
5458 #endif /* HAVE_WINDOW_SYSTEM */
5463 /* Realize basic faces other than the default face in face cache C.
5464 SYMBOL is the face name, ID is the face id the realized face must
5465 have. The default face must have been realized already. */
5468 realize_named_face (struct frame
*f
, Lisp_Object symbol
, int id
)
5470 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5471 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5472 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5473 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5475 /* The default face must exist and be fully specified. */
5476 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5477 check_lface_attrs (attrs
);
5478 eassert (lface_fully_specified_p (attrs
));
5480 /* If SYMBOL isn't know as a face, create it. */
5484 XSETFRAME (frame
, f
);
5485 lface
= Finternal_make_lisp_face (symbol
, frame
);
5488 /* Merge SYMBOL's face with the default face. */
5489 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5490 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5492 /* Realize the face. */
5493 realize_face (c
, attrs
, id
);
5497 /* Realize the fully-specified face with attributes ATTRS in face
5498 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5499 non-negative, it is an ID of face to remove before caching the new
5500 face. Value is a pointer to the newly created realized face. */
5502 static struct face
*
5503 realize_face (struct face_cache
*cache
, Lisp_Object
*attrs
, int former_face_id
)
5507 /* LFACE must be fully specified. */
5508 eassert (cache
!= NULL
);
5509 check_lface_attrs (attrs
);
5511 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5513 /* Remove the former face. */
5514 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5515 uncache_face (cache
, former_face
);
5516 free_realized_face (cache
->f
, former_face
);
5517 SET_FRAME_GARBAGED (cache
->f
);
5520 if (FRAME_WINDOW_P (cache
->f
))
5521 face
= realize_x_face (cache
, attrs
);
5522 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5523 face
= realize_tty_face (cache
, attrs
);
5524 else if (FRAME_INITIAL_P (cache
->f
))
5526 /* Create a dummy face. */
5527 face
= make_realized_face (attrs
);
5532 /* Insert the new face. */
5533 cache_face (cache
, face
, lface_hash (attrs
));
5538 #ifdef HAVE_WINDOW_SYSTEM
5539 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5540 same attributes as BASE_FACE except for the font on frame F.
5541 FONT-OBJECT may be nil, in which case, realized a face of
5544 static struct face
*
5545 realize_non_ascii_face (struct frame
*f
, Lisp_Object font_object
,
5546 struct face
*base_face
)
5548 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5551 face
= xmalloc (sizeof *face
);
5556 = (! NILP (font_object
)
5557 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5558 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5560 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5561 face
->colors_copied_bitwise_p
= 1;
5562 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5565 cache_face (cache
, face
, face
->hash
);
5569 #endif /* HAVE_WINDOW_SYSTEM */
5572 /* Realize the fully-specified face with attributes ATTRS in face
5573 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5574 the new face doesn't share font with the default face, a fontname
5575 is allocated from the heap and set in `font_name' of the new face,
5576 but it is not yet loaded here. Value is a pointer to the newly
5577 created realized face. */
5579 static struct face
*
5580 realize_x_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5582 struct face
*face
= NULL
;
5583 #ifdef HAVE_WINDOW_SYSTEM
5584 struct face
*default_face
;
5586 Lisp_Object stipple
, underline
, overline
, strike_through
, box
;
5588 eassert (FRAME_WINDOW_P (cache
->f
));
5590 /* Allocate a new realized face. */
5591 face
= make_realized_face (attrs
);
5592 face
->ascii_face
= face
;
5596 /* Determine the font to use. Most of the time, the font will be
5597 the same as the font of the default face, so try that first. */
5598 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5600 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5602 face
->font
= default_face
->font
;
5604 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5608 /* If the face attribute ATTRS specifies a fontset, use it as
5609 the base of a new realized fontset. Otherwise, use the same
5610 base fontset as of the default face. The base determines
5611 registry and encoding of a font. It may also determine
5612 foundry and family. The other fields of font name pattern
5613 are constructed from ATTRS. */
5614 int fontset
= face_fontset (attrs
);
5616 /* If we are realizing the default face, ATTRS should specify a
5617 fontset. In other words, if FONTSET is -1, we are not
5618 realizing the default face, thus the default face should have
5619 already been realized. */
5623 fontset
= default_face
->fontset
;
5627 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5628 attrs
[LFACE_FONT_INDEX
]
5629 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5630 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5632 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5633 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5643 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5644 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5645 face
->overstrike
= 1;
5647 /* Load colors, and set remaining attributes. */
5649 load_face_colors (f
, face
, attrs
);
5652 box
= attrs
[LFACE_BOX_INDEX
];
5655 /* A simple box of line width 1 drawn in color given by
5657 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5659 face
->box
= FACE_SIMPLE_BOX
;
5660 face
->box_line_width
= 1;
5662 else if (INTEGERP (box
))
5664 /* Simple box of specified line width in foreground color of the
5666 eassert (XINT (box
) != 0);
5667 face
->box
= FACE_SIMPLE_BOX
;
5668 face
->box_line_width
= XINT (box
);
5669 face
->box_color
= face
->foreground
;
5670 face
->box_color_defaulted_p
= 1;
5672 else if (CONSP (box
))
5674 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5675 being one of `raised' or `sunken'. */
5676 face
->box
= FACE_SIMPLE_BOX
;
5677 face
->box_color
= face
->foreground
;
5678 face
->box_color_defaulted_p
= 1;
5679 face
->box_line_width
= 1;
5683 Lisp_Object keyword
, value
;
5685 keyword
= XCAR (box
);
5693 if (EQ (keyword
, QCline_width
))
5695 if (INTEGERP (value
) && XINT (value
) != 0)
5696 face
->box_line_width
= XINT (value
);
5698 else if (EQ (keyword
, QCcolor
))
5700 if (STRINGP (value
))
5702 face
->box_color
= load_color (f
, face
, value
,
5704 face
->use_box_color_for_shadows_p
= 1;
5707 else if (EQ (keyword
, QCstyle
))
5709 if (EQ (value
, Qreleased_button
))
5710 face
->box
= FACE_RAISED_BOX
;
5711 else if (EQ (value
, Qpressed_button
))
5712 face
->box
= FACE_SUNKEN_BOX
;
5717 /* Text underline, overline, strike-through. */
5719 underline
= attrs
[LFACE_UNDERLINE_INDEX
];
5720 if (EQ (underline
, Qt
))
5722 /* Use default color (same as foreground color). */
5723 face
->underline_p
= 1;
5724 face
->underline_type
= FACE_UNDER_LINE
;
5725 face
->underline_defaulted_p
= 1;
5726 face
->underline_color
= 0;
5728 else if (STRINGP (underline
))
5730 /* Use specified color. */
5731 face
->underline_p
= 1;
5732 face
->underline_type
= FACE_UNDER_LINE
;
5733 face
->underline_defaulted_p
= 0;
5734 face
->underline_color
5735 = load_color (f
, face
, underline
,
5736 LFACE_UNDERLINE_INDEX
);
5738 else if (NILP (underline
))
5740 face
->underline_p
= 0;
5741 face
->underline_defaulted_p
= 0;
5742 face
->underline_color
= 0;
5744 else if (CONSP (underline
))
5746 /* `(:color COLOR :style STYLE)'.
5747 STYLE being one of `line' or `wave'. */
5748 face
->underline_p
= 1;
5749 face
->underline_color
= 0;
5750 face
->underline_defaulted_p
= 1;
5751 face
->underline_type
= FACE_UNDER_LINE
;
5753 while (CONSP (underline
))
5755 Lisp_Object keyword
, value
;
5757 keyword
= XCAR (underline
);
5758 underline
= XCDR (underline
);
5760 if (!CONSP (underline
))
5762 value
= XCAR (underline
);
5763 underline
= XCDR (underline
);
5765 if (EQ (keyword
, QCcolor
))
5767 if (EQ (value
, Qforeground_color
))
5769 face
->underline_defaulted_p
= 1;
5770 face
->underline_color
= 0;
5772 else if (STRINGP (value
))
5774 face
->underline_defaulted_p
= 0;
5775 face
->underline_color
= load_color (f
, face
, value
,
5776 LFACE_UNDERLINE_INDEX
);
5779 else if (EQ (keyword
, QCstyle
))
5781 if (EQ (value
, Qline
))
5782 face
->underline_type
= FACE_UNDER_LINE
;
5783 else if (EQ (value
, Qwave
))
5784 face
->underline_type
= FACE_UNDER_WAVE
;
5789 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5790 if (STRINGP (overline
))
5792 face
->overline_color
5793 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5794 LFACE_OVERLINE_INDEX
);
5795 face
->overline_p
= 1;
5797 else if (EQ (overline
, Qt
))
5799 face
->overline_color
= face
->foreground
;
5800 face
->overline_color_defaulted_p
= 1;
5801 face
->overline_p
= 1;
5804 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5805 if (STRINGP (strike_through
))
5807 face
->strike_through_color
5808 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5809 LFACE_STRIKE_THROUGH_INDEX
);
5810 face
->strike_through_p
= 1;
5812 else if (EQ (strike_through
, Qt
))
5814 face
->strike_through_color
= face
->foreground
;
5815 face
->strike_through_color_defaulted_p
= 1;
5816 face
->strike_through_p
= 1;
5819 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5820 if (!NILP (stipple
))
5821 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5822 #endif /* HAVE_WINDOW_SYSTEM */
5828 /* Map a specified color of face FACE on frame F to a tty color index.
5829 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5830 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5831 default foreground/background colors. */
5834 map_tty_color (struct frame
*f
, struct face
*face
,
5835 enum lface_attribute_index idx
, int *defaulted
)
5837 Lisp_Object frame
, color
, def
;
5838 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5839 unsigned long default_pixel
=
5840 foreground_p
? FACE_TTY_DEFAULT_FG_COLOR
: FACE_TTY_DEFAULT_BG_COLOR
;
5841 unsigned long pixel
= default_pixel
;
5843 unsigned long default_other_pixel
=
5844 foreground_p
? FACE_TTY_DEFAULT_BG_COLOR
: FACE_TTY_DEFAULT_FG_COLOR
;
5847 eassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5849 XSETFRAME (frame
, f
);
5850 color
= face
->lface
[idx
];
5854 && CONSP (Vtty_defined_color_alist
)
5855 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5858 /* Associations in tty-defined-color-alist are of the form
5859 (NAME INDEX R G B). We need the INDEX part. */
5860 pixel
= XINT (XCAR (XCDR (def
)));
5863 if (pixel
== default_pixel
&& STRINGP (color
))
5865 pixel
= load_color (f
, face
, color
, idx
);
5868 /* If the foreground of the default face is the default color,
5869 use the foreground color defined by the frame. */
5870 if (FRAME_MSDOS_P (f
))
5872 if (pixel
== default_pixel
5873 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5876 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5878 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5879 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5882 else if (pixel
== default_other_pixel
)
5885 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5887 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5888 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5896 face
->foreground
= pixel
;
5898 face
->background
= pixel
;
5902 /* Realize the fully-specified face with attributes ATTRS in face
5903 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
5904 Value is a pointer to the newly created realized face. */
5906 static struct face
*
5907 realize_tty_face (struct face_cache
*cache
, Lisp_Object
*attrs
)
5911 int face_colors_defaulted
= 0;
5912 struct frame
*f
= cache
->f
;
5914 /* Frame must be a termcap frame. */
5915 eassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
5917 /* Allocate a new realized face. */
5918 face
= make_realized_face (attrs
);
5920 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
5923 /* Map face attributes to TTY appearances. */
5924 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5925 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
5927 face
->tty_bold_p
= 1;
5929 face
->tty_italic_p
= 1;
5930 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5931 face
->tty_underline_p
= 1;
5932 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
5933 face
->tty_reverse_p
= 1;
5935 /* Map color names to color indices. */
5936 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
5937 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
5939 /* Swap colors if face is inverse-video. If the colors are taken
5940 from the frame colors, they are already inverted, since the
5941 frame-creation function calls x-handle-reverse-video. */
5942 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
5944 unsigned long tem
= face
->foreground
;
5945 face
->foreground
= face
->background
;
5946 face
->background
= tem
;
5949 if (tty_suppress_bold_inverse_default_colors_p
5951 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
5952 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
5953 face
->tty_bold_p
= 0;
5959 DEFUN ("tty-suppress-bold-inverse-default-colors",
5960 Ftty_suppress_bold_inverse_default_colors
,
5961 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
5962 doc
: /* Suppress/allow boldness of faces with inverse default colors.
5963 SUPPRESS non-nil means suppress it.
5964 This affects bold faces on TTYs whose foreground is the default background
5965 color of the display and whose background is the default foreground color.
5966 For such faces, the bold face attribute is ignored if this variable
5968 (Lisp_Object suppress
)
5970 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
5971 ++face_change_count
;
5977 /***********************************************************************
5979 ***********************************************************************/
5981 /* Return the ID of the face to use to display character CH with face
5982 property PROP on frame F in current_buffer. */
5985 compute_char_face (struct frame
*f
, int ch
, Lisp_Object prop
)
5989 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
5994 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5995 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
5999 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6000 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6001 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6002 merge_face_ref (f
, prop
, attrs
, 1, 0);
6003 face_id
= lookup_face (f
, attrs
);
6009 /* Return the face ID associated with buffer position POS for
6010 displaying ASCII characters. Return in *ENDPTR the position at
6011 which a different face is needed, as far as text properties and
6012 overlays are concerned. W is a window displaying current_buffer.
6014 REGION_BEG, REGION_END delimit the region, so it can be
6017 LIMIT is a position not to scan beyond. That is to limit the time
6018 this function can take.
6020 If MOUSE is non-zero, use the character's mouse-face, not its face.
6022 BASE_FACE_ID, if non-negative, specifies a base face id to use
6023 instead of DEFAULT_FACE_ID.
6025 The face returned is suitable for displaying ASCII characters. */
6028 face_at_buffer_position (struct window
*w
, ptrdiff_t pos
,
6029 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6030 ptrdiff_t *endptr
, ptrdiff_t limit
,
6031 int mouse
, int base_face_id
)
6033 struct frame
*f
= XFRAME (w
->frame
);
6034 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6035 Lisp_Object prop
, position
;
6036 ptrdiff_t i
, noverlays
;
6037 Lisp_Object
*overlay_vec
;
6040 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6041 Lisp_Object limit1
, end
;
6042 struct face
*default_face
;
6044 /* W must display the current buffer. We could write this function
6045 to use the frame and buffer of W, but right now it doesn't. */
6046 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6048 XSETFRAME (frame
, f
);
6049 XSETFASTINT (position
, pos
);
6052 if (pos
< region_beg
&& region_beg
< endpos
)
6053 endpos
= region_beg
;
6055 /* Get the `face' or `mouse_face' text property at POS, and
6056 determine the next position at which the property changes. */
6057 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6058 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6059 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6061 endpos
= XINT (end
);
6063 /* Look at properties from overlays. */
6065 ptrdiff_t next_overlay
;
6067 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6068 if (next_overlay
< endpos
)
6069 endpos
= next_overlay
;
6077 if (base_face_id
>= 0)
6078 face_id
= base_face_id
;
6079 else if (NILP (Vface_remapping_alist
))
6080 face_id
= DEFAULT_FACE_ID
;
6082 face_id
= lookup_basic_face (f
, DEFAULT_FACE_ID
);
6084 default_face
= FACE_FROM_ID (f
, face_id
);
6087 /* Optimize common cases where we can use the default face. */
6090 && !(pos
>= region_beg
&& pos
< region_end
))
6091 return default_face
->id
;
6093 /* Begin with attributes from the default face. */
6094 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6096 /* Merge in attributes specified via text properties. */
6098 merge_face_ref (f
, prop
, attrs
, 1, 0);
6100 /* Now merge the overlay data. */
6101 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6102 for (i
= 0; i
< noverlays
; i
++)
6107 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6109 merge_face_ref (f
, prop
, attrs
, 1, 0);
6111 oend
= OVERLAY_END (overlay_vec
[i
]);
6112 oendpos
= OVERLAY_POSITION (oend
);
6113 if (oendpos
< endpos
)
6117 /* If in the region, merge in the region face. */
6118 if (pos
>= region_beg
&& pos
< region_end
)
6120 merge_named_face (f
, Qregion
, attrs
, 0);
6122 if (region_end
< endpos
)
6123 endpos
= region_end
;
6128 /* Look up a realized face with the given face attributes,
6129 or realize a new one for ASCII characters. */
6130 return lookup_face (f
, attrs
);
6133 /* Return the face ID at buffer position POS for displaying ASCII
6134 characters associated with overlay strings for overlay OVERLAY.
6136 Like face_at_buffer_position except for OVERLAY. Currently it
6137 simply disregards the `face' properties of all overlays. */
6140 face_for_overlay_string (struct window
*w
, ptrdiff_t pos
,
6141 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6142 ptrdiff_t *endptr
, ptrdiff_t limit
,
6143 int mouse
, Lisp_Object overlay
)
6145 struct frame
*f
= XFRAME (w
->frame
);
6146 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6147 Lisp_Object prop
, position
;
6150 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6151 Lisp_Object limit1
, end
;
6152 struct face
*default_face
;
6154 /* W must display the current buffer. We could write this function
6155 to use the frame and buffer of W, but right now it doesn't. */
6156 /* eassert (XBUFFER (w->buffer) == current_buffer); */
6158 XSETFRAME (frame
, f
);
6159 XSETFASTINT (position
, pos
);
6162 if (pos
< region_beg
&& region_beg
< endpos
)
6163 endpos
= region_beg
;
6165 /* Get the `face' or `mouse_face' text property at POS, and
6166 determine the next position at which the property changes. */
6167 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6168 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6169 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6171 endpos
= XINT (end
);
6175 /* Optimize common case where we can use the default face. */
6177 && !(pos
>= region_beg
&& pos
< region_end
)
6178 && NILP (Vface_remapping_alist
))
6179 return DEFAULT_FACE_ID
;
6181 /* Begin with attributes from the default face. */
6182 default_face
= FACE_FROM_ID (f
, lookup_basic_face (f
, DEFAULT_FACE_ID
));
6183 memcpy (attrs
, default_face
->lface
, sizeof attrs
);
6185 /* Merge in attributes specified via text properties. */
6187 merge_face_ref (f
, prop
, attrs
, 1, 0);
6189 /* If in the region, merge in the region face. */
6190 if (pos
>= region_beg
&& pos
< region_end
)
6192 merge_named_face (f
, Qregion
, attrs
, 0);
6194 if (region_end
< endpos
)
6195 endpos
= region_end
;
6200 /* Look up a realized face with the given face attributes,
6201 or realize a new one for ASCII characters. */
6202 return lookup_face (f
, attrs
);
6206 /* Compute the face at character position POS in Lisp string STRING on
6207 window W, for ASCII characters.
6209 If STRING is an overlay string, it comes from position BUFPOS in
6210 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6211 not an overlay string. W must display the current buffer.
6212 REGION_BEG and REGION_END give the start and end positions of the
6213 region; both are -1 if no region is visible.
6215 BASE_FACE_ID is the id of a face to merge with. For strings coming
6216 from overlays or the `display' property it is the face at BUFPOS.
6218 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6220 Set *ENDPTR to the next position where to check for faces in
6221 STRING; -1 if the face is constant from POS to the end of the
6224 Value is the id of the face to use. The face returned is suitable
6225 for displaying ASCII characters. */
6228 face_at_string_position (struct window
*w
, Lisp_Object string
,
6229 ptrdiff_t pos
, ptrdiff_t bufpos
,
6230 ptrdiff_t region_beg
, ptrdiff_t region_end
,
6231 ptrdiff_t *endptr
, enum face_id base_face_id
,
6234 Lisp_Object prop
, position
, end
, limit
;
6235 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6236 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6237 struct face
*base_face
;
6238 int multibyte_p
= STRING_MULTIBYTE (string
);
6239 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6241 /* Get the value of the face property at the current position within
6242 STRING. Value is nil if there is no face property. */
6243 XSETFASTINT (position
, pos
);
6244 prop
= Fget_text_property (position
, prop_name
, string
);
6246 /* Get the next position at which to check for faces. Value of end
6247 is nil if face is constant all the way to the end of the string.
6248 Otherwise it is a string position where to check faces next.
6249 Limit is the maximum position up to which to check for property
6250 changes in Fnext_single_property_change. Strings are usually
6251 short, so set the limit to the end of the string. */
6252 XSETFASTINT (limit
, SCHARS (string
));
6253 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6255 *endptr
= XFASTINT (end
);
6259 base_face
= FACE_FROM_ID (f
, base_face_id
);
6260 eassert (base_face
);
6262 /* Optimize the default case that there is no face property and we
6263 are not in the region. */
6265 && (base_face_id
!= DEFAULT_FACE_ID
6266 /* BUFPOS <= 0 means STRING is not an overlay string, so
6267 that the region doesn't have to be taken into account. */
6269 || bufpos
< region_beg
6270 || bufpos
>= region_end
)
6272 /* We can't realize faces for different charsets differently
6273 if we don't have fonts, so we can stop here if not working
6274 on a window-system frame. */
6275 || !FRAME_WINDOW_P (f
)
6276 || FACE_SUITABLE_FOR_ASCII_CHAR_P (base_face
, 0)))
6277 return base_face
->id
;
6279 /* Begin with attributes from the base face. */
6280 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6282 /* Merge in attributes specified via text properties. */
6284 merge_face_ref (f
, prop
, attrs
, 1, 0);
6286 /* If in the region, merge in the region face. */
6288 && bufpos
>= region_beg
6289 && bufpos
< region_end
)
6290 merge_named_face (f
, Qregion
, attrs
, 0);
6292 /* Look up a realized face with the given face attributes,
6293 or realize a new one for ASCII characters. */
6294 return lookup_face (f
, attrs
);
6298 /* Merge a face into a realized face.
6300 F is frame where faces are (to be) realized.
6302 FACE_NAME is named face to merge.
6304 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6306 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6308 BASE_FACE_ID is realized face to merge into.
6314 merge_faces (struct frame
*f
, Lisp_Object face_name
, int face_id
,
6317 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6318 struct face
*base_face
;
6320 base_face
= FACE_FROM_ID (f
, base_face_id
);
6322 return base_face_id
;
6324 if (EQ (face_name
, Qt
))
6326 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6327 return base_face_id
;
6328 face_name
= lface_id_to_name
[face_id
];
6329 /* When called during make-frame, lookup_derived_face may fail
6330 if the faces are uninitialized. Don't signal an error. */
6331 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6332 return (face_id
>= 0 ? face_id
: base_face_id
);
6335 /* Begin with attributes from the base face. */
6336 memcpy (attrs
, base_face
->lface
, sizeof attrs
);
6338 if (!NILP (face_name
))
6340 if (!merge_named_face (f
, face_name
, attrs
, 0))
6341 return base_face_id
;
6347 return base_face_id
;
6348 face
= FACE_FROM_ID (f
, face_id
);
6350 return base_face_id
;
6351 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6354 /* Look up a realized face with the given face attributes,
6355 or realize a new one for ASCII characters. */
6356 return lookup_face (f
, attrs
);
6361 #ifndef HAVE_X_WINDOWS
6362 DEFUN ("x-load-color-file", Fx_load_color_file
,
6363 Sx_load_color_file
, 1, 1, 0,
6364 doc
: /* Create an alist of color entries from an external file.
6366 The file should define one named RGB color per line like so:
6368 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6369 (Lisp_Object filename
)
6372 Lisp_Object cmap
= Qnil
;
6373 Lisp_Object abspath
;
6375 CHECK_STRING (filename
);
6376 abspath
= Fexpand_file_name (filename
, Qnil
);
6378 fp
= fopen (SSDATA (abspath
), "rt");
6382 int red
, green
, blue
;
6387 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6388 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6390 char *name
= buf
+ num
;
6391 num
= strlen (name
) - 1;
6392 if (num
>= 0 && name
[num
] == '\n')
6394 cmap
= Fcons (Fcons (build_string (name
),
6396 make_number (RGB (red
, green
, blue
))),
6398 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6413 /***********************************************************************
6415 ***********************************************************************/
6419 /* Print the contents of the realized face FACE to stderr. */
6422 dump_realized_face (struct face
*face
)
6424 fprintf (stderr
, "ID: %d\n", face
->id
);
6425 #ifdef HAVE_X_WINDOWS
6426 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6428 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6430 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6431 fprintf (stderr
, "background: 0x%lx (%s)\n",
6433 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6435 fprintf (stderr
, "font_name: %s (%s)\n",
6436 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6437 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6438 #ifdef HAVE_X_WINDOWS
6439 fprintf (stderr
, "font = %p\n", face
->font
);
6441 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6442 fprintf (stderr
, "underline: %d (%s)\n",
6444 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6445 fprintf (stderr
, "hash: %d\n", face
->hash
);
6449 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6456 fprintf (stderr
, "font selection order: ");
6457 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6458 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6459 fprintf (stderr
, "\n");
6461 fprintf (stderr
, "alternative fonts: ");
6462 debug_print (Vface_alternative_font_family_alist
);
6463 fprintf (stderr
, "\n");
6465 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6466 Fdump_face (make_number (i
));
6472 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6474 error ("Not a valid face");
6475 dump_realized_face (face
);
6482 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6483 0, 0, 0, doc
: /* */)
6486 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6487 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6488 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6492 #endif /* GLYPH_DEBUG */
6496 /***********************************************************************
6498 ***********************************************************************/
6501 syms_of_xfaces (void)
6503 DEFSYM (Qface
, "face");
6504 DEFSYM (Qface_no_inherit
, "face-no-inherit");
6505 DEFSYM (Qbitmap_spec_p
, "bitmap-spec-p");
6506 DEFSYM (Qframe_set_background_mode
, "frame-set-background-mode");
6508 /* Lisp face attribute keywords. */
6509 DEFSYM (QCfamily
, ":family");
6510 DEFSYM (QCheight
, ":height");
6511 DEFSYM (QCweight
, ":weight");
6512 DEFSYM (QCslant
, ":slant");
6513 DEFSYM (QCunderline
, ":underline");
6514 DEFSYM (QCinverse_video
, ":inverse-video");
6515 DEFSYM (QCreverse_video
, ":reverse-video");
6516 DEFSYM (QCforeground
, ":foreground");
6517 DEFSYM (QCbackground
, ":background");
6518 DEFSYM (QCstipple
, ":stipple");
6519 DEFSYM (QCwidth
, ":width");
6520 DEFSYM (QCfont
, ":font");
6521 DEFSYM (QCfontset
, ":fontset");
6522 DEFSYM (QCbold
, ":bold");
6523 DEFSYM (QCitalic
, ":italic");
6524 DEFSYM (QCoverline
, ":overline");
6525 DEFSYM (QCstrike_through
, ":strike-through");
6526 DEFSYM (QCbox
, ":box");
6527 DEFSYM (QCinherit
, ":inherit");
6529 /* Symbols used for Lisp face attribute values. */
6530 DEFSYM (QCcolor
, ":color");
6531 DEFSYM (QCline_width
, ":line-width");
6532 DEFSYM (QCstyle
, ":style");
6533 DEFSYM (Qline
, "line");
6534 DEFSYM (Qwave
, "wave");
6535 DEFSYM (Qreleased_button
, "released-button");
6536 DEFSYM (Qpressed_button
, "pressed-button");
6537 DEFSYM (Qnormal
, "normal");
6538 DEFSYM (Qultra_light
, "ultra-light");
6539 DEFSYM (Qextra_light
, "extra-light");
6540 DEFSYM (Qlight
, "light");
6541 DEFSYM (Qsemi_light
, "semi-light");
6542 DEFSYM (Qsemi_bold
, "semi-bold");
6543 DEFSYM (Qbold
, "bold");
6544 DEFSYM (Qextra_bold
, "extra-bold");
6545 DEFSYM (Qultra_bold
, "ultra-bold");
6546 DEFSYM (Qoblique
, "oblique");
6547 DEFSYM (Qitalic
, "italic");
6548 DEFSYM (Qreverse_oblique
, "reverse-oblique");
6549 DEFSYM (Qreverse_italic
, "reverse-italic");
6550 DEFSYM (Qultra_condensed
, "ultra-condensed");
6551 DEFSYM (Qextra_condensed
, "extra-condensed");
6552 DEFSYM (Qcondensed
, "condensed");
6553 DEFSYM (Qsemi_condensed
, "semi-condensed");
6554 DEFSYM (Qsemi_expanded
, "semi-expanded");
6555 DEFSYM (Qexpanded
, "expanded");
6556 DEFSYM (Qextra_expanded
, "extra-expanded");
6557 DEFSYM (Qultra_expanded
, "ultra-expanded");
6558 DEFSYM (Qbackground_color
, "background-color");
6559 DEFSYM (Qforeground_color
, "foreground-color");
6560 DEFSYM (Qunspecified
, "unspecified");
6561 DEFSYM (QCignore_defface
, ":ignore-defface");
6563 DEFSYM (Qface_alias
, "face-alias");
6564 DEFSYM (Qdefault
, "default");
6565 DEFSYM (Qtool_bar
, "tool-bar");
6566 DEFSYM (Qregion
, "region");
6567 DEFSYM (Qfringe
, "fringe");
6568 DEFSYM (Qheader_line
, "header-line");
6569 DEFSYM (Qscroll_bar
, "scroll-bar");
6570 DEFSYM (Qmenu
, "menu");
6571 DEFSYM (Qcursor
, "cursor");
6572 DEFSYM (Qborder
, "border");
6573 DEFSYM (Qmouse
, "mouse");
6574 DEFSYM (Qmode_line_inactive
, "mode-line-inactive");
6575 DEFSYM (Qvertical_border
, "vertical-border");
6576 DEFSYM (Qtty_color_desc
, "tty-color-desc");
6577 DEFSYM (Qtty_color_standard_values
, "tty-color-standard-values");
6578 DEFSYM (Qtty_color_by_index
, "tty-color-by-index");
6579 DEFSYM (Qtty_color_alist
, "tty-color-alist");
6580 DEFSYM (Qscalable_fonts_allowed
, "scalable-fonts-allowed");
6582 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6583 staticpro (&Vparam_value_alist
);
6584 Vface_alternative_font_family_alist
= Qnil
;
6585 staticpro (&Vface_alternative_font_family_alist
);
6586 Vface_alternative_font_registry_alist
= Qnil
;
6587 staticpro (&Vface_alternative_font_registry_alist
);
6589 defsubr (&Sinternal_make_lisp_face
);
6590 defsubr (&Sinternal_lisp_face_p
);
6591 defsubr (&Sinternal_set_lisp_face_attribute
);
6592 #ifdef HAVE_WINDOW_SYSTEM
6593 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6595 defsubr (&Scolor_gray_p
);
6596 defsubr (&Scolor_supported_p
);
6597 #ifndef HAVE_X_WINDOWS
6598 defsubr (&Sx_load_color_file
);
6600 defsubr (&Sface_attribute_relative_p
);
6601 defsubr (&Smerge_face_attribute
);
6602 defsubr (&Sinternal_get_lisp_face_attribute
);
6603 defsubr (&Sinternal_lisp_face_attribute_values
);
6604 defsubr (&Sinternal_lisp_face_equal_p
);
6605 defsubr (&Sinternal_lisp_face_empty_p
);
6606 defsubr (&Sinternal_copy_lisp_face
);
6607 defsubr (&Sinternal_merge_in_global_face
);
6608 defsubr (&Sface_font
);
6609 defsubr (&Sframe_face_alist
);
6610 defsubr (&Sdisplay_supports_face_attributes_p
);
6611 defsubr (&Scolor_distance
);
6612 defsubr (&Sinternal_set_font_selection_order
);
6613 defsubr (&Sinternal_set_alternative_font_family_alist
);
6614 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6615 defsubr (&Sface_attributes_as_vector
);
6617 defsubr (&Sdump_face
);
6618 defsubr (&Sshow_face_resources
);
6619 #endif /* GLYPH_DEBUG */
6620 defsubr (&Sclear_face_cache
);
6621 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6623 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6624 defsubr (&Sdump_colors
);
6627 DEFVAR_LISP ("font-list-limit", Vfont_list_limit
,
6628 doc
: /* Limit for font matching.
6629 If an integer > 0, font matching functions won't load more than
6630 that number of fonts when searching for a matching font. */);
6631 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6633 DEFVAR_LISP ("face-new-frame-defaults", Vface_new_frame_defaults
,
6634 doc
: /* List of global face definitions (for internal use only.) */);
6635 Vface_new_frame_defaults
= Qnil
;
6637 DEFVAR_LISP ("face-default-stipple", Vface_default_stipple
,
6638 doc
: /* Default stipple pattern used on monochrome displays.
6639 This stipple pattern is used on monochrome displays
6640 instead of shades of gray for a face background color.
6641 See `set-face-stipple' for possible values for this variable. */);
6642 Vface_default_stipple
= build_pure_c_string ("gray3");
6644 DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist
,
6645 doc
: /* An alist of defined terminal colors and their RGB values.
6646 See the docstring of `tty-color-alist' for the details. */);
6647 Vtty_defined_color_alist
= Qnil
;
6649 DEFVAR_LISP ("scalable-fonts-allowed", Vscalable_fonts_allowed
,
6650 doc
: /* Allowed scalable fonts.
6651 A value of nil means don't allow any scalable fonts.
6652 A value of t means allow any scalable font.
6653 Otherwise, value must be a list of regular expressions. A font may be
6654 scaled if its name matches a regular expression in the list.
6655 Note that if value is nil, a scalable font might still be used, if no
6656 other font of the appropriate family and registry is available. */);
6657 Vscalable_fonts_allowed
= Qnil
;
6659 DEFVAR_LISP ("face-ignored-fonts", Vface_ignored_fonts
,
6660 doc
: /* List of ignored fonts.
6661 Each element is a regular expression that matches names of fonts to
6663 Vface_ignored_fonts
= Qnil
;
6665 DEFVAR_LISP ("face-remapping-alist", Vface_remapping_alist
,
6666 doc
: /* Alist of face remappings.
6667 Each element is of the form:
6669 (FACE . REPLACEMENT),
6671 which causes display of the face FACE to use REPLACEMENT instead.
6672 REPLACEMENT is a face specification, i.e. one of the following:
6675 (2) a property list of attribute/value pairs, or
6676 (3) a list in which each element has the form of (1) or (2).
6678 List values for REPLACEMENT are merged to form the final face
6679 specification, with earlier entries taking precedence, in the same as
6680 as in the `face' text property.
6682 Face-name remapping cycles are suppressed; recursive references use
6683 the underlying face instead of the remapped face. So a remapping of
6686 (FACE EXTRA-FACE... FACE)
6690 (FACE (FACE-ATTR VAL ...) FACE)
6692 causes EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
6693 existing definition of FACE. Note that this isn't necessary for the
6694 default face, since every face inherits from the default face.
6696 If this variable is made buffer-local, the face remapping takes effect
6697 only in that buffer. For instance, the mode my-mode could define a
6698 face `my-mode-default', and then in the mode setup function, do:
6700 (set (make-local-variable 'face-remapping-alist)
6701 '((default my-mode-default)))).
6703 Because Emacs normally only redraws screen areas when the underlying
6704 buffer contents change, you may need to call `redraw-display' after
6705 changing this variable for it to take effect. */);
6706 Vface_remapping_alist
= Qnil
;
6708 DEFVAR_LISP ("face-font-rescale-alist", Vface_font_rescale_alist
,
6709 doc
: /* Alist of fonts vs the rescaling factors.
6710 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
6711 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
6712 RESCALE-RATIO is a floating point number to specify how much larger
6713 \(or smaller) font we should use. For instance, if a face requests
6714 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6715 Vface_font_rescale_alist
= Qnil
;
6717 #ifdef HAVE_WINDOW_SYSTEM
6718 defsubr (&Sbitmap_spec_p
);
6719 defsubr (&Sx_list_fonts
);
6720 defsubr (&Sinternal_face_x_get_resource
);
6721 defsubr (&Sx_family_fonts
);