1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008, 2009, 2010, 2011, 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
30 2. Font foundary name.
32 3. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 4. Font height in 1/10pt.
37 5. Font weight, e.g. `bold'.
39 6. Font slant, e.g. `italic'.
45 9. Whether or not characters should be underlined, and in what color.
47 10. Whether or not characters should be displayed in inverse video.
49 11. A background stipple, a bitmap.
51 12. Whether or not characters should be overlined, and in what color.
53 13. Whether or not characters should be strike-through, and in what
56 14. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 15. Font-spec, or nil. This is a special attribute.
61 A font-spec is a collection of font attributes (specs).
63 When this attribute is specified, the face uses a font matching
64 with the specs as is except for what overwritten by the specs in
65 the fontset (see below). In addition, the other font-related
66 attributes (1st thru 5th) are updated from the spec.
68 On the other hand, if one of the other font-related attributes are
69 specified, the correspoinding specs in this attribute is set to nil.
71 15. A face name or list of face names from which to inherit attributes.
73 16. A specified average font width, which is invisible from Lisp,
74 and is used to ensure that a font specified on the command line,
75 for example, can be matched exactly.
77 17. A fontset name. This is another special attribute.
79 A fontset is a mappings from characters to font-specs, and the
80 specs overwrite the font-spec in the 14th attribute.
83 Faces are frame-local by nature because Emacs allows to define the
84 same named face (face names are symbols) differently for different
85 frames. Each frame has an alist of face definitions for all named
86 faces. The value of a named face in such an alist is a Lisp vector
87 with the symbol `face' in slot 0, and a slot for each of the face
88 attributes mentioned above.
90 There is also a global face alist `Vface_new_frame_defaults'. Face
91 definitions from this list are used to initialize faces of newly
94 A face doesn't have to specify all attributes. Those not specified
95 have a value of `unspecified'. Faces specifying all attributes but
96 the 14th are called `fully-specified'.
101 The display style of a given character in the text is determined by
102 combining several faces. This process is called `face merging'.
103 Any aspect of the display style that isn't specified by overlays or
104 text properties is taken from the `default' face. Since it is made
105 sure that the default face is always fully-specified, face merging
106 always results in a fully-specified face.
111 After all face attributes for a character have been determined by
112 merging faces of that character, that face is `realized'. The
113 realization process maps face attributes to what is physically
114 available on the system where Emacs runs. The result is a
115 `realized face' in form of a struct face which is stored in the
116 face cache of the frame on which it was realized.
118 Face realization is done in the context of the character to display
119 because different fonts may be used for different characters. In
120 other words, for characters that have different font
121 specifications, different realized faces are needed to display
124 Font specification is done by fontsets. See the comment in
125 fontset.c for the details. In the current implementation, all ASCII
126 characters share the same font in a fontset.
128 Faces are at first realized for ASCII characters, and, at that
129 time, assigned a specific realized fontset. Hereafter, we call
130 such a face as `ASCII face'. When a face for a multibyte character
131 is realized, it inherits (thus shares) a fontset of an ASCII face
132 that has the same attributes other than font-related ones.
134 Thus, all realized faces have a realized fontset.
139 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
140 font as ASCII characters. That is because it is expected that
141 unibyte text users specify a font that is suitable both for ASCII
142 and raw 8-bit characters.
147 Font selection tries to find the best available matching font for a
148 given (character, face) combination.
150 If the face specifies a fontset name, that fontset determines a
151 pattern for fonts of the given character. If the face specifies a
152 font name or the other font-related attributes, a fontset is
153 realized from the default fontset. In that case, that
154 specification determines a pattern for ASCII characters and the
155 default fontset determines a pattern for multibyte characters.
157 Available fonts on the system on which Emacs runs are then matched
158 against the font pattern. The result of font selection is the best
159 match for the given face attributes in this font list.
161 Font selection can be influenced by the user.
163 1. The user can specify the relative importance he gives the face
164 attributes width, height, weight, and slant by setting
165 face-font-selection-order (faces.el) to a list of face attribute
166 names. The default is '(:width :height :weight :slant), and means
167 that font selection first tries to find a good match for the font
168 width specified by a face, then---within fonts with that
169 width---tries to find a best match for the specified font height,
172 2. Setting face-font-family-alternatives allows the user to
173 specify alternative font families to try if a family specified by a
176 3. Setting face-font-registry-alternatives allows the user to
177 specify all alternative font registries to try for a face
178 specifying a registry.
180 4. Setting face-ignored-fonts allows the user to ignore specific
184 Character composition.
186 Usually, the realization process is already finished when Emacs
187 actually reflects the desired glyph matrix on the screen. However,
188 on displaying a composition (sequence of characters to be composed
189 on the screen), a suitable font for the components of the
190 composition is selected and realized while drawing them on the
191 screen, i.e. the realization process is delayed but in principle
195 Initialization of basic faces.
197 The faces `default', `modeline' are considered `basic faces'.
198 When redisplay happens the first time for a newly created frame,
199 basic faces are realized for CHARSET_ASCII. Frame parameters are
200 used to fill in unspecified attributes of the default face. */
204 #include <sys/types.h>
205 #include <sys/stat.h>
206 #include <stdio.h> /* This needs to be before termchar.h */
210 #include "character.h"
212 #include "keyboard.h"
214 #include "termhooks.h"
216 #ifdef HAVE_X_WINDOWS
220 #include <Xm/XmStrDefs.h>
221 #endif /* USE_MOTIF */
222 #endif /* HAVE_X_WINDOWS */
231 /* Redefine X specifics to W32 equivalents to avoid cluttering the
232 code with #ifdef blocks. */
233 #undef FRAME_X_DISPLAY_INFO
234 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
235 #define x_display_info w32_display_info
236 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
237 #define check_x check_w32
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #undef FRAME_X_DISPLAY_INFO
244 #define FRAME_X_DISPLAY_INFO FRAME_NS_DISPLAY_INFO
245 #define x_display_info ns_display_info
246 #define FRAME_X_FONT_TABLE FRAME_NS_FONT_TABLE
247 #define check_x check_ns
248 #define GCGraphicsExposures 0
252 #include "dispextern.h"
253 #include "blockinput.h"
255 #include "intervals.h"
256 #include "termchar.h"
259 #ifdef HAVE_WINDOW_SYSTEM
261 #endif /* HAVE_WINDOW_SYSTEM */
263 #ifdef HAVE_X_WINDOWS
265 /* Compensate for a bug in Xos.h on some systems, on which it requires
266 time.h. On some such systems, Xos.h tries to redefine struct
267 timeval and struct timezone if USG is #defined while it is
270 #ifdef XOS_NEEDS_TIME_H
276 #else /* not XOS_NEEDS_TIME_H */
278 #endif /* not XOS_NEEDS_TIME_H */
280 #endif /* HAVE_X_WINDOWS */
284 /* Number of pt per inch (from the TeXbook). */
286 #define PT_PER_INCH 72.27
288 /* Non-zero if face attribute ATTR is unspecified. */
290 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
292 /* Non-zero if face attribute ATTR is `ignore-defface'. */
294 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)
296 /* Value is the number of elements of VECTOR. */
298 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
300 /* Make a copy of string S on the stack using alloca. Value is a pointer
303 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
305 /* Make a copy of the contents of Lisp string S on the stack using
306 alloca. Value is a pointer to the copy. */
308 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
310 /* Size of hash table of realized faces in face caches (should be a
313 #define FACE_CACHE_BUCKETS_SIZE 1001
315 /* Keyword symbols used for face attribute names. */
317 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
318 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
319 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
320 Lisp_Object QCreverse_video
;
321 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
322 Lisp_Object QCfontset
;
324 /* Keywords symbols used for font properties. */
325 extern Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
326 extern Lisp_Object QCspacing
, QCsize
, QCavgwidth
;
327 extern Lisp_Object Qp
;
329 /* Symbols used for attribute values. */
331 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
332 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
333 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
334 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
335 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
336 Lisp_Object Qultra_expanded
;
337 Lisp_Object Qreleased_button
, Qpressed_button
;
338 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
339 Lisp_Object Qunspecified
;
340 Lisp_Object Qignore_defface
;
342 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
344 /* The name of the function to call when the background of the frame
345 has changed, frame_set_background_mode. */
347 Lisp_Object Qframe_set_background_mode
;
349 /* Names of basic faces. */
351 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
352 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
353 Lisp_Object Qmode_line_inactive
, Qvertical_border
;
354 extern Lisp_Object Qmode_line
;
356 /* The symbol `face-alias'. A symbols having that property is an
357 alias for another face. Value of the property is the name of
360 Lisp_Object Qface_alias
;
362 extern Lisp_Object Qcircular_list
;
364 /* Default stipple pattern used on monochrome displays. This stipple
365 pattern is used on monochrome displays instead of shades of gray
366 for a face background color. See `set-face-stipple' for possible
367 values for this variable. */
369 Lisp_Object Vface_default_stipple
;
371 /* Alist of alternative font families. Each element is of the form
372 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
373 try FAMILY1, then FAMILY2, ... */
375 Lisp_Object Vface_alternative_font_family_alist
;
377 /* Alist of alternative font registries. Each element is of the form
378 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
379 loaded, try REGISTRY1, then REGISTRY2, ... */
381 Lisp_Object Vface_alternative_font_registry_alist
;
383 /* Allowed scalable fonts. A value of nil means don't allow any
384 scalable fonts. A value of t means allow the use of any scalable
385 font. Otherwise, value must be a list of regular expressions. A
386 font may be scaled if its name matches a regular expression in the
389 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
391 /* List of regular expressions that matches names of fonts to ignore. */
393 Lisp_Object Vface_ignored_fonts
;
395 /* Alist of font name patterns vs the rescaling factor. */
397 Lisp_Object Vface_font_rescale_alist
;
399 /* Maximum number of fonts to consider in font_list. If not an
400 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
402 Lisp_Object Vfont_list_limit
;
403 #define DEFAULT_FONT_LIST_LIMIT 100
405 /* The symbols `foreground-color' and `background-color' which can be
406 used as part of a `face' property. This is for compatibility with
409 Lisp_Object Qforeground_color
, Qbackground_color
;
411 /* The symbols `face' and `mouse-face' used as text properties. */
414 extern Lisp_Object Qmouse_face
;
416 /* Property for basic faces which other faces cannot inherit. */
418 Lisp_Object Qface_no_inherit
;
420 /* Error symbol for wrong_type_argument in load_pixmap. */
422 Lisp_Object Qbitmap_spec_p
;
424 /* Alist of global face definitions. Each element is of the form
425 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
426 is a Lisp vector of face attributes. These faces are used
427 to initialize faces for new frames. */
429 Lisp_Object Vface_new_frame_defaults
;
431 /* Alist of face remappings. Each element is of the form:
432 (FACE REPLACEMENT...) which causes display of the face FACE to use
433 REPLACEMENT... instead. REPLACEMENT... is interpreted the same way
434 the value of a `face' text property is: it may be (1) A face name,
435 (2) A list of face names, (3) A property-list of face attribute/value
436 pairs, or (4) A list of face names intermixed with lists containing
437 face attribute/value pairs.
439 Multiple entries in REPLACEMENT... are merged together to form the final
440 result, with faces or attributes earlier in the list taking precedence
441 over those that are later.
443 Face-name remapping cycles are suppressed; recursive references use
444 the underlying face instead of the remapped face. */
446 Lisp_Object Vface_remapping_alist
;
448 /* The next ID to assign to Lisp faces. */
450 static int next_lface_id
;
452 /* A vector mapping Lisp face Id's to face names. */
454 static Lisp_Object
*lface_id_to_name
;
455 static int lface_id_to_name_size
;
457 /* TTY color-related functions (defined in tty-colors.el). */
459 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
461 /* The name of the function used to compute colors on TTYs. */
463 Lisp_Object Qtty_color_alist
;
465 /* An alist of defined terminal colors and their RGB values. */
467 Lisp_Object Vtty_defined_color_alist
;
469 /* Counter for calls to clear_face_cache. If this counter reaches
470 CLEAR_FONT_TABLE_COUNT, and a frame has more than
471 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
473 static int clear_font_table_count
;
474 #define CLEAR_FONT_TABLE_COUNT 100
475 #define CLEAR_FONT_TABLE_NFONTS 10
477 /* Non-zero means face attributes have been changed since the last
478 redisplay. Used in redisplay_internal. */
480 int face_change_count
;
482 /* Non-zero means don't display bold text if a face's foreground
483 and background colors are the inverse of the default colors of the
484 display. This is a kluge to suppress `bold black' foreground text
485 which is hard to read on an LCD monitor. */
487 int tty_suppress_bold_inverse_default_colors_p
;
489 /* A list of the form `((x . y))' used to avoid consing in
490 Finternal_set_lisp_face_attribute. */
492 static Lisp_Object Vparam_value_alist
;
494 /* The total number of colors currently allocated. */
497 static int ncolors_allocated
;
498 static int npixmaps_allocated
;
502 /* Non-zero means the definition of the `menu' face for new frames has
505 int menu_face_changed_default
;
508 /* Function prototypes. */
511 struct named_merge_point
;
513 static void map_tty_color
P_ ((struct frame
*, struct face
*,
514 enum lface_attribute_index
, int *));
515 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
, int));
516 static int may_use_scalable_font_p
P_ ((const char *));
517 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
518 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
519 int, struct named_merge_point
*));
520 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
521 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
522 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
523 static void free_face_colors
P_ ((struct frame
*, struct face
*));
524 static int face_color_gray_p
P_ ((struct frame
*, char *));
525 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
527 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, Lisp_Object
,
529 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
530 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
531 static int realize_basic_faces
P_ ((struct frame
*));
532 static int realize_default_face
P_ ((struct frame
*));
533 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
534 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
535 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
536 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
537 static unsigned lface_hash
P_ ((Lisp_Object
*));
538 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
539 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
540 static void clear_face_gcs
P_ ((struct face_cache
*));
541 static void free_face_cache
P_ ((struct face_cache
*));
542 static int face_fontset
P_ ((Lisp_Object
*));
543 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
544 struct named_merge_point
*));
545 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
546 int, struct named_merge_point
*));
547 static int set_lface_from_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
549 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
550 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
551 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
552 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
554 #ifdef HAVE_WINDOW_SYSTEM
556 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
557 static void x_free_gc
P_ ((struct frame
*, GC
));
560 static void x_update_menu_appearance
P_ ((struct frame
*));
562 extern void free_frame_menubar
P_ ((struct frame
*));
563 #endif /* USE_X_TOOLKIT */
565 #endif /* HAVE_WINDOW_SYSTEM */
568 /***********************************************************************
570 ***********************************************************************/
572 #ifdef HAVE_X_WINDOWS
574 #ifdef DEBUG_X_COLORS
576 /* The following is a poor mans infrastructure for debugging X color
577 allocation problems on displays with PseudoColor-8. Some X servers
578 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
579 color reference counts completely so that they don't signal an
580 error when a color is freed whose reference count is already 0.
581 Other X servers do. To help me debug this, the following code
582 implements a simple reference counting schema of its own, for a
583 single display/screen. --gerd. */
585 /* Reference counts for pixel colors. */
587 int color_count
[256];
589 /* Register color PIXEL as allocated. */
592 register_color (pixel
)
595 xassert (pixel
< 256);
596 ++color_count
[pixel
];
600 /* Register color PIXEL as deallocated. */
603 unregister_color (pixel
)
606 xassert (pixel
< 256);
607 if (color_count
[pixel
] > 0)
608 --color_count
[pixel
];
614 /* Register N colors from PIXELS as deallocated. */
617 unregister_colors (pixels
, n
)
618 unsigned long *pixels
;
622 for (i
= 0; i
< n
; ++i
)
623 unregister_color (pixels
[i
]);
627 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
628 doc
: /* Dump currently allocated colors to stderr. */)
633 fputc ('\n', stderr
);
635 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
638 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
641 fputc ('\n', stderr
);
643 fputc ('\t', stderr
);
647 fputc ('\n', stderr
);
651 #endif /* DEBUG_X_COLORS */
654 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
655 color values. Interrupt input must be blocked when this function
659 x_free_colors (f
, pixels
, npixels
)
661 unsigned long *pixels
;
664 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
666 /* If display has an immutable color map, freeing colors is not
667 necessary and some servers don't allow it. So don't do it. */
668 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
670 #ifdef DEBUG_X_COLORS
671 unregister_colors (pixels
, npixels
);
673 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
679 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
680 color values. Interrupt input must be blocked when this function
684 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
688 unsigned long *pixels
;
691 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
692 int class = dpyinfo
->visual
->class;
694 /* If display has an immutable color map, freeing colors is not
695 necessary and some servers don't allow it. So don't do it. */
696 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
698 #ifdef DEBUG_X_COLORS
699 unregister_colors (pixels
, npixels
);
701 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
706 /* Create and return a GC for use on frame F. GC values and mask
707 are given by XGCV and MASK. */
710 x_create_gc (f
, mask
, xgcv
)
717 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
724 /* Free GC which was used on frame F. */
731 eassert (interrupt_input_blocked
);
732 IF_DEBUG (xassert (--ngcs
>= 0));
733 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
736 #endif /* HAVE_X_WINDOWS */
739 /* W32 emulation of GCs */
742 x_create_gc (f
, mask
, xgcv
)
749 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
756 /* Free GC which was used on frame F. */
763 IF_DEBUG (xassert (--ngcs
>= 0));
767 #endif /* WINDOWSNT */
770 /* NS emulation of GCs */
773 x_create_gc (f
, mask
, xgcv
)
778 GC gc
= xmalloc (sizeof (*gc
));
780 bcopy(xgcv
, gc
, sizeof(XGCValues
));
793 /* Like strcasecmp/stricmp. Used to compare parts of font names which
798 const unsigned char *s1
, *s2
;
802 unsigned char c1
= tolower (*s1
);
803 unsigned char c2
= tolower (*s2
);
805 return c1
< c2
? -1 : 1;
810 return *s2
== 0 ? 0 : -1;
815 /* If FRAME is nil, return a pointer to the selected frame.
816 Otherwise, check that FRAME is a live frame, and return a pointer
817 to it. NPARAM is the parameter number of FRAME, for
818 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
819 Lisp function definitions. */
821 static INLINE
struct frame
*
822 frame_or_selected_frame (frame
, nparam
)
827 frame
= selected_frame
;
829 CHECK_LIVE_FRAME (frame
);
830 return XFRAME (frame
);
834 /***********************************************************************
836 ***********************************************************************/
838 /* Initialize face cache and basic faces for frame F. */
844 /* Make a face cache, if F doesn't have one. */
845 if (FRAME_FACE_CACHE (f
) == NULL
)
846 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
848 #ifdef HAVE_WINDOW_SYSTEM
849 /* Make the image cache. */
850 if (FRAME_WINDOW_P (f
))
852 /* We initialize the image cache when creating the first frame
853 on a terminal, and not during terminal creation. This way,
854 `x-open-connection' on a tty won't create an image cache. */
855 if (FRAME_IMAGE_CACHE (f
) == NULL
)
856 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
857 ++FRAME_IMAGE_CACHE (f
)->refcount
;
859 #endif /* HAVE_WINDOW_SYSTEM */
861 /* Realize basic faces. Must have enough information in frame
862 parameters to realize basic faces at this point. */
863 #ifdef HAVE_X_WINDOWS
864 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
867 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
870 if (!FRAME_NS_P (f
) || FRAME_NS_WINDOW (f
))
872 if (!realize_basic_faces (f
))
877 /* Free face cache of frame F. Called from delete_frame. */
883 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
887 free_face_cache (face_cache
);
888 FRAME_FACE_CACHE (f
) = NULL
;
891 #ifdef HAVE_WINDOW_SYSTEM
892 if (FRAME_WINDOW_P (f
))
894 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
897 --image_cache
->refcount
;
898 if (image_cache
->refcount
== 0)
899 free_image_cache (f
);
902 #endif /* HAVE_WINDOW_SYSTEM */
906 /* Clear face caches, and recompute basic faces for frame F. Call
907 this after changing frame parameters on which those faces depend,
908 or when realized faces have been freed due to changing attributes
912 recompute_basic_faces (f
)
915 if (FRAME_FACE_CACHE (f
))
917 clear_face_cache (0);
918 if (!realize_basic_faces (f
))
924 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
925 try to free unused fonts, too. */
928 clear_face_cache (clear_fonts_p
)
931 #ifdef HAVE_WINDOW_SYSTEM
932 Lisp_Object tail
, frame
;
936 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
939 /* Not yet implemented. */
940 clear_font_cache (frame
);
943 /* From time to time see if we can unload some fonts. This also
944 frees all realized faces on all frames. Fonts needed by
945 faces will be loaded again when faces are realized again. */
946 clear_font_table_count
= 0;
948 FOR_EACH_FRAME (tail
, frame
)
950 struct frame
*f
= XFRAME (frame
);
951 if (FRAME_WINDOW_P (f
)
952 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
953 free_all_realized_faces (frame
);
958 /* Clear GCs of realized faces. */
959 FOR_EACH_FRAME (tail
, frame
)
962 if (FRAME_WINDOW_P (f
))
963 clear_face_gcs (FRAME_FACE_CACHE (f
));
965 clear_image_caches (Qnil
);
967 #endif /* HAVE_WINDOW_SYSTEM */
971 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
972 doc
: /* Clear face caches on all frames.
973 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
975 Lisp_Object thoroughly
;
977 clear_face_cache (!NILP (thoroughly
));
979 ++windows_or_buffers_changed
;
984 /***********************************************************************
986 ***********************************************************************/
988 #ifdef HAVE_WINDOW_SYSTEM
990 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
991 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
992 A bitmap specification is either a string, a file name, or a list
993 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
994 HEIGHT is its height, and DATA is a string containing the bits of
995 the pixmap. Bits are stored row by row, each row occupies
996 \(WIDTH + 7)/8 bytes. */)
1002 if (STRINGP (object
))
1003 /* If OBJECT is a string, it's a file name. */
1005 else if (CONSP (object
))
1007 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1008 HEIGHT must be integers > 0, and DATA must be string large
1009 enough to hold a bitmap of the specified size. */
1010 Lisp_Object width
, height
, data
;
1012 height
= width
= data
= Qnil
;
1016 width
= XCAR (object
);
1017 object
= XCDR (object
);
1020 height
= XCAR (object
);
1021 object
= XCDR (object
);
1023 data
= XCAR (object
);
1027 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1029 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1031 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1036 return pixmap_p
? Qt
: Qnil
;
1040 /* Load a bitmap according to NAME (which is either a file name or a
1041 pixmap spec) for use on frame F. Value is the bitmap_id (see
1042 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1043 bitmap cannot be loaded, display a message saying so, and return
1044 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1045 if these pointers are not null. */
1048 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1051 unsigned int *w_ptr
, *h_ptr
;
1058 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
1063 /* Decode a bitmap spec into a bitmap. */
1068 w
= XINT (Fcar (name
));
1069 h
= XINT (Fcar (Fcdr (name
)));
1070 bits
= Fcar (Fcdr (Fcdr (name
)));
1072 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1077 /* It must be a string -- a file name. */
1078 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1084 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
1095 ++npixmaps_allocated
;
1098 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1101 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1107 #endif /* HAVE_WINDOW_SYSTEM */
1111 /***********************************************************************
1113 ***********************************************************************/
1115 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1116 RGB_LIST should contain (at least) 3 lisp integers.
1117 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1120 parse_rgb_list (rgb_list
, color
)
1121 Lisp_Object rgb_list
;
1124 #define PARSE_RGB_LIST_FIELD(field) \
1125 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1127 color->field = XINT (XCAR (rgb_list)); \
1128 rgb_list = XCDR (rgb_list); \
1133 PARSE_RGB_LIST_FIELD (red
);
1134 PARSE_RGB_LIST_FIELD (green
);
1135 PARSE_RGB_LIST_FIELD (blue
);
1141 /* Lookup on frame F the color described by the lisp string COLOR.
1142 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1143 non-zero, then the `standard' definition of the same color is
1147 tty_lookup_color (f
, color
, tty_color
, std_color
)
1150 XColor
*tty_color
, *std_color
;
1152 Lisp_Object frame
, color_desc
;
1154 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1157 XSETFRAME (frame
, f
);
1159 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1160 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1164 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1167 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1169 rgb
= XCDR (XCDR (color_desc
));
1170 if (! parse_rgb_list (rgb
, tty_color
))
1173 /* Should we fill in STD_COLOR too? */
1176 /* Default STD_COLOR to the same as TTY_COLOR. */
1177 *std_color
= *tty_color
;
1179 /* Do a quick check to see if the returned descriptor is
1180 actually _exactly_ equal to COLOR, otherwise we have to
1181 lookup STD_COLOR separately. If it's impossible to lookup
1182 a standard color, we just give up and use TTY_COLOR. */
1183 if ((!STRINGP (XCAR (color_desc
))
1184 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1185 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1187 /* Look up STD_COLOR separately. */
1188 rgb
= call1 (Qtty_color_standard_values
, color
);
1189 if (! parse_rgb_list (rgb
, std_color
))
1196 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1197 /* We were called early during startup, and the colors are not
1198 yet set up in tty-defined-color-alist. Don't return a failure
1199 indication, since this produces the annoying "Unable to
1200 load color" messages in the *Messages* buffer. */
1203 /* tty-color-desc seems to have returned a bad value. */
1207 /* A version of defined_color for non-X frames. */
1210 tty_defined_color (f
, color_name
, color_def
, alloc
)
1219 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1221 color_def
->blue
= 0;
1222 color_def
->green
= 0;
1225 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1227 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1229 if (strcmp (color_name
, "unspecified-fg") == 0)
1230 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1231 else if (strcmp (color_name
, "unspecified-bg") == 0)
1232 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1235 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1242 /* Decide if color named COLOR_NAME is valid for the display
1243 associated with the frame F; if so, return the rgb values in
1244 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1246 This does the right thing for any type of frame. */
1249 defined_color (f
, color_name
, color_def
, alloc
)
1255 if (!FRAME_WINDOW_P (f
))
1256 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1257 #ifdef HAVE_X_WINDOWS
1258 else if (FRAME_X_P (f
))
1259 return x_defined_color (f
, color_name
, color_def
, alloc
);
1262 else if (FRAME_W32_P (f
))
1263 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1266 else if (FRAME_NS_P (f
))
1267 return ns_defined_color (f
, color_name
, color_def
, alloc
, 1);
1274 /* Given the index IDX of a tty color on frame F, return its name, a
1278 tty_color_name (f
, idx
)
1282 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1285 Lisp_Object coldesc
;
1287 XSETFRAME (frame
, f
);
1288 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1290 if (!NILP (coldesc
))
1291 return XCAR (coldesc
);
1294 /* We can have an MSDOG frame under -nw for a short window of
1295 opportunity before internal_terminal_init is called. DTRT. */
1296 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1297 return msdos_stdcolor_name (idx
);
1300 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1301 return build_string (unspecified_fg
);
1302 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1303 return build_string (unspecified_bg
);
1305 return Qunspecified
;
1309 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1312 The criterion implemented here is not a terribly sophisticated one. */
1315 face_color_gray_p (f
, color_name
)
1322 if (defined_color (f
, color_name
, &color
, 0))
1323 gray_p
= (/* Any color sufficiently close to black counts as grey. */
1324 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1326 ((eabs (color
.red
- color
.green
)
1327 < max (color
.red
, color
.green
) / 20)
1328 && (eabs (color
.green
- color
.blue
)
1329 < max (color
.green
, color
.blue
) / 20)
1330 && (eabs (color
.blue
- color
.red
)
1331 < max (color
.blue
, color
.red
) / 20)));
1339 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1340 BACKGROUND_P non-zero means the color will be used as background
1344 face_color_supported_p (f
, color_name
, background_p
)
1352 XSETFRAME (frame
, f
);
1354 #ifdef HAVE_WINDOW_SYSTEM
1356 ? (!NILP (Fxw_display_color_p (frame
))
1357 || xstrcasecmp (color_name
, "black") == 0
1358 || xstrcasecmp (color_name
, "white") == 0
1360 && face_color_gray_p (f
, color_name
))
1361 || (!NILP (Fx_display_grayscale_p (frame
))
1362 && face_color_gray_p (f
, color_name
)))
1365 tty_defined_color (f
, color_name
, ¬_used
, 0);
1369 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1370 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1371 FRAME specifies the frame and thus the display for interpreting COLOR.
1372 If FRAME is nil or omitted, use the selected frame. */)
1374 Lisp_Object color
, frame
;
1378 CHECK_STRING (color
);
1380 frame
= selected_frame
;
1382 CHECK_FRAME (frame
);
1384 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1388 DEFUN ("color-supported-p", Fcolor_supported_p
,
1389 Scolor_supported_p
, 1, 3, 0,
1390 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1391 BACKGROUND-P non-nil means COLOR is used as a background.
1392 Otherwise, this function tells whether it can be used as a foreground.
1393 If FRAME is nil or omitted, use the selected frame.
1394 COLOR must be a valid color name. */)
1395 (color
, frame
, background_p
)
1396 Lisp_Object frame
, color
, background_p
;
1400 CHECK_STRING (color
);
1402 frame
= selected_frame
;
1404 CHECK_FRAME (frame
);
1406 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1412 /* Load color with name NAME for use by face FACE on frame F.
1413 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1414 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1415 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1416 pixel color. If color cannot be loaded, display a message, and
1417 return the foreground, background or underline color of F, but
1418 record that fact in flags of the face so that we don't try to free
1422 load_color (f
, face
, name
, target_index
)
1426 enum lface_attribute_index target_index
;
1430 xassert (STRINGP (name
));
1431 xassert (target_index
== LFACE_FOREGROUND_INDEX
1432 || target_index
== LFACE_BACKGROUND_INDEX
1433 || target_index
== LFACE_UNDERLINE_INDEX
1434 || target_index
== LFACE_OVERLINE_INDEX
1435 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1436 || target_index
== LFACE_BOX_INDEX
);
1438 /* if the color map is full, defined_color will return a best match
1439 to the values in an existing cell. */
1440 if (!defined_color (f
, SDATA (name
), &color
, 1))
1442 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1444 switch (target_index
)
1446 case LFACE_FOREGROUND_INDEX
:
1447 face
->foreground_defaulted_p
= 1;
1448 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1451 case LFACE_BACKGROUND_INDEX
:
1452 face
->background_defaulted_p
= 1;
1453 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1456 case LFACE_UNDERLINE_INDEX
:
1457 face
->underline_defaulted_p
= 1;
1458 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1461 case LFACE_OVERLINE_INDEX
:
1462 face
->overline_color_defaulted_p
= 1;
1463 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1466 case LFACE_STRIKE_THROUGH_INDEX
:
1467 face
->strike_through_color_defaulted_p
= 1;
1468 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1471 case LFACE_BOX_INDEX
:
1472 face
->box_color_defaulted_p
= 1;
1473 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1482 ++ncolors_allocated
;
1489 #ifdef HAVE_WINDOW_SYSTEM
1491 /* Load colors for face FACE which is used on frame F. Colors are
1492 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1493 of ATTRS. If the background color specified is not supported on F,
1494 try to emulate gray colors with a stipple from Vface_default_stipple. */
1497 load_face_colors (f
, face
, attrs
)
1504 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1505 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1507 /* Swap colors if face is inverse-video. */
1508 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1516 /* Check for support for foreground, not for background because
1517 face_color_supported_p is smart enough to know that grays are
1518 "supported" as background because we are supposed to use stipple
1520 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1521 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1523 x_destroy_bitmap (f
, face
->stipple
);
1524 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1525 &face
->pixmap_w
, &face
->pixmap_h
);
1528 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1529 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1533 /* Free color PIXEL on frame F. */
1536 unload_color (f
, pixel
)
1538 unsigned long pixel
;
1540 #ifdef HAVE_X_WINDOWS
1544 x_free_colors (f
, &pixel
, 1);
1551 /* Free colors allocated for FACE. */
1554 free_face_colors (f
, face
)
1558 /* PENDING(NS): need to do something here? */
1559 #ifdef HAVE_X_WINDOWS
1560 if (face
->colors_copied_bitwise_p
)
1565 if (!face
->foreground_defaulted_p
)
1567 x_free_colors (f
, &face
->foreground
, 1);
1568 IF_DEBUG (--ncolors_allocated
);
1571 if (!face
->background_defaulted_p
)
1573 x_free_colors (f
, &face
->background
, 1);
1574 IF_DEBUG (--ncolors_allocated
);
1577 if (face
->underline_p
1578 && !face
->underline_defaulted_p
)
1580 x_free_colors (f
, &face
->underline_color
, 1);
1581 IF_DEBUG (--ncolors_allocated
);
1584 if (face
->overline_p
1585 && !face
->overline_color_defaulted_p
)
1587 x_free_colors (f
, &face
->overline_color
, 1);
1588 IF_DEBUG (--ncolors_allocated
);
1591 if (face
->strike_through_p
1592 && !face
->strike_through_color_defaulted_p
)
1594 x_free_colors (f
, &face
->strike_through_color
, 1);
1595 IF_DEBUG (--ncolors_allocated
);
1598 if (face
->box
!= FACE_NO_BOX
1599 && !face
->box_color_defaulted_p
)
1601 x_free_colors (f
, &face
->box_color
, 1);
1602 IF_DEBUG (--ncolors_allocated
);
1606 #endif /* HAVE_X_WINDOWS */
1609 #endif /* HAVE_WINDOW_SYSTEM */
1613 /***********************************************************************
1615 ***********************************************************************/
1617 /* An enumerator for each field of an XLFD font name. */
1638 /* An enumerator for each possible slant value of a font. Taken from
1639 the XLFD specification. */
1647 XLFD_SLANT_REVERSE_ITALIC
,
1648 XLFD_SLANT_REVERSE_OBLIQUE
,
1652 /* Relative font weight according to XLFD documentation. */
1656 XLFD_WEIGHT_UNKNOWN
,
1657 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1658 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1659 XLFD_WEIGHT_LIGHT
, /* 30 */
1660 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1661 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1662 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1663 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1664 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1665 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1668 /* Relative proportionate width. */
1672 XLFD_SWIDTH_UNKNOWN
,
1673 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1674 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1675 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1676 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1677 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1678 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1679 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1680 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1681 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1684 /* Order by which font selection chooses fonts. The default values
1685 mean `first, find a best match for the font width, then for the
1686 font height, then for weight, then for slant.' This variable can be
1687 set via set-face-font-sort-order. */
1689 static int font_sort_order
[4];
1691 #ifdef HAVE_WINDOW_SYSTEM
1693 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1696 compare_fonts_by_sort_order (v1
, v2
)
1697 const void *v1
, *v2
;
1699 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1700 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1703 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1705 enum font_property_index idx
= font_props_for_sorting
[i
];
1706 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1709 if (idx
<= FONT_REGISTRY_INDEX
)
1712 result
= STRINGP (val2
) ? strcmp (SDATA (val1
), SDATA (val2
)) : -1;
1714 result
= STRINGP (val2
) ? 1 : 0;
1718 if (INTEGERP (val1
))
1719 result
= INTEGERP (val2
) ? XINT (val1
) - XINT (val2
) : -1;
1721 result
= INTEGERP (val2
) ? 1 : 0;
1729 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1730 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1731 If FAMILY is omitted or nil, list all families.
1732 Otherwise, FAMILY must be a string, possibly containing wildcards
1734 If FRAME is omitted or nil, use the selected frame.
1735 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1736 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1737 FAMILY is the font family name. POINT-SIZE is the size of the
1738 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1739 width, weight and slant of the font. These symbols are the same as for
1740 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1741 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1742 giving the registry and encoding of the font.
1743 The result list is sorted according to the current setting of
1744 the face font sort order. */)
1746 Lisp_Object family
, frame
;
1748 Lisp_Object font_spec
, list
, *drivers
, vec
;
1749 int i
, nfonts
, ndrivers
;
1753 frame
= selected_frame
;
1754 CHECK_LIVE_FRAME (frame
);
1756 font_spec
= Ffont_spec (0, NULL
);
1759 CHECK_STRING (family
);
1760 font_parse_family_registry (family
, Qnil
, font_spec
);
1763 list
= font_list_entities (frame
, font_spec
);
1767 /* Sort the font entities. */
1768 for (i
= 0; i
< 4; i
++)
1769 switch (font_sort_order
[i
])
1772 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1773 case XLFD_POINT_SIZE
:
1774 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1776 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1778 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1780 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1781 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1782 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1783 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1785 ndrivers
= XINT (Flength (list
));
1786 drivers
= alloca (sizeof (Lisp_Object
) * ndrivers
);
1787 for (i
= 0; i
< ndrivers
; i
++, list
= XCDR (list
))
1788 drivers
[i
] = XCAR (list
);
1789 vec
= Fvconcat (ndrivers
, drivers
);
1790 nfonts
= ASIZE (vec
);
1792 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1793 compare_fonts_by_sort_order
);
1796 for (i
= nfonts
- 1; i
>= 0; --i
)
1798 Lisp_Object font
= AREF (vec
, i
);
1799 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1801 Lisp_Object spacing
;
1803 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1804 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1805 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1806 XFRAME (frame
)->resy
);
1807 ASET (v
, 2, make_number (point
));
1808 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1809 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1810 spacing
= Ffont_get (font
, QCspacing
);
1811 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1812 ASET (v
, 6, Ffont_xlfd_name (font
, Qnil
));
1813 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1815 result
= Fcons (v
, result
);
1821 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1822 doc
: /* Return a list of the names of available fonts matching PATTERN.
1823 If optional arguments FACE and FRAME are specified, return only fonts
1824 the same size as FACE on FRAME.
1826 PATTERN should be a string containing a font name in the XLFD,
1827 Fontconfig, or GTK format. A font name given in the XLFD format may
1828 contain wildcard characters:
1829 the * character matches any substring, and
1830 the ? character matches any single character.
1831 PATTERN is case-insensitive.
1833 The return value is a list of strings, suitable as arguments to
1836 Fonts Emacs can't use may or may not be excluded
1837 even if they match PATTERN and FACE.
1838 The optional fourth argument MAXIMUM sets a limit on how many
1839 fonts to match. The first MAXIMUM fonts are reported.
1840 The optional fifth argument WIDTH, if specified, is a number of columns
1841 occupied by a character of a font. In that case, return only fonts
1842 the WIDTH times as wide as FACE on FRAME. */)
1843 (pattern
, face
, frame
, maximum
, width
)
1844 Lisp_Object pattern
, face
, frame
, maximum
, width
;
1850 CHECK_STRING (pattern
);
1852 if (! NILP (maximum
))
1853 CHECK_NATNUM (maximum
);
1856 CHECK_NUMBER (width
);
1858 /* We can't simply call check_x_frame because this function may be
1859 called before any frame is created. */
1861 frame
= selected_frame
;
1862 f
= frame_or_selected_frame (frame
, 2);
1863 if (! FRAME_WINDOW_P (f
))
1865 /* Perhaps we have not yet created any frame. */
1871 /* Determine the width standard for comparison with the fonts we find. */
1877 /* This is of limited utility since it works with character
1878 widths. Keep it for compatibility. --gerd. */
1879 int face_id
= lookup_named_face (f
, face
, 0);
1880 struct face
*face
= (face_id
< 0
1882 : FACE_FROM_ID (f
, face_id
));
1884 if (face
&& face
->font
)
1886 size
= face
->font
->pixel_size
;
1887 avgwidth
= face
->font
->average_width
;
1891 size
= FRAME_FONT (f
)->pixel_size
;
1892 avgwidth
= FRAME_FONT (f
)->average_width
;
1895 avgwidth
*= XINT (width
);
1899 Lisp_Object font_spec
;
1900 Lisp_Object args
[2], tail
;
1902 font_spec
= font_spec_from_name (pattern
);
1903 if (!FONTP (font_spec
))
1904 signal_error ("Invalid font name", pattern
);
1908 Ffont_put (font_spec
, QCsize
, make_number (size
));
1909 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
1911 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, font_spec
);
1912 for (tail
= args
[0]; CONSP (tail
); tail
= XCDR (tail
))
1914 Lisp_Object font_entity
;
1916 font_entity
= XCAR (tail
);
1917 if ((NILP (AREF (font_entity
, FONT_SIZE_INDEX
))
1918 || XINT (AREF (font_entity
, FONT_SIZE_INDEX
)) == 0)
1919 && ! NILP (AREF (font_spec
, FONT_SIZE_INDEX
)))
1921 /* This is a scalable font. For backward compatibility,
1922 we set the specified size. */
1923 font_entity
= Fcopy_font_spec (font_entity
);
1924 ASET (font_entity
, FONT_SIZE_INDEX
,
1925 AREF (font_spec
, FONT_SIZE_INDEX
));
1927 XSETCAR (tail
, Ffont_xlfd_name (font_entity
, Qnil
));
1930 /* We don't have to check fontsets. */
1932 args
[1] = list_fontsets (f
, pattern
, size
);
1933 return Fnconc (2, args
);
1937 #endif /* HAVE_WINDOW_SYSTEM */
1940 /***********************************************************************
1942 ***********************************************************************/
1944 /* Access face attributes of face LFACE, a Lisp vector. */
1946 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
1947 #define LFACE_FOUNDRY(LFACE) AREF ((LFACE), LFACE_FOUNDRY_INDEX)
1948 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
1949 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
1950 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
1951 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
1952 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
1953 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
1954 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
1955 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
1956 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
1957 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
1958 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
1959 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
1960 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
1961 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
1962 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
1964 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
1965 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
1967 #define LFACEP(LFACE) \
1969 && XVECTOR_SIZE (LFACE) == LFACE_VECTOR_SIZE \
1970 && EQ (AREF (LFACE, 0), Qface))
1975 /* Check consistency of Lisp face attribute vector ATTRS. */
1978 check_lface_attrs (attrs
)
1981 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
1982 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
1983 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
1984 xassert (UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
1985 || IGNORE_DEFFACE_P (attrs
[LFACE_FOUNDRY_INDEX
])
1986 || STRINGP (attrs
[LFACE_FOUNDRY_INDEX
]));
1987 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
1988 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
1989 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
1990 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
1991 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
1992 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
1993 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
1994 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
1995 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
1996 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
1997 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
1998 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
1999 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
2000 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2001 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2002 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
2003 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2004 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2005 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2006 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
2007 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2008 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2009 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2010 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2011 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2012 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2013 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2014 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
2015 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2016 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2017 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2018 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2019 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2020 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
2021 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2022 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2023 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
2024 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2025 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2026 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
2027 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2028 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2029 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
2030 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2031 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2032 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2033 #ifdef HAVE_WINDOW_SYSTEM
2034 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2035 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
2036 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2037 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2038 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2039 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
2040 || FONTP (attrs
[LFACE_FONT_INDEX
]));
2041 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
2042 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
2047 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2055 xassert (LFACEP (lface
));
2056 check_lface_attrs (XVECTOR (lface
)->contents
);
2060 #else /* GLYPH_DEBUG == 0 */
2062 #define check_lface_attrs(attrs) (void) 0
2063 #define check_lface(lface) (void) 0
2065 #endif /* GLYPH_DEBUG == 0 */
2069 /* Face-merge cycle checking. */
2071 enum named_merge_point_kind
2073 NAMED_MERGE_POINT_NORMAL
,
2074 NAMED_MERGE_POINT_REMAP
2077 /* A `named merge point' is simply a point during face-merging where we
2078 look up a face by name. We keep a stack of which named lookups we're
2079 currently processing so that we can easily detect cycles, using a
2080 linked- list of struct named_merge_point structures, typically
2081 allocated on the stack frame of the named lookup functions which are
2082 active (so no consing is required). */
2083 struct named_merge_point
2085 Lisp_Object face_name
;
2086 enum named_merge_point_kind named_merge_point_kind
;
2087 struct named_merge_point
*prev
;
2091 /* If a face merging cycle is detected for FACE_NAME, return 0,
2092 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
2093 FACE_NAME and NAMED_MERGE_POINT_KIND, as the head of the linked list
2094 pointed to by NAMED_MERGE_POINTS, and return 1. */
2097 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
2098 Lisp_Object face_name
,
2099 enum named_merge_point_kind named_merge_point_kind
,
2100 struct named_merge_point
**named_merge_points
)
2102 struct named_merge_point
*prev
;
2104 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
2105 if (EQ (face_name
, prev
->face_name
))
2107 if (prev
->named_merge_point_kind
== named_merge_point_kind
)
2108 /* A cycle, so fail. */
2110 else if (prev
->named_merge_point_kind
== NAMED_MERGE_POINT_REMAP
)
2111 /* A remap `hides ' any previous normal merge points
2112 (because the remap means that it's actually different face),
2113 so as we know the current merge point must be normal, we
2114 can just assume it's OK. */
2118 new_named_merge_point
->face_name
= face_name
;
2119 new_named_merge_point
->named_merge_point_kind
= named_merge_point_kind
;
2120 new_named_merge_point
->prev
= *named_merge_points
;
2122 *named_merge_points
= new_named_merge_point
;
2129 #if 0 /* Seems to be unused. */
2131 internal_resolve_face_name (nargs
, args
)
2135 return Fget (args
[0], args
[1]);
2139 resolve_face_name_error (ignore
)
2146 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2147 to make it a symbol. If FACE_NAME is an alias for another face,
2148 return that face's name.
2150 Return default face in case of errors. */
2153 resolve_face_name (face_name
, signal_p
)
2154 Lisp_Object face_name
;
2157 Lisp_Object orig_face
;
2158 Lisp_Object tortoise
, hare
;
2160 if (STRINGP (face_name
))
2161 face_name
= intern (SDATA (face_name
));
2163 if (NILP (face_name
) || !SYMBOLP (face_name
))
2166 orig_face
= face_name
;
2167 tortoise
= hare
= face_name
;
2172 hare
= Fget (hare
, Qface_alias
);
2173 if (NILP (hare
) || !SYMBOLP (hare
))
2177 hare
= Fget (hare
, Qface_alias
);
2178 if (NILP (hare
) || !SYMBOLP (hare
))
2181 tortoise
= Fget (tortoise
, Qface_alias
);
2182 if (EQ (hare
, tortoise
))
2185 xsignal1 (Qcircular_list
, orig_face
);
2194 /* Return the face definition of FACE_NAME on frame F. F null means
2195 return the definition for new frames. FACE_NAME may be a string or
2196 a symbol (apparently Emacs 20.2 allowed strings as face names in
2197 face text properties; Ediff uses that). If SIGNAL_P is non-zero,
2198 signal an error if FACE_NAME is not a valid face name. If SIGNAL_P
2199 is zero, value is nil if FACE_NAME is not a valid face name. */
2200 static INLINE Lisp_Object
2201 lface_from_face_name_no_resolve (f
, face_name
, signal_p
)
2203 Lisp_Object face_name
;
2209 lface
= assq_no_quit (face_name
, f
->face_alist
);
2211 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2214 lface
= XCDR (lface
);
2216 signal_error ("Invalid face", face_name
);
2218 check_lface (lface
);
2223 /* Return the face definition of FACE_NAME on frame F. F null means
2224 return the definition for new frames. FACE_NAME may be a string or
2225 a symbol (apparently Emacs 20.2 allowed strings as face names in
2226 face text properties; Ediff uses that). If FACE_NAME is an alias
2227 for another face, return that face's definition. If SIGNAL_P is
2228 non-zero, signal an error if FACE_NAME is not a valid face name.
2229 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2231 static INLINE Lisp_Object
2232 lface_from_face_name (f
, face_name
, signal_p
)
2234 Lisp_Object face_name
;
2237 face_name
= resolve_face_name (face_name
, signal_p
);
2238 return lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2242 /* Get face attributes of face FACE_NAME from frame-local faces on
2243 frame F. Store the resulting attributes in ATTRS which must point
2244 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2245 is non-zero, signal an error if FACE_NAME does not name a face.
2246 Otherwise, value is zero if FACE_NAME is not a face. */
2249 get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
)
2251 Lisp_Object face_name
;
2257 lface
= lface_from_face_name_no_resolve (f
, face_name
, signal_p
);
2260 bcopy (XVECTOR (lface
)->contents
, attrs
,
2261 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2263 return !NILP (lface
);
2266 /* Get face attributes of face FACE_NAME from frame-local faces on frame
2267 F. Store the resulting attributes in ATTRS which must point to a
2268 vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If FACE_NAME is an
2269 alias for another face, use that face's definition. If SIGNAL_P is
2270 non-zero, signal an error if FACE_NAME does not name a face.
2271 Otherwise, value is zero if FACE_NAME is not a face. */
2274 get_lface_attributes (f
, face_name
, attrs
, signal_p
, named_merge_points
)
2276 Lisp_Object face_name
;
2279 struct named_merge_point
*named_merge_points
;
2281 Lisp_Object face_remapping
;
2283 face_name
= resolve_face_name (face_name
, signal_p
);
2285 /* See if SYMBOL has been remapped to some other face (usually this
2286 is done buffer-locally). */
2287 face_remapping
= assq_no_quit (face_name
, Vface_remapping_alist
);
2288 if (CONSP (face_remapping
))
2290 struct named_merge_point named_merge_point
;
2292 if (push_named_merge_point (&named_merge_point
,
2293 face_name
, NAMED_MERGE_POINT_REMAP
,
2294 &named_merge_points
))
2298 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2299 attrs
[i
] = Qunspecified
;
2301 return merge_face_ref (f
, XCDR (face_remapping
), attrs
,
2302 signal_p
, named_merge_points
);
2306 /* Default case, no remapping. */
2307 return get_lface_attributes_no_remap (f
, face_name
, attrs
, signal_p
);
2311 /* Non-zero if all attributes in face attribute vector ATTRS are
2312 specified, i.e. are non-nil. */
2315 lface_fully_specified_p (attrs
)
2320 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2321 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2322 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
])))
2325 return i
== LFACE_VECTOR_SIZE
;
2328 #ifdef HAVE_WINDOW_SYSTEM
2330 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2331 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2332 exception is `font' attribute. It is set to FONT_OBJECT regardless
2336 set_lface_from_font (f
, lface
, font_object
, force_p
)
2338 Lisp_Object lface
, font_object
;
2342 struct font
*font
= XFONT_OBJECT (font_object
);
2344 /* Set attributes only if unspecified, otherwise face defaults for
2345 new frames would never take effect. If the font doesn't have a
2346 specific property, set a normal value for that. */
2348 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2350 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2352 LFACE_FAMILY (lface
) = SYMBOL_NAME (family
);
2355 if (force_p
|| UNSPECIFIEDP (LFACE_FOUNDRY (lface
)))
2357 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2359 LFACE_FOUNDRY (lface
) = SYMBOL_NAME (foundry
);
2362 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2364 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2367 LFACE_HEIGHT (lface
) = make_number (pt
);
2370 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2372 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2373 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2375 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2377 val
= FONT_SLANT_FOR_FACE (font_object
);
2378 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2380 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2382 val
= FONT_WIDTH_FOR_FACE (font_object
);
2383 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2386 LFACE_FONT (lface
) = font_object
;
2390 #endif /* HAVE_WINDOW_SYSTEM */
2393 /* Merges the face height FROM with the face height TO, and returns the
2394 merged height. If FROM is an invalid height, then INVALID is
2395 returned instead. FROM and TO may be either absolute face heights or
2396 `relative' heights; the returned value is always an absolute height
2397 unless both FROM and TO are relative. */
2400 merge_face_heights (from
, to
, invalid
)
2401 Lisp_Object from
, to
, invalid
;
2403 Lisp_Object result
= invalid
;
2405 if (INTEGERP (from
))
2406 /* FROM is absolute, just use it as is. */
2408 else if (FLOATP (from
))
2409 /* FROM is a scale, use it to adjust TO. */
2412 /* relative X absolute => absolute */
2413 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
2414 else if (FLOATP (to
))
2415 /* relative X relative => relative */
2416 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2417 else if (UNSPECIFIEDP (to
))
2420 else if (FUNCTIONP (from
))
2421 /* FROM is a function, which use to adjust TO. */
2423 /* Call function with current height as argument.
2424 From is the new height. */
2425 Lisp_Object args
[2];
2429 result
= safe_call (2, args
);
2431 /* Ensure that if TO was absolute, so is the result. */
2432 if (INTEGERP (to
) && !INTEGERP (result
))
2440 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2441 store the resulting attributes in TO, which must be already be
2442 completely specified and contain only absolute attributes. Every
2443 specified attribute of FROM overrides the corresponding attribute of
2444 TO; relative attributes in FROM are merged with the absolute value in
2445 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2446 loops in face inheritance/remapping; it should be 0 when called from
2450 merge_face_vectors (f
, from
, to
, named_merge_points
)
2452 Lisp_Object
*from
, *to
;
2453 struct named_merge_point
*named_merge_points
;
2457 /* If FROM inherits from some other faces, merge their attributes into
2458 TO before merging FROM's direct attributes. Note that an :inherit
2459 attribute of `unspecified' is the same as one of nil; we never
2460 merge :inherit attributes, so nil is more correct, but lots of
2461 other code uses `unspecified' as a generic value for face attributes. */
2462 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2463 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2464 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2466 i
= LFACE_FONT_INDEX
;
2467 if (!UNSPECIFIEDP (from
[i
]))
2469 if (!UNSPECIFIEDP (to
[i
]))
2470 to
[i
] = Fmerge_font_spec (from
[i
], to
[i
]);
2472 to
[i
] = Fcopy_font_spec (from
[i
]);
2473 if (! NILP (AREF (to
[i
], FONT_FOUNDRY_INDEX
)))
2474 to
[LFACE_FOUNDRY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FOUNDRY_INDEX
));
2475 if (! NILP (AREF (to
[i
], FONT_FAMILY_INDEX
)))
2476 to
[LFACE_FAMILY_INDEX
] = SYMBOL_NAME (AREF (to
[i
], FONT_FAMILY_INDEX
));
2477 if (! NILP (AREF (to
[i
], FONT_WEIGHT_INDEX
)))
2478 to
[LFACE_WEIGHT_INDEX
] = FONT_WEIGHT_FOR_FACE (to
[i
]);
2479 if (! NILP (AREF (to
[i
], FONT_SLANT_INDEX
)))
2480 to
[LFACE_SLANT_INDEX
] = FONT_SLANT_FOR_FACE (to
[i
]);
2481 if (! NILP (AREF (to
[i
], FONT_WIDTH_INDEX
)))
2482 to
[LFACE_SWIDTH_INDEX
] = FONT_WIDTH_FOR_FACE (to
[i
]);
2483 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2486 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2487 if (!UNSPECIFIEDP (from
[i
]))
2489 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2491 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2492 font_clear_prop (to
, FONT_SIZE_INDEX
);
2494 else if (i
!= LFACE_FONT_INDEX
2495 && ! EQ (to
[i
], from
[i
]))
2498 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2499 font_clear_prop (to
,
2500 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2501 : i
== LFACE_FOUNDRY_INDEX
? FONT_FOUNDRY_INDEX
2502 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2503 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2504 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2505 : FONT_SLANT_INDEX
));
2509 /* TO is always an absolute face, which should inherit from nothing.
2510 We blindly copy the :inherit attribute above and fix it up here. */
2511 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2514 /* Merge the named face FACE_NAME on frame F, into the vector of face
2515 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2516 inheritance. Returns true if FACE_NAME is a valid face name and
2517 merging succeeded. */
2520 merge_named_face (f
, face_name
, to
, named_merge_points
)
2522 Lisp_Object face_name
;
2524 struct named_merge_point
*named_merge_points
;
2526 struct named_merge_point named_merge_point
;
2528 if (push_named_merge_point (&named_merge_point
,
2529 face_name
, NAMED_MERGE_POINT_NORMAL
,
2530 &named_merge_points
))
2532 struct gcpro gcpro1
;
2533 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2534 int ok
= get_lface_attributes (f
, face_name
, from
, 0, named_merge_points
);
2538 GCPRO1 (named_merge_point
.face_name
);
2539 merge_face_vectors (f
, from
, to
, named_merge_points
);
2550 /* Merge face attributes from the lisp `face reference' FACE_REF on
2551 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2552 problems with FACE_REF cause an error message to be shown. Return
2553 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2554 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2555 list structure; it may be 0 for most callers.
2557 FACE_REF may be a single face specification or a list of such
2558 specifications. Each face specification can be:
2560 1. A symbol or string naming a Lisp face.
2562 2. A property list of the form (KEYWORD VALUE ...) where each
2563 KEYWORD is a face attribute name, and value is an appropriate value
2566 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2567 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2568 for compatibility with 20.2.
2570 Face specifications earlier in lists take precedence over later
2574 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
2576 Lisp_Object face_ref
;
2579 struct named_merge_point
*named_merge_points
;
2581 int ok
= 1; /* Succeed without an error? */
2583 if (CONSP (face_ref
))
2585 Lisp_Object first
= XCAR (face_ref
);
2587 if (EQ (first
, Qforeground_color
)
2588 || EQ (first
, Qbackground_color
))
2590 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2591 . COLOR). COLOR must be a string. */
2592 Lisp_Object color_name
= XCDR (face_ref
);
2593 Lisp_Object color
= first
;
2595 if (STRINGP (color_name
))
2597 if (EQ (color
, Qforeground_color
))
2598 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2600 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2605 add_to_log ("Invalid face color", color_name
, Qnil
);
2609 else if (SYMBOLP (first
)
2610 && *SDATA (SYMBOL_NAME (first
)) == ':')
2612 /* Assume this is the property list form. */
2613 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2615 Lisp_Object keyword
= XCAR (face_ref
);
2616 Lisp_Object value
= XCAR (XCDR (face_ref
));
2619 /* Specifying `unspecified' is a no-op. */
2620 if (EQ (value
, Qunspecified
))
2622 else if (EQ (keyword
, QCfamily
))
2624 if (STRINGP (value
))
2626 to
[LFACE_FAMILY_INDEX
] = value
;
2627 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2632 else if (EQ (keyword
, QCfoundry
))
2634 if (STRINGP (value
))
2636 to
[LFACE_FOUNDRY_INDEX
] = value
;
2637 font_clear_prop (to
, FONT_FOUNDRY_INDEX
);
2642 else if (EQ (keyword
, QCheight
))
2644 Lisp_Object new_height
=
2645 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2647 if (! NILP (new_height
))
2649 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2650 font_clear_prop (to
, FONT_SIZE_INDEX
);
2655 else if (EQ (keyword
, QCweight
))
2657 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2659 to
[LFACE_WEIGHT_INDEX
] = value
;
2660 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2665 else if (EQ (keyword
, QCslant
))
2667 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2669 to
[LFACE_SLANT_INDEX
] = value
;
2670 font_clear_prop (to
, FONT_SLANT_INDEX
);
2675 else if (EQ (keyword
, QCunderline
))
2680 to
[LFACE_UNDERLINE_INDEX
] = value
;
2684 else if (EQ (keyword
, QCoverline
))
2689 to
[LFACE_OVERLINE_INDEX
] = value
;
2693 else if (EQ (keyword
, QCstrike_through
))
2698 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2702 else if (EQ (keyword
, QCbox
))
2705 value
= make_number (1);
2706 if (INTEGERP (value
)
2710 to
[LFACE_BOX_INDEX
] = value
;
2714 else if (EQ (keyword
, QCinverse_video
)
2715 || EQ (keyword
, QCreverse_video
))
2717 if (EQ (value
, Qt
) || NILP (value
))
2718 to
[LFACE_INVERSE_INDEX
] = value
;
2722 else if (EQ (keyword
, QCforeground
))
2724 if (STRINGP (value
))
2725 to
[LFACE_FOREGROUND_INDEX
] = value
;
2729 else if (EQ (keyword
, QCbackground
))
2731 if (STRINGP (value
))
2732 to
[LFACE_BACKGROUND_INDEX
] = value
;
2736 else if (EQ (keyword
, QCstipple
))
2738 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
2739 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2740 if (!NILP (pixmap_p
))
2741 to
[LFACE_STIPPLE_INDEX
] = value
;
2746 else if (EQ (keyword
, QCwidth
))
2748 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2750 to
[LFACE_SWIDTH_INDEX
] = value
;
2751 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2756 else if (EQ (keyword
, QCinherit
))
2758 /* This is not really very useful; it's just like a
2759 normal face reference. */
2760 if (! merge_face_ref (f
, value
, to
,
2761 err_msgs
, named_merge_points
))
2769 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2773 face_ref
= XCDR (XCDR (face_ref
));
2778 /* This is a list of face refs. Those at the beginning of the
2779 list take precedence over what follows, so we have to merge
2780 from the end backwards. */
2781 Lisp_Object next
= XCDR (face_ref
);
2784 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2786 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2792 /* FACE_REF ought to be a face name. */
2793 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2794 if (!ok
&& err_msgs
)
2795 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2802 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2803 Sinternal_make_lisp_face
, 1, 2, 0,
2804 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2805 If FACE was not known as a face before, create a new one.
2806 If optional argument FRAME is specified, make a frame-local face
2807 for that frame. Otherwise operate on the global face definition.
2808 Value is a vector of face attributes. */)
2810 Lisp_Object face
, frame
;
2812 Lisp_Object global_lface
, lface
;
2816 CHECK_SYMBOL (face
);
2817 global_lface
= lface_from_face_name (NULL
, face
, 0);
2821 CHECK_LIVE_FRAME (frame
);
2823 lface
= lface_from_face_name (f
, face
, 0);
2826 f
= NULL
, lface
= Qnil
;
2828 /* Add a global definition if there is none. */
2829 if (NILP (global_lface
))
2831 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2833 ASET (global_lface
, 0, Qface
);
2834 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2835 Vface_new_frame_defaults
);
2837 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2838 face id to Lisp face is given by the vector lface_id_to_name.
2839 The mapping from Lisp face to Lisp face id is given by the
2840 property `face' of the Lisp face name. */
2841 if (next_lface_id
== lface_id_to_name_size
)
2843 int new_size
= max (50, 2 * lface_id_to_name_size
);
2844 int sz
= new_size
* sizeof *lface_id_to_name
;
2845 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
2846 lface_id_to_name_size
= new_size
;
2849 lface_id_to_name
[next_lface_id
] = face
;
2850 Fput (face
, Qface
, make_number (next_lface_id
));
2854 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2855 ASET (global_lface
, i
, Qunspecified
);
2857 /* Add a frame-local definition. */
2862 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2864 ASET (lface
, 0, Qface
);
2865 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2868 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2869 ASET (lface
, i
, Qunspecified
);
2872 lface
= global_lface
;
2874 /* Changing a named face means that all realized faces depending on
2875 that face are invalid. Since we cannot tell which realized faces
2876 depend on the face, make sure they are all removed. This is done
2877 by incrementing face_change_count. The next call to
2878 init_iterator will then free realized faces. */
2879 if (NILP (Fget (face
, Qface_no_inherit
)))
2881 ++face_change_count
;
2882 ++windows_or_buffers_changed
;
2885 xassert (LFACEP (lface
));
2886 check_lface (lface
);
2891 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2892 Sinternal_lisp_face_p
, 1, 2, 0,
2893 doc
: /* Return non-nil if FACE names a face.
2894 FACE should be a symbol or string.
2895 If optional second argument FRAME is non-nil, check for the
2896 existence of a frame-local face with name FACE on that frame.
2897 Otherwise check for the existence of a global face. */)
2899 Lisp_Object face
, frame
;
2903 face
= resolve_face_name (face
, 1);
2907 CHECK_LIVE_FRAME (frame
);
2908 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2911 lface
= lface_from_face_name (NULL
, face
, 0);
2917 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2918 Sinternal_copy_lisp_face
, 4, 4, 0,
2919 doc
: /* Copy face FROM to TO.
2920 If FRAME is t, copy the global face definition of FROM.
2921 Otherwise, copy the frame-local definition of FROM on FRAME.
2922 If NEW-FRAME is a frame, copy that data into the frame-local
2923 definition of TO on NEW-FRAME. If NEW-FRAME is nil,
2924 FRAME controls where the data is copied to.
2926 The value is TO. */)
2927 (from
, to
, frame
, new_frame
)
2928 Lisp_Object from
, to
, frame
, new_frame
;
2930 Lisp_Object lface
, copy
;
2932 CHECK_SYMBOL (from
);
2937 /* Copy global definition of FROM. We don't make copies of
2938 strings etc. because 20.2 didn't do it either. */
2939 lface
= lface_from_face_name (NULL
, from
, 1);
2940 copy
= Finternal_make_lisp_face (to
, Qnil
);
2944 /* Copy frame-local definition of FROM. */
2945 if (NILP (new_frame
))
2947 CHECK_LIVE_FRAME (frame
);
2948 CHECK_LIVE_FRAME (new_frame
);
2949 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2950 copy
= Finternal_make_lisp_face (to
, new_frame
);
2953 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
2954 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2956 /* Changing a named face means that all realized faces depending on
2957 that face are invalid. Since we cannot tell which realized faces
2958 depend on the face, make sure they are all removed. This is done
2959 by incrementing face_change_count. The next call to
2960 init_iterator will then free realized faces. */
2961 if (NILP (Fget (to
, Qface_no_inherit
)))
2963 ++face_change_count
;
2964 ++windows_or_buffers_changed
;
2971 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
2972 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
2973 doc
: /* Set attribute ATTR of FACE to VALUE.
2974 FRAME being a frame means change the face on that frame.
2975 FRAME nil means change the face of the selected frame.
2976 FRAME t means change the default for new frames.
2977 FRAME 0 means change the face on all frames, and change the default
2979 (face
, attr
, value
, frame
)
2980 Lisp_Object face
, attr
, value
, frame
;
2983 Lisp_Object old_value
= Qnil
;
2984 /* Set one of enum font_property_index (> 0) if ATTR is one of
2985 font-related attributes other than QCfont and QCfontset. */
2986 enum font_property_index prop_index
= 0;
2988 CHECK_SYMBOL (face
);
2989 CHECK_SYMBOL (attr
);
2991 face
= resolve_face_name (face
, 1);
2993 /* If FRAME is 0, change face on all frames, and change the
2994 default for new frames. */
2995 if (INTEGERP (frame
) && XINT (frame
) == 0)
2998 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
2999 FOR_EACH_FRAME (tail
, frame
)
3000 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3004 /* Set lface to the Lisp attribute vector of FACE. */
3007 lface
= lface_from_face_name (NULL
, face
, 1);
3009 /* When updating face-new-frame-defaults, we put :ignore-defface
3010 where the caller wants `unspecified'. This forces the frame
3011 defaults to ignore the defface value. Otherwise, the defface
3012 will take effect, which is generally not what is intended.
3013 The value of that attribute will be inherited from some other
3014 face during face merging. See internal_merge_in_global_face. */
3015 if (UNSPECIFIEDP (value
))
3016 value
= Qignore_defface
;
3021 frame
= selected_frame
;
3023 CHECK_LIVE_FRAME (frame
);
3024 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3026 /* If a frame-local face doesn't exist yet, create one. */
3028 lface
= Finternal_make_lisp_face (face
, frame
);
3031 if (EQ (attr
, QCfamily
))
3033 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3035 CHECK_STRING (value
);
3036 if (SCHARS (value
) == 0)
3037 signal_error ("Invalid face family", value
);
3039 old_value
= LFACE_FAMILY (lface
);
3040 LFACE_FAMILY (lface
) = value
;
3041 prop_index
= FONT_FAMILY_INDEX
;
3043 else if (EQ (attr
, QCfoundry
))
3045 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3047 CHECK_STRING (value
);
3048 if (SCHARS (value
) == 0)
3049 signal_error ("Invalid face foundry", value
);
3051 old_value
= LFACE_FOUNDRY (lface
);
3052 LFACE_FOUNDRY (lface
) = value
;
3053 prop_index
= FONT_FOUNDRY_INDEX
;
3055 else if (EQ (attr
, QCheight
))
3057 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3059 if (EQ (face
, Qdefault
))
3061 /* The default face must have an absolute size. */
3062 if (!INTEGERP (value
) || XINT (value
) <= 0)
3063 signal_error ("Default face height not absolute and positive", value
);
3067 /* For non-default faces, do a test merge with a random
3068 height to see if VALUE's ok. */
3069 Lisp_Object test
= merge_face_heights (value
,
3072 if (!INTEGERP (test
) || XINT (test
) <= 0)
3073 signal_error ("Face height does not produce a positive integer", value
);
3077 old_value
= LFACE_HEIGHT (lface
);
3078 LFACE_HEIGHT (lface
) = value
;
3079 prop_index
= FONT_SIZE_INDEX
;
3081 else if (EQ (attr
, QCweight
))
3083 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3085 CHECK_SYMBOL (value
);
3086 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
3087 signal_error ("Invalid face weight", value
);
3089 old_value
= LFACE_WEIGHT (lface
);
3090 LFACE_WEIGHT (lface
) = value
;
3091 prop_index
= FONT_WEIGHT_INDEX
;
3093 else if (EQ (attr
, QCslant
))
3095 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3097 CHECK_SYMBOL (value
);
3098 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
3099 signal_error ("Invalid face slant", value
);
3101 old_value
= LFACE_SLANT (lface
);
3102 LFACE_SLANT (lface
) = value
;
3103 prop_index
= FONT_SLANT_INDEX
;
3105 else if (EQ (attr
, QCunderline
))
3107 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3108 if ((SYMBOLP (value
)
3110 && !EQ (value
, Qnil
))
3111 /* Underline color. */
3113 && SCHARS (value
) == 0))
3114 signal_error ("Invalid face underline", value
);
3116 old_value
= LFACE_UNDERLINE (lface
);
3117 LFACE_UNDERLINE (lface
) = value
;
3119 else if (EQ (attr
, QCoverline
))
3121 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3122 if ((SYMBOLP (value
)
3124 && !EQ (value
, Qnil
))
3125 /* Overline color. */
3127 && SCHARS (value
) == 0))
3128 signal_error ("Invalid face overline", value
);
3130 old_value
= LFACE_OVERLINE (lface
);
3131 LFACE_OVERLINE (lface
) = value
;
3133 else if (EQ (attr
, QCstrike_through
))
3135 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3136 if ((SYMBOLP (value
)
3138 && !EQ (value
, Qnil
))
3139 /* Strike-through color. */
3141 && SCHARS (value
) == 0))
3142 signal_error ("Invalid face strike-through", value
);
3144 old_value
= LFACE_STRIKE_THROUGH (lface
);
3145 LFACE_STRIKE_THROUGH (lface
) = value
;
3147 else if (EQ (attr
, QCbox
))
3151 /* Allow t meaning a simple box of width 1 in foreground color
3154 value
= make_number (1);
3156 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3158 else if (NILP (value
))
3160 else if (INTEGERP (value
))
3161 valid_p
= XINT (value
) != 0;
3162 else if (STRINGP (value
))
3163 valid_p
= SCHARS (value
) > 0;
3164 else if (CONSP (value
))
3180 if (EQ (k
, QCline_width
))
3182 if (!INTEGERP (v
) || XINT (v
) == 0)
3185 else if (EQ (k
, QCcolor
))
3187 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3190 else if (EQ (k
, QCstyle
))
3192 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3199 valid_p
= NILP (tem
);
3205 signal_error ("Invalid face box", value
);
3207 old_value
= LFACE_BOX (lface
);
3208 LFACE_BOX (lface
) = value
;
3210 else if (EQ (attr
, QCinverse_video
)
3211 || EQ (attr
, QCreverse_video
))
3213 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3215 CHECK_SYMBOL (value
);
3216 if (!EQ (value
, Qt
) && !NILP (value
))
3217 signal_error ("Invalid inverse-video face attribute value", value
);
3219 old_value
= LFACE_INVERSE (lface
);
3220 LFACE_INVERSE (lface
) = value
;
3222 else if (EQ (attr
, QCforeground
))
3224 /* Compatibility with 20.x. */
3226 value
= Qunspecified
;
3227 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3229 /* Don't check for valid color names here because it depends
3230 on the frame (display) whether the color will be valid
3231 when the face is realized. */
3232 CHECK_STRING (value
);
3233 if (SCHARS (value
) == 0)
3234 signal_error ("Empty foreground color value", value
);
3236 old_value
= LFACE_FOREGROUND (lface
);
3237 LFACE_FOREGROUND (lface
) = value
;
3239 else if (EQ (attr
, QCbackground
))
3241 /* Compatibility with 20.x. */
3243 value
= Qunspecified
;
3244 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3246 /* Don't check for valid color names here because it depends
3247 on the frame (display) whether the color will be valid
3248 when the face is realized. */
3249 CHECK_STRING (value
);
3250 if (SCHARS (value
) == 0)
3251 signal_error ("Empty background color value", value
);
3253 old_value
= LFACE_BACKGROUND (lface
);
3254 LFACE_BACKGROUND (lface
) = value
;
3256 else if (EQ (attr
, QCstipple
))
3258 #if defined(HAVE_X_WINDOWS) || defined(HAVE_NS)
3259 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3261 && NILP (Fbitmap_spec_p (value
)))
3262 signal_error ("Invalid stipple attribute", value
);
3263 old_value
= LFACE_STIPPLE (lface
);
3264 LFACE_STIPPLE (lface
) = value
;
3265 #endif /* HAVE_X_WINDOWS || HAVE_NS */
3267 else if (EQ (attr
, QCwidth
))
3269 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3271 CHECK_SYMBOL (value
);
3272 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3273 signal_error ("Invalid face width", value
);
3275 old_value
= LFACE_SWIDTH (lface
);
3276 LFACE_SWIDTH (lface
) = value
;
3277 prop_index
= FONT_WIDTH_INDEX
;
3279 else if (EQ (attr
, QCfont
))
3281 #ifdef HAVE_WINDOW_SYSTEM
3282 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3284 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3288 old_value
= LFACE_FONT (lface
);
3289 if (! FONTP (value
))
3291 if (STRINGP (value
))
3293 Lisp_Object name
= value
;
3294 int fontset
= fs_query_fontset (name
, 0);
3297 name
= fontset_ascii (fontset
);
3298 value
= font_spec_from_name (name
);
3300 signal_error ("Invalid font name", name
);
3303 signal_error ("Invalid font or font-spec", value
);
3306 f
= XFRAME (selected_frame
);
3309 if (! FONT_OBJECT_P (value
))
3311 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3312 Lisp_Object font_object
;
3314 font_object
= font_load_for_lface (f
, attrs
, value
);
3315 if (NILP (font_object
))
3316 signal_error ("Font not available", value
);
3317 value
= font_object
;
3319 set_lface_from_font (f
, lface
, value
, 1);
3322 LFACE_FONT (lface
) = value
;
3324 #endif /* HAVE_WINDOW_SYSTEM */
3326 else if (EQ (attr
, QCfontset
))
3328 #ifdef HAVE_WINDOW_SYSTEM
3329 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3333 old_value
= LFACE_FONTSET (lface
);
3334 tmp
= Fquery_fontset (value
, Qnil
);
3336 signal_error ("Invalid fontset name", value
);
3337 LFACE_FONTSET (lface
) = value
= tmp
;
3339 #endif /* HAVE_WINDOW_SYSTEM */
3341 else if (EQ (attr
, QCinherit
))
3344 if (SYMBOLP (value
))
3347 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3348 if (!SYMBOLP (XCAR (tail
)))
3351 LFACE_INHERIT (lface
) = value
;
3353 signal_error ("Invalid face inheritance", value
);
3355 else if (EQ (attr
, QCbold
))
3357 old_value
= LFACE_WEIGHT (lface
);
3358 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3359 prop_index
= FONT_WEIGHT_INDEX
;
3361 else if (EQ (attr
, QCitalic
))
3364 old_value
= LFACE_SLANT (lface
);
3365 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3366 prop_index
= FONT_SLANT_INDEX
;
3369 signal_error ("Invalid face attribute name", attr
);
3373 /* If a font-related attribute other than QCfont and QCfontset
3374 is specified, and if the original QCfont attribute has a font
3375 (font-spec or font-object), set the corresponding property in
3376 the font to nil so that the font selector doesn't think that
3377 the attribute is mandatory. Also, clear the average
3379 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3382 /* Changing a named face means that all realized faces depending on
3383 that face are invalid. Since we cannot tell which realized faces
3384 depend on the face, make sure they are all removed. This is done
3385 by incrementing face_change_count. The next call to
3386 init_iterator will then free realized faces. */
3388 && NILP (Fget (face
, Qface_no_inherit
))
3389 && NILP (Fequal (old_value
, value
)))
3391 ++face_change_count
;
3392 ++windows_or_buffers_changed
;
3395 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3396 && NILP (Fequal (old_value
, value
)))
3402 if (EQ (face
, Qdefault
))
3404 #ifdef HAVE_WINDOW_SYSTEM
3405 /* Changed font-related attributes of the `default' face are
3406 reflected in changed `font' frame parameters. */
3408 && (prop_index
|| EQ (attr
, QCfont
))
3409 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3410 set_font_frame_param (frame
, lface
);
3412 #endif /* HAVE_WINDOW_SYSTEM */
3414 if (EQ (attr
, QCforeground
))
3415 param
= Qforeground_color
;
3416 else if (EQ (attr
, QCbackground
))
3417 param
= Qbackground_color
;
3419 #ifdef HAVE_WINDOW_SYSTEM
3421 else if (EQ (face
, Qscroll_bar
))
3423 /* Changing the colors of `scroll-bar' sets frame parameters
3424 `scroll-bar-foreground' and `scroll-bar-background'. */
3425 if (EQ (attr
, QCforeground
))
3426 param
= Qscroll_bar_foreground
;
3427 else if (EQ (attr
, QCbackground
))
3428 param
= Qscroll_bar_background
;
3430 #endif /* not WINDOWSNT */
3431 else if (EQ (face
, Qborder
))
3433 /* Changing background color of `border' sets frame parameter
3435 if (EQ (attr
, QCbackground
))
3436 param
= Qborder_color
;
3438 else if (EQ (face
, Qcursor
))
3440 /* Changing background color of `cursor' sets frame parameter
3442 if (EQ (attr
, QCbackground
))
3443 param
= Qcursor_color
;
3445 else if (EQ (face
, Qmouse
))
3447 /* Changing background color of `mouse' sets frame parameter
3449 if (EQ (attr
, QCbackground
))
3450 param
= Qmouse_color
;
3452 #endif /* HAVE_WINDOW_SYSTEM */
3453 else if (EQ (face
, Qmenu
))
3455 /* Indicate that we have to update the menu bar when
3456 realizing faces on FRAME. FRAME t change the
3457 default for new frames. We do this by setting
3458 setting the flag in new face caches */
3461 struct frame
*f
= XFRAME (frame
);
3462 if (FRAME_FACE_CACHE (f
) == NULL
)
3463 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3464 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3467 menu_face_changed_default
= 1;
3473 /* Update `default-frame-alist', which is used for new frames. */
3475 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3478 /* Update the current frame's parameters. */
3481 cons
= XCAR (Vparam_value_alist
);
3482 XSETCAR (cons
, param
);
3483 XSETCDR (cons
, value
);
3484 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3493 /* Update the corresponding face when frame parameter PARAM on frame F
3494 has been assigned the value NEW_VALUE. */
3497 update_face_from_frame_parameter (f
, param
, new_value
)
3499 Lisp_Object param
, new_value
;
3501 Lisp_Object face
= Qnil
;
3504 /* If there are no faces yet, give up. This is the case when called
3505 from Fx_create_frame, and we do the necessary things later in
3506 face-set-after-frame-defaults. */
3507 if (NILP (f
->face_alist
))
3510 if (EQ (param
, Qforeground_color
))
3513 lface
= lface_from_face_name (f
, face
, 1);
3514 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3515 ? new_value
: Qunspecified
);
3516 realize_basic_faces (f
);
3518 else if (EQ (param
, Qbackground_color
))
3522 /* Changing the background color might change the background
3523 mode, so that we have to load new defface specs.
3524 Call frame-update-face-colors to do that. */
3525 XSETFRAME (frame
, f
);
3526 call1 (Qframe_set_background_mode
, frame
);
3529 lface
= lface_from_face_name (f
, face
, 1);
3530 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3531 ? new_value
: Qunspecified
);
3532 realize_basic_faces (f
);
3534 #ifdef HAVE_WINDOW_SYSTEM
3535 else if (EQ (param
, Qborder_color
))
3538 lface
= lface_from_face_name (f
, face
, 1);
3539 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3540 ? new_value
: Qunspecified
);
3542 else if (EQ (param
, Qcursor_color
))
3545 lface
= lface_from_face_name (f
, face
, 1);
3546 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3547 ? new_value
: Qunspecified
);
3549 else if (EQ (param
, Qmouse_color
))
3552 lface
= lface_from_face_name (f
, face
, 1);
3553 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3554 ? new_value
: Qunspecified
);
3558 /* Changing a named face means that all realized faces depending on
3559 that face are invalid. Since we cannot tell which realized faces
3560 depend on the face, make sure they are all removed. This is done
3561 by incrementing face_change_count. The next call to
3562 init_iterator will then free realized faces. */
3564 && NILP (Fget (face
, Qface_no_inherit
)))
3566 ++face_change_count
;
3567 ++windows_or_buffers_changed
;
3572 #ifdef HAVE_WINDOW_SYSTEM
3574 /* Set the `font' frame parameter of FRAME determined from the
3575 font-object set in `default' face attributes LFACE. */
3578 set_font_frame_param (frame
, lface
)
3579 Lisp_Object frame
, lface
;
3581 struct frame
*f
= XFRAME (frame
);
3584 if (FRAME_WINDOW_P (f
)
3585 /* Don't do anything if the font is `unspecified'. This can
3586 happen during frame creation. */
3587 && (font
= LFACE_FONT (lface
),
3588 ! UNSPECIFIEDP (font
)))
3590 if (FONT_SPEC_P (font
))
3592 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3595 LFACE_FONT (lface
) = font
;
3597 f
->default_face_done_p
= 0;
3598 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3603 /* Get the value of X resource RESOURCE, class CLASS for the display
3604 of frame FRAME. This is here because ordinary `x-get-resource'
3605 doesn't take a frame argument. */
3607 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3608 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3609 (resource
, class, frame
)
3610 Lisp_Object resource
, class, frame
;
3612 Lisp_Object value
= Qnil
;
3613 CHECK_STRING (resource
);
3614 CHECK_STRING (class);
3615 CHECK_LIVE_FRAME (frame
);
3617 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3618 resource
, class, Qnil
, Qnil
);
3624 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3625 If VALUE is "on" or "true", return t. If VALUE is "off" or
3626 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3627 error; if SIGNAL_P is zero, return 0. */
3630 face_boolean_x_resource_value (value
, signal_p
)
3634 Lisp_Object result
= make_number (0);
3636 xassert (STRINGP (value
));
3638 if (xstrcasecmp (SDATA (value
), "on") == 0
3639 || xstrcasecmp (SDATA (value
), "true") == 0)
3641 else if (xstrcasecmp (SDATA (value
), "off") == 0
3642 || xstrcasecmp (SDATA (value
), "false") == 0)
3644 else if (xstrcasecmp (SDATA (value
), "unspecified") == 0)
3645 result
= Qunspecified
;
3647 signal_error ("Invalid face attribute value from X resource", value
);
3653 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3654 Finternal_set_lisp_face_attribute_from_resource
,
3655 Sinternal_set_lisp_face_attribute_from_resource
,
3656 3, 4, 0, doc
: /* */)
3657 (face
, attr
, value
, frame
)
3658 Lisp_Object face
, attr
, value
, frame
;
3660 CHECK_SYMBOL (face
);
3661 CHECK_SYMBOL (attr
);
3662 CHECK_STRING (value
);
3664 if (xstrcasecmp (SDATA (value
), "unspecified") == 0)
3665 value
= Qunspecified
;
3666 else if (EQ (attr
, QCheight
))
3668 value
= Fstring_to_number (value
, make_number (10));
3669 if (XINT (value
) <= 0)
3670 signal_error ("Invalid face height from X resource", value
);
3672 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3673 value
= face_boolean_x_resource_value (value
, 1);
3674 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3675 value
= intern (SDATA (value
));
3676 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3677 value
= face_boolean_x_resource_value (value
, 1);
3678 else if (EQ (attr
, QCunderline
)
3679 || EQ (attr
, QCoverline
)
3680 || EQ (attr
, QCstrike_through
))
3682 Lisp_Object boolean_value
;
3684 /* If the result of face_boolean_x_resource_value is t or nil,
3685 VALUE does NOT specify a color. */
3686 boolean_value
= face_boolean_x_resource_value (value
, 0);
3687 if (SYMBOLP (boolean_value
))
3688 value
= boolean_value
;
3690 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3691 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3693 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3696 #endif /* HAVE_WINDOW_SYSTEM */
3699 /***********************************************************************
3701 ***********************************************************************/
3703 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3705 /* Make menus on frame F appear as specified by the `menu' face. */
3708 x_update_menu_appearance (f
)
3711 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3715 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3719 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3720 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3721 const char *myname
= SDATA (Vx_resource_name
);
3724 const char *popup_path
= "popup_menu";
3726 const char *popup_path
= "menu.popup";
3729 if (STRINGP (LFACE_FOREGROUND (lface
)))
3731 sprintf (line
, "%s.%s*foreground: %s",
3733 SDATA (LFACE_FOREGROUND (lface
)));
3734 XrmPutLineResource (&rdb
, line
);
3735 sprintf (line
, "%s.pane.menubar*foreground: %s",
3736 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3737 XrmPutLineResource (&rdb
, line
);
3741 if (STRINGP (LFACE_BACKGROUND (lface
)))
3743 sprintf (line
, "%s.%s*background: %s",
3745 SDATA (LFACE_BACKGROUND (lface
)));
3746 XrmPutLineResource (&rdb
, line
);
3747 sprintf (line
, "%s.pane.menubar*background: %s",
3748 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3749 XrmPutLineResource (&rdb
, line
);
3754 /* On Solaris 5.8, it's been reported that the `menu' face
3755 can be unspecified here, during startup. Why this
3756 happens remains unknown. -- cyd */
3757 && FONTP (LFACE_FONT (lface
))
3758 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3759 || !UNSPECIFIEDP (LFACE_FOUNDRY (lface
))
3760 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3761 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3762 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3763 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3765 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
), Qnil
);
3767 const char *suffix
= "List";
3770 #if defined HAVE_X_I18N
3772 const char *suffix
= "Set";
3774 const char *suffix
= "";
3781 #if defined HAVE_X_I18N
3782 extern char *xic_create_fontsetname
3783 P_ ((char *base_fontname
, Bool motif
));
3784 char *fontsetname
= xic_create_fontsetname (SDATA (xlfd
), motif
);
3786 char *fontsetname
= (char *) SDATA (xlfd
);
3788 sprintf (line
, "%s.pane.menubar*font%s: %s",
3789 myname
, suffix
, fontsetname
);
3790 XrmPutLineResource (&rdb
, line
);
3791 sprintf (line
, "%s.%s*font%s: %s",
3792 myname
, popup_path
, suffix
, fontsetname
);
3793 XrmPutLineResource (&rdb
, line
);
3795 if (fontsetname
!= (char *) SDATA (xlfd
))
3796 xfree (fontsetname
);
3800 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3801 free_frame_menubar (f
);
3805 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3808 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3809 Sface_attribute_relative_p
,
3811 doc
: /* Check whether a face attribute value is relative.
3812 Specifically, this function returns t if the attribute ATTRIBUTE
3813 with the value VALUE is relative.
3815 A relative value is one that doesn't entirely override whatever is
3816 inherited from another face. For most possible attributes,
3817 the only relative value that users see is `unspecified'.
3818 However, for :height, floating point values are also relative. */)
3820 Lisp_Object attribute
, value
;
3822 if (EQ (value
, Qunspecified
) || (EQ (value
, Qignore_defface
)))
3824 else if (EQ (attribute
, QCheight
))
3825 return INTEGERP (value
) ? Qnil
: Qt
;
3830 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3832 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3833 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3834 the result will be absolute, otherwise it will be relative. */)
3835 (attribute
, value1
, value2
)
3836 Lisp_Object attribute
, value1
, value2
;
3838 if (EQ (value1
, Qunspecified
) || EQ (value1
, Qignore_defface
))
3840 else if (EQ (attribute
, QCheight
))
3841 return merge_face_heights (value1
, value2
, value1
);
3847 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3848 Sinternal_get_lisp_face_attribute
,
3850 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3851 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3852 face attribute name, signal an error.
3853 If the optional argument FRAME is given, report on face SYMBOL in that
3854 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3855 frames). If FRAME is omitted or nil, use the selected frame. */)
3856 (symbol
, keyword
, frame
)
3857 Lisp_Object symbol
, keyword
, frame
;
3859 Lisp_Object lface
, value
= Qnil
;
3861 CHECK_SYMBOL (symbol
);
3862 CHECK_SYMBOL (keyword
);
3865 lface
= lface_from_face_name (NULL
, symbol
, 1);
3869 frame
= selected_frame
;
3870 CHECK_LIVE_FRAME (frame
);
3871 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3874 if (EQ (keyword
, QCfamily
))
3875 value
= LFACE_FAMILY (lface
);
3876 else if (EQ (keyword
, QCfoundry
))
3877 value
= LFACE_FOUNDRY (lface
);
3878 else if (EQ (keyword
, QCheight
))
3879 value
= LFACE_HEIGHT (lface
);
3880 else if (EQ (keyword
, QCweight
))
3881 value
= LFACE_WEIGHT (lface
);
3882 else if (EQ (keyword
, QCslant
))
3883 value
= LFACE_SLANT (lface
);
3884 else if (EQ (keyword
, QCunderline
))
3885 value
= LFACE_UNDERLINE (lface
);
3886 else if (EQ (keyword
, QCoverline
))
3887 value
= LFACE_OVERLINE (lface
);
3888 else if (EQ (keyword
, QCstrike_through
))
3889 value
= LFACE_STRIKE_THROUGH (lface
);
3890 else if (EQ (keyword
, QCbox
))
3891 value
= LFACE_BOX (lface
);
3892 else if (EQ (keyword
, QCinverse_video
)
3893 || EQ (keyword
, QCreverse_video
))
3894 value
= LFACE_INVERSE (lface
);
3895 else if (EQ (keyword
, QCforeground
))
3896 value
= LFACE_FOREGROUND (lface
);
3897 else if (EQ (keyword
, QCbackground
))
3898 value
= LFACE_BACKGROUND (lface
);
3899 else if (EQ (keyword
, QCstipple
))
3900 value
= LFACE_STIPPLE (lface
);
3901 else if (EQ (keyword
, QCwidth
))
3902 value
= LFACE_SWIDTH (lface
);
3903 else if (EQ (keyword
, QCinherit
))
3904 value
= LFACE_INHERIT (lface
);
3905 else if (EQ (keyword
, QCfont
))
3906 value
= LFACE_FONT (lface
);
3907 else if (EQ (keyword
, QCfontset
))
3908 value
= LFACE_FONTSET (lface
);
3910 signal_error ("Invalid face attribute name", keyword
);
3912 if (IGNORE_DEFFACE_P (value
))
3913 return Qunspecified
;
3919 DEFUN ("internal-lisp-face-attribute-values",
3920 Finternal_lisp_face_attribute_values
,
3921 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3922 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3923 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3927 Lisp_Object result
= Qnil
;
3929 CHECK_SYMBOL (attr
);
3931 if (EQ (attr
, QCunderline
))
3932 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3933 else if (EQ (attr
, QCoverline
))
3934 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3935 else if (EQ (attr
, QCstrike_through
))
3936 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3937 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3938 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3944 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3945 Sinternal_merge_in_global_face
, 2, 2, 0,
3946 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3947 Default face attributes override any local face attributes. */)
3949 Lisp_Object face
, frame
;
3952 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3953 struct frame
*f
= XFRAME (frame
);
3955 CHECK_LIVE_FRAME (frame
);
3956 global_lface
= lface_from_face_name (NULL
, face
, 1);
3957 local_lface
= lface_from_face_name (f
, face
, 0);
3958 if (NILP (local_lface
))
3959 local_lface
= Finternal_make_lisp_face (face
, frame
);
3961 /* Make every specified global attribute override the local one.
3962 BEWARE!! This is only used from `face-set-after-frame-default' where
3963 the local frame is defined from default specs in `face-defface-spec'
3964 and those should be overridden by global settings. Hence the strange
3965 "global before local" priority. */
3966 lvec
= XVECTOR (local_lface
)->contents
;
3967 gvec
= XVECTOR (global_lface
)->contents
;
3968 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3969 if (IGNORE_DEFFACE_P (gvec
[i
]))
3970 lvec
[i
] = Qunspecified
;
3971 else if (! UNSPECIFIEDP (gvec
[i
]))
3974 /* If the default face was changed, update the face cache and the
3975 `font' frame parameter. */
3976 if (EQ (face
, Qdefault
))
3978 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
3979 struct face
*newface
, *oldface
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
3980 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
3982 /* This can be NULL (e.g., in batch mode). */
3985 /* Ensure that the face vector is fully specified by merging
3986 the previously-cached vector. */
3987 bcopy (oldface
->lface
, attrs
, sizeof attrs
);
3988 merge_face_vectors (f
, lvec
, attrs
, 0);
3989 bcopy (attrs
, lvec
, sizeof attrs
);
3990 newface
= realize_face (c
, lvec
, DEFAULT_FACE_ID
);
3992 if ((! UNSPECIFIEDP (gvec
[LFACE_FAMILY_INDEX
])
3993 || ! UNSPECIFIEDP (gvec
[LFACE_FOUNDRY_INDEX
])
3994 || ! UNSPECIFIEDP (gvec
[LFACE_HEIGHT_INDEX
])
3995 || ! UNSPECIFIEDP (gvec
[LFACE_WEIGHT_INDEX
])
3996 || ! UNSPECIFIEDP (gvec
[LFACE_SLANT_INDEX
])
3997 || ! UNSPECIFIEDP (gvec
[LFACE_SWIDTH_INDEX
])
3998 || ! UNSPECIFIEDP (gvec
[LFACE_FONT_INDEX
]))
4001 Lisp_Object name
= newface
->font
->props
[FONT_NAME_INDEX
];
4002 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, name
),
4012 /* The following function is implemented for compatibility with 20.2.
4013 The function is used in x-resolve-fonts when it is asked to
4014 return fonts with the same size as the font of a face. This is
4015 done in fontset.el. */
4017 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
4018 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4019 The font name is, by default, for ASCII characters.
4020 If the optional argument FRAME is given, report on face FACE in that frame.
4021 If FRAME is t, report on the defaults for face FACE (for new frames).
4022 The font default for a face is either nil, or a list
4023 of the form (bold), (italic) or (bold italic).
4024 If FRAME is omitted or nil, use the selected frame. And, in this case,
4025 if the optional third argument CHARACTER is given,
4026 return the font name used for CHARACTER. */)
4027 (face
, frame
, character
)
4028 Lisp_Object face
, frame
, character
;
4032 Lisp_Object result
= Qnil
;
4033 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4035 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4036 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4037 result
= Fcons (Qbold
, result
);
4039 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4040 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4041 result
= Fcons (Qitalic
, result
);
4047 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4048 int face_id
= lookup_named_face (f
, face
, 1);
4049 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4053 #ifdef HAVE_WINDOW_SYSTEM
4054 if (FRAME_WINDOW_P (f
) && !NILP (character
))
4056 CHECK_CHARACTER (character
);
4057 face_id
= FACE_FOR_CHAR (f
, face
, XINT (character
), -1, Qnil
);
4058 face
= FACE_FROM_ID (f
, face_id
);
4061 ? face
->font
->props
[FONT_NAME_INDEX
]
4063 #else /* !HAVE_WINDOW_SYSTEM */
4064 return build_string (FRAME_MSDOS_P (f
)
4066 : FRAME_W32_P (f
) ? "w32term"
4073 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
4074 all attributes are `equal'. Tries to be fast because this function
4075 is called quite often. */
4078 face_attr_equal_p (v1
, v2
)
4081 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4082 and the other is specified. */
4083 if (XTYPE (v1
) != XTYPE (v2
))
4092 if (SBYTES (v1
) != SBYTES (v2
))
4095 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
4102 return !NILP (Fequal (v1
, v2
));
4107 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4108 all attributes are `equal'. Tries to be fast because this function
4109 is called quite often. */
4112 lface_equal_p (v1
, v2
)
4113 Lisp_Object
*v1
, *v2
;
4117 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4118 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
4124 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4125 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4126 doc
: /* True if FACE1 and FACE2 are equal.
4127 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
4128 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
4129 If FRAME is omitted or nil, use the selected frame. */)
4130 (face1
, face2
, frame
)
4131 Lisp_Object face1
, face2
, frame
;
4135 Lisp_Object lface1
, lface2
;
4140 /* Don't use check_x_frame here because this function is called
4141 before X frames exist. At that time, if FRAME is nil,
4142 selected_frame will be used which is the frame dumped with
4143 Emacs. That frame is not an X frame. */
4144 f
= frame_or_selected_frame (frame
, 2);
4146 lface1
= lface_from_face_name (f
, face1
, 1);
4147 lface2
= lface_from_face_name (f
, face2
, 1);
4148 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4149 XVECTOR (lface2
)->contents
);
4150 return equal_p
? Qt
: Qnil
;
4154 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4155 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4156 doc
: /* True if FACE has no attribute specified.
4157 If the optional argument FRAME is given, report on face FACE in that frame.
4158 If FRAME is t, report on the defaults for face FACE (for new frames).
4159 If FRAME is omitted or nil, use the selected frame. */)
4161 Lisp_Object face
, frame
;
4168 frame
= selected_frame
;
4169 CHECK_LIVE_FRAME (frame
);
4173 lface
= lface_from_face_name (NULL
, face
, 1);
4175 lface
= lface_from_face_name (f
, face
, 1);
4177 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4178 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4181 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4185 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4187 doc
: /* Return an alist of frame-local faces defined on FRAME.
4188 For internal use only. */)
4192 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4193 return f
->face_alist
;
4197 /* Return a hash code for Lisp string STRING with case ignored. Used
4198 below in computing a hash value for a Lisp face. */
4200 static INLINE
unsigned
4201 hash_string_case_insensitive (string
)
4204 const unsigned char *s
;
4206 xassert (STRINGP (string
));
4207 for (s
= SDATA (string
); *s
; ++s
)
4208 hash
= (hash
<< 1) ^ tolower (*s
);
4213 /* Return a hash code for face attribute vector V. */
4215 static INLINE
unsigned
4219 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4220 ^ hash_string_case_insensitive (v
[LFACE_FOUNDRY_INDEX
])
4221 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4222 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4223 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4224 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4225 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4226 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4230 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4231 considering charsets/registries). They do if they specify the same
4232 family, point size, weight, width, slant, and font. Both
4233 LFACE1 and LFACE2 must be fully-specified. */
4236 lface_same_font_attributes_p (lface1
, lface2
)
4237 Lisp_Object
*lface1
, *lface2
;
4239 xassert (lface_fully_specified_p (lface1
)
4240 && lface_fully_specified_p (lface2
));
4241 return (xstrcasecmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
4242 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4243 && xstrcasecmp (SDATA (lface1
[LFACE_FOUNDRY_INDEX
]),
4244 SDATA (lface2
[LFACE_FOUNDRY_INDEX
])) == 0
4245 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4246 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4247 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4248 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4249 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4250 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4251 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4252 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4253 && ! xstrcasecmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
4254 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4260 /***********************************************************************
4262 ***********************************************************************/
4264 /* Allocate and return a new realized face for Lisp face attribute
4267 static struct face
*
4268 make_realized_face (attr
)
4271 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4272 bzero (face
, sizeof *face
);
4273 face
->ascii_face
= face
;
4274 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4279 /* Free realized face FACE, including its X resources. FACE may
4283 free_realized_face (f
, face
)
4289 #ifdef HAVE_WINDOW_SYSTEM
4290 if (FRAME_WINDOW_P (f
))
4292 /* Free fontset of FACE if it is ASCII face. */
4293 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4294 free_face_fontset (f
, face
);
4299 font_done_for_face (f
, face
);
4300 x_free_gc (f
, face
->gc
);
4305 free_face_colors (f
, face
);
4306 x_destroy_bitmap (f
, face
->stipple
);
4308 #endif /* HAVE_WINDOW_SYSTEM */
4315 /* Prepare face FACE for subsequent display on frame F. This
4316 allocated GCs if they haven't been allocated yet or have been freed
4317 by clearing the face cache. */
4320 prepare_face_for_display (f
, face
)
4324 #ifdef HAVE_WINDOW_SYSTEM
4325 xassert (FRAME_WINDOW_P (f
));
4330 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4332 xgcv
.foreground
= face
->foreground
;
4333 xgcv
.background
= face
->background
;
4334 #ifdef HAVE_X_WINDOWS
4335 xgcv
.graphics_exposures
= False
;
4339 #ifdef HAVE_X_WINDOWS
4342 xgcv
.fill_style
= FillOpaqueStippled
;
4343 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4344 mask
|= GCFillStyle
| GCStipple
;
4347 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4349 font_prepare_for_face (f
, face
);
4352 #endif /* HAVE_WINDOW_SYSTEM */
4356 /* Returns the `distance' between the colors X and Y. */
4359 color_distance (x
, y
)
4362 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
4363 Quoting from that paper:
4365 This formula has results that are very close to L*u*v* (with the
4366 modified lightness curve) and, more importantly, it is a more even
4367 algorithm: it does not have a range of colours where it suddenly
4368 gives far from optimal results.
4370 See <http://www.compuphase.com/cmetric.htm> for more info. */
4372 long r
= (x
->red
- y
->red
) >> 8;
4373 long g
= (x
->green
- y
->green
) >> 8;
4374 long b
= (x
->blue
- y
->blue
) >> 8;
4375 long r_mean
= (x
->red
+ y
->red
) >> 9;
4378 (((512 + r_mean
) * r
* r
) >> 8)
4380 + (((767 - r_mean
) * b
* b
) >> 8);
4384 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4385 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4386 COLOR1 and COLOR2 may be either strings containing the color name,
4387 or lists of the form (RED GREEN BLUE).
4388 If FRAME is unspecified or nil, the current frame is used. */)
4389 (color1
, color2
, frame
)
4390 Lisp_Object color1
, color2
, frame
;
4393 XColor cdef1
, cdef2
;
4396 frame
= selected_frame
;
4397 CHECK_LIVE_FRAME (frame
);
4400 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4401 && !(STRINGP (color1
) && defined_color (f
, SDATA (color1
), &cdef1
, 0)))
4402 signal_error ("Invalid color", color1
);
4403 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4404 && !(STRINGP (color2
) && defined_color (f
, SDATA (color2
), &cdef2
, 0)))
4405 signal_error ("Invalid color", color2
);
4407 return make_number (color_distance (&cdef1
, &cdef2
));
4411 /***********************************************************************
4413 ***********************************************************************/
4415 /* Return a new face cache for frame F. */
4417 static struct face_cache
*
4421 struct face_cache
*c
;
4424 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4425 bzero (c
, sizeof *c
);
4426 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4427 c
->buckets
= (struct face
**) xmalloc (size
);
4428 bzero (c
->buckets
, size
);
4430 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4432 c
->menu_face_changed_p
= menu_face_changed_default
;
4437 /* Clear out all graphics contexts for all realized faces, except for
4438 the basic faces. This should be done from time to time just to avoid
4439 keeping too many graphics contexts that are no longer needed. */
4443 struct face_cache
*c
;
4445 if (c
&& FRAME_WINDOW_P (c
->f
))
4447 #ifdef HAVE_WINDOW_SYSTEM
4449 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4451 struct face
*face
= c
->faces_by_id
[i
];
4452 if (face
&& face
->gc
)
4456 font_done_for_face (c
->f
, face
);
4457 x_free_gc (c
->f
, face
->gc
);
4462 #endif /* HAVE_WINDOW_SYSTEM */
4467 /* Free all realized faces in face cache C, including basic faces.
4468 C may be null. If faces are freed, make sure the frame's current
4469 matrix is marked invalid, so that a display caused by an expose
4470 event doesn't try to use faces we destroyed. */
4473 free_realized_faces (c
)
4474 struct face_cache
*c
;
4479 struct frame
*f
= c
->f
;
4481 /* We must block input here because we can't process X events
4482 safely while only some faces are freed, or when the frame's
4483 current matrix still references freed faces. */
4486 for (i
= 0; i
< c
->used
; ++i
)
4488 free_realized_face (f
, c
->faces_by_id
[i
]);
4489 c
->faces_by_id
[i
] = NULL
;
4493 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4494 bzero (c
->buckets
, size
);
4496 /* Must do a thorough redisplay the next time. Mark current
4497 matrices as invalid because they will reference faces freed
4498 above. This function is also called when a frame is
4499 destroyed. In this case, the root window of F is nil. */
4500 if (WINDOWP (f
->root_window
))
4502 clear_current_matrices (f
);
4503 ++windows_or_buffers_changed
;
4511 /* Free all realized faces that are using FONTSET on frame F. */
4514 free_realized_faces_for_fontset (f
, fontset
)
4518 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4522 /* We must block input here because we can't process X events safely
4523 while only some faces are freed, or when the frame's current
4524 matrix still references freed faces. */
4527 for (i
= 0; i
< cache
->used
; i
++)
4529 face
= cache
->faces_by_id
[i
];
4531 && face
->fontset
== fontset
)
4533 uncache_face (cache
, face
);
4534 free_realized_face (f
, face
);
4538 /* Must do a thorough redisplay the next time. Mark current
4539 matrices as invalid because they will reference faces freed
4540 above. This function is also called when a frame is destroyed.
4541 In this case, the root window of F is nil. */
4542 if (WINDOWP (f
->root_window
))
4544 clear_current_matrices (f
);
4545 ++windows_or_buffers_changed
;
4552 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4553 This is done after attributes of a named face have been changed,
4554 because we can't tell which realized faces depend on that face. */
4557 free_all_realized_faces (frame
)
4563 FOR_EACH_FRAME (rest
, frame
)
4564 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4567 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4571 /* Free face cache C and faces in it, including their X resources. */
4575 struct face_cache
*c
;
4579 free_realized_faces (c
);
4581 xfree (c
->faces_by_id
);
4587 /* Cache realized face FACE in face cache C. HASH is the hash value
4588 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4589 FACE), insert the new face to the beginning of the collision list
4590 of the face hash table of C. Otherwise, add the new face to the
4591 end of the collision list. This way, lookup_face can quickly find
4592 that a requested face is not cached. */
4595 cache_face (c
, face
, hash
)
4596 struct face_cache
*c
;
4600 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4604 if (face
->ascii_face
!= face
)
4606 struct face
*last
= c
->buckets
[i
];
4617 c
->buckets
[i
] = face
;
4618 face
->prev
= face
->next
= NULL
;
4624 face
->next
= c
->buckets
[i
];
4626 face
->next
->prev
= face
;
4627 c
->buckets
[i
] = face
;
4630 /* Find a free slot in C->faces_by_id and use the index of the free
4631 slot as FACE->id. */
4632 for (i
= 0; i
< c
->used
; ++i
)
4633 if (c
->faces_by_id
[i
] == NULL
)
4637 /* Maybe enlarge C->faces_by_id. */
4640 if (c
->used
== c
->size
)
4643 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
4644 if (new_size
== c
->size
)
4645 abort (); /* Alternatives? ++kfs */
4646 sz
= new_size
* sizeof *c
->faces_by_id
;
4647 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4654 /* Check that FACE got a unique id. */
4659 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4660 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4666 #endif /* GLYPH_DEBUG */
4668 c
->faces_by_id
[i
] = face
;
4672 /* Remove face FACE from cache C. */
4675 uncache_face (c
, face
)
4676 struct face_cache
*c
;
4679 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4682 face
->prev
->next
= face
->next
;
4684 c
->buckets
[i
] = face
->next
;
4687 face
->next
->prev
= face
->prev
;
4689 c
->faces_by_id
[face
->id
] = NULL
;
4690 if (face
->id
== c
->used
)
4695 /* Look up a realized face with face attributes ATTR in the face cache
4696 of frame F. The face will be used to display ASCII characters.
4697 Value is the ID of the face found. If no suitable face is found,
4698 realize a new one. */
4701 lookup_face (f
, attr
)
4705 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4710 xassert (cache
!= NULL
);
4711 check_lface_attrs (attr
);
4713 /* Look up ATTR in the face cache. */
4714 hash
= lface_hash (attr
);
4715 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4717 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4719 if (face
->ascii_face
!= face
)
4721 /* There's no more ASCII face. */
4725 if (face
->hash
== hash
4726 && lface_equal_p (face
->lface
, attr
))
4730 /* If not found, realize a new face. */
4732 face
= realize_face (cache
, attr
, -1);
4735 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4736 #endif /* GLYPH_DEBUG */
4741 #ifdef HAVE_WINDOW_SYSTEM
4742 /* Look up a realized face that has the same attributes as BASE_FACE
4743 except for the font in the face cache of frame F. If FONT-OBJECT
4744 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4745 the face has no font. Value is the ID of the face found. If no
4746 suitable face is found, realize a new one. */
4749 face_for_font (f
, font_object
, base_face
)
4751 Lisp_Object font_object
;
4752 struct face
*base_face
;
4754 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4759 xassert (cache
!= NULL
);
4760 base_face
= base_face
->ascii_face
;
4761 hash
= lface_hash (base_face
->lface
);
4762 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4764 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4766 if (face
->ascii_face
== face
)
4768 if (face
->ascii_face
== base_face
4769 && face
->font
== (NILP (font_object
) ? NULL
4770 : XFONT_OBJECT (font_object
))
4771 && lface_equal_p (face
->lface
, base_face
->lface
))
4775 /* If not found, realize a new face. */
4776 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4779 #endif /* HAVE_WINDOW_SYSTEM */
4781 /* Return the face id of the realized face for named face SYMBOL on
4782 frame F suitable for displaying ASCII characters. Value is -1 if
4783 the face couldn't be determined, which might happen if the default
4784 face isn't realized and cannot be realized. */
4787 lookup_named_face (f
, symbol
, signal_p
)
4792 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4793 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4794 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4796 if (default_face
== NULL
)
4798 if (!realize_basic_faces (f
))
4800 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4801 if (default_face
== NULL
)
4802 abort (); /* realize_basic_faces must have set it up */
4805 if (! get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
4808 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4809 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4811 return lookup_face (f
, attrs
);
4815 /* Return the display face-id of the basic face who's canonical face-id
4816 is FACE_ID. The return value will usually simply be FACE_ID, unless that
4817 basic face has bee remapped via Vface_remapping_alist. This function is
4818 conservative: if something goes wrong, it will simply return FACE_ID
4819 rather than signal an error. */
4822 lookup_basic_face (f
, face_id
)
4826 Lisp_Object name
, mapping
;
4827 int remapped_face_id
;
4829 if (NILP (Vface_remapping_alist
))
4830 return face_id
; /* Nothing to do. */
4834 case DEFAULT_FACE_ID
: name
= Qdefault
; break;
4835 case MODE_LINE_FACE_ID
: name
= Qmode_line
; break;
4836 case MODE_LINE_INACTIVE_FACE_ID
: name
= Qmode_line_inactive
; break;
4837 case HEADER_LINE_FACE_ID
: name
= Qheader_line
; break;
4838 case TOOL_BAR_FACE_ID
: name
= Qtool_bar
; break;
4839 case FRINGE_FACE_ID
: name
= Qfringe
; break;
4840 case SCROLL_BAR_FACE_ID
: name
= Qscroll_bar
; break;
4841 case BORDER_FACE_ID
: name
= Qborder
; break;
4842 case CURSOR_FACE_ID
: name
= Qcursor
; break;
4843 case MOUSE_FACE_ID
: name
= Qmouse
; break;
4844 case MENU_FACE_ID
: name
= Qmenu
; break;
4847 abort (); /* the caller is supposed to pass us a basic face id */
4850 /* Do a quick scan through Vface_remapping_alist, and return immediately
4851 if there is no remapping for face NAME. This is just an optimization
4852 for the very common no-remapping case. */
4853 mapping
= assq_no_quit (name
, Vface_remapping_alist
);
4855 return face_id
; /* Give up. */
4857 /* If there is a remapping entry, lookup the face using NAME, which will
4858 handle the remapping too. */
4859 remapped_face_id
= lookup_named_face (f
, name
, 0);
4860 if (remapped_face_id
< 0)
4861 return face_id
; /* Give up. */
4863 return remapped_face_id
;
4867 /* Return the ID of the realized ASCII face of Lisp face with ID
4868 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4871 ascii_face_of_lisp_face (f
, lface_id
)
4877 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4879 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4880 face_id
= lookup_named_face (f
, face_name
, 1);
4889 /* Return a face for charset ASCII that is like the face with id
4890 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4891 STEPS < 0 means larger. Value is the id of the face. */
4894 smaller_face (f
, face_id
, steps
)
4898 #ifdef HAVE_WINDOW_SYSTEM
4900 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4901 int pt
, last_pt
, last_height
;
4904 struct face
*new_face
;
4906 /* If not called for an X frame, just return the original face. */
4907 if (FRAME_TERMCAP_P (f
))
4910 /* Try in increments of 1/2 pt. */
4911 delta
= steps
< 0 ? 5 : -5;
4912 steps
= eabs (steps
);
4914 face
= FACE_FROM_ID (f
, face_id
);
4915 bcopy (face
->lface
, attrs
, sizeof attrs
);
4916 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4917 new_face_id
= face_id
;
4918 last_height
= FONT_HEIGHT (face
->font
);
4922 /* Give up if we cannot find a font within 10pt. */
4923 && eabs (last_pt
- pt
) < 100)
4925 /* Look up a face for a slightly smaller/larger font. */
4927 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4928 new_face_id
= lookup_face (f
, attrs
);
4929 new_face
= FACE_FROM_ID (f
, new_face_id
);
4931 /* If height changes, count that as one step. */
4932 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4933 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4936 last_height
= FONT_HEIGHT (new_face
->font
);
4943 #else /* not HAVE_WINDOW_SYSTEM */
4947 #endif /* not HAVE_WINDOW_SYSTEM */
4951 /* Return a face for charset ASCII that is like the face with id
4952 FACE_ID on frame F, but has height HEIGHT. */
4955 face_with_height (f
, face_id
, height
)
4960 #ifdef HAVE_WINDOW_SYSTEM
4962 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4964 if (FRAME_TERMCAP_P (f
)
4968 face
= FACE_FROM_ID (f
, face_id
);
4969 bcopy (face
->lface
, attrs
, sizeof attrs
);
4970 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4971 font_clear_prop (attrs
, FONT_SIZE_INDEX
);
4972 face_id
= lookup_face (f
, attrs
);
4973 #endif /* HAVE_WINDOW_SYSTEM */
4979 /* Return the face id of the realized face for named face SYMBOL on
4980 frame F suitable for displaying ASCII characters, and use
4981 attributes of the face FACE_ID for attributes that aren't
4982 completely specified by SYMBOL. This is like lookup_named_face,
4983 except that the default attributes come from FACE_ID, not from the
4984 default face. FACE_ID is assumed to be already realized. */
4987 lookup_derived_face (f
, symbol
, face_id
, signal_p
)
4993 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4994 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4995 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5000 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
, 0))
5003 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5004 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5005 return lookup_face (f
, attrs
);
5008 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5009 Sface_attributes_as_vector
, 1, 1, 0,
5010 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5015 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5017 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
5024 /***********************************************************************
5025 Face capability testing
5026 ***********************************************************************/
5029 /* If the distance (as returned by color_distance) between two colors is
5030 less than this, then they are considered the same, for determining
5031 whether a color is supported or not. The range of values is 0-65535. */
5033 #define TTY_SAME_COLOR_THRESHOLD 10000
5035 #ifdef HAVE_WINDOW_SYSTEM
5037 /* Return non-zero if all the face attributes in ATTRS are supported
5038 on the window-system frame F.
5040 The definition of `supported' is somewhat heuristic, but basically means
5041 that a face containing all the attributes in ATTRS, when merged with the
5042 default face for display, can be represented in a way that's
5044 \(1) different in appearance than the default face, and
5045 \(2) `close in spirit' to what the attributes specify, if not exact. */
5048 x_supports_face_attributes_p (f
, attrs
, def_face
)
5051 struct face
*def_face
;
5053 Lisp_Object
*def_attrs
= def_face
->lface
;
5055 /* Check that other specified attributes are different that the default
5057 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
5058 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
5059 def_attrs
[LFACE_UNDERLINE_INDEX
]))
5060 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
5061 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
5062 def_attrs
[LFACE_INVERSE_INDEX
]))
5063 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
5064 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
5065 def_attrs
[LFACE_FOREGROUND_INDEX
]))
5066 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
5067 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
5068 def_attrs
[LFACE_BACKGROUND_INDEX
]))
5069 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5070 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
5071 def_attrs
[LFACE_STIPPLE_INDEX
]))
5072 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5073 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
5074 def_attrs
[LFACE_OVERLINE_INDEX
]))
5075 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5076 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5077 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
5078 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5079 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
5080 def_attrs
[LFACE_BOX_INDEX
])))
5083 /* Check font-related attributes, as those are the most commonly
5084 "unsupported" on a window-system (because of missing fonts). */
5085 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5086 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
5087 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5088 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
5089 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
5090 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
5094 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
5097 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
5099 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
5101 face_id
= lookup_face (f
, merged_attrs
);
5102 face
= FACE_FROM_ID (f
, face_id
);
5105 error ("Cannot make face");
5107 /* If the font is the same, or no font is found, then not
5109 if (face
->font
== def_face
->font
5112 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
5113 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
5117 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
5118 || face
->font
->driver
->case_sensitive
)
5120 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
5121 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
5122 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
5123 s2
, make_number (0), Qnil
, Qt
), Qt
))
5129 /* Everything checks out, this face is supported. */
5133 #endif /* HAVE_WINDOW_SYSTEM */
5135 /* Return non-zero if all the face attributes in ATTRS are supported
5138 The definition of `supported' is somewhat heuristic, but basically means
5139 that a face containing all the attributes in ATTRS, when merged
5140 with the default face for display, can be represented in a way that's
5142 \(1) different in appearance than the default face, and
5143 \(2) `close in spirit' to what the attributes specify, if not exact.
5145 Point (2) implies that a `:weight black' attribute will be satisfied
5146 by any terminal that can display bold, and a `:foreground "yellow"' as
5147 long as the terminal can display a yellowish color, but `:slant italic'
5148 will _not_ be satisfied by the tty display code's automatic
5149 substitution of a `dim' face for italic. */
5152 tty_supports_face_attributes_p (f
, attrs
, def_face
)
5155 struct face
*def_face
;
5158 Lisp_Object val
, fg
, bg
;
5159 XColor fg_tty_color
, fg_std_color
;
5160 XColor bg_tty_color
, bg_std_color
;
5161 unsigned test_caps
= 0;
5162 Lisp_Object
*def_attrs
= def_face
->lface
;
5165 /* First check some easy-to-check stuff; ttys support none of the
5166 following attributes, so we can just return false if any are requested
5167 (even if `nominal' values are specified, we should still return false,
5168 as that will be the same value that the default face uses). We
5169 consider :slant unsupportable on ttys, even though the face code
5170 actually `fakes' them using a dim attribute if possible. This is
5171 because the faked result is too different from what the face
5173 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5174 || !UNSPECIFIEDP (attrs
[LFACE_FOUNDRY_INDEX
])
5175 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5176 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5177 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
5178 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5179 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5180 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5181 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
5185 /* Test for terminal `capabilities' (non-color character attributes). */
5187 /* font weight (bold/dim) */
5188 val
= attrs
[LFACE_WEIGHT_INDEX
];
5189 if (!UNSPECIFIEDP (val
)
5190 && (weight
= FONT_WEIGHT_NAME_NUMERIC (val
), weight
>= 0))
5192 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
5196 if (def_weight
> 100)
5197 return 0; /* same as default */
5198 test_caps
= TTY_CAP_BOLD
;
5200 else if (weight
< 100)
5202 if (def_weight
< 100)
5203 return 0; /* same as default */
5204 test_caps
= TTY_CAP_DIM
;
5206 else if (def_weight
== 100)
5207 return 0; /* same as default */
5211 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5212 if (!UNSPECIFIEDP (val
))
5215 return 0; /* ttys can't use colored underlines */
5216 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
5217 return 0; /* same as default */
5219 test_caps
|= TTY_CAP_UNDERLINE
;
5223 val
= attrs
[LFACE_INVERSE_INDEX
];
5224 if (!UNSPECIFIEDP (val
))
5226 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
5227 return 0; /* same as default */
5229 test_caps
|= TTY_CAP_INVERSE
;
5233 /* Color testing. */
5235 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5236 we use them when calling `tty_capable_p' below, even if the face
5237 specifies no colors. */
5238 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5239 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5241 /* Check if foreground color is close enough. */
5242 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5245 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
5247 if (face_attr_equal_p (fg
, def_fg
))
5248 return 0; /* same as default */
5249 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5250 return 0; /* not a valid color */
5251 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5252 > TTY_SAME_COLOR_THRESHOLD
)
5253 return 0; /* displayed color is too different */
5255 /* Make sure the color is really different than the default. */
5257 XColor def_fg_color
;
5258 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5259 && (color_distance (&fg_tty_color
, &def_fg_color
)
5260 <= TTY_SAME_COLOR_THRESHOLD
))
5265 /* Check if background color is close enough. */
5266 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5269 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5271 if (face_attr_equal_p (bg
, def_bg
))
5272 return 0; /* same as default */
5273 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5274 return 0; /* not a valid color */
5275 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5276 > TTY_SAME_COLOR_THRESHOLD
)
5277 return 0; /* displayed color is too different */
5279 /* Make sure the color is really different than the default. */
5281 XColor def_bg_color
;
5282 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5283 && (color_distance (&bg_tty_color
, &def_bg_color
)
5284 <= TTY_SAME_COLOR_THRESHOLD
))
5289 /* If both foreground and background are requested, see if the
5290 distance between them is OK. We just check to see if the distance
5291 between the tty's foreground and background is close enough to the
5292 distance between the standard foreground and background. */
5293 if (STRINGP (fg
) && STRINGP (bg
))
5296 = (color_distance (&fg_std_color
, &bg_std_color
)
5297 - color_distance (&fg_tty_color
, &bg_tty_color
));
5298 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5299 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5304 /* See if the capabilities we selected above are supported, with the
5306 if (test_caps
!= 0 &&
5307 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5311 /* Hmmm, everything checks out, this terminal must support this face. */
5316 DEFUN ("display-supports-face-attributes-p",
5317 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5319 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5320 The optional argument DISPLAY can be a display name, a frame, or
5321 nil (meaning the selected frame's display).
5323 The definition of `supported' is somewhat heuristic, but basically means
5324 that a face containing all the attributes in ATTRIBUTES, when merged
5325 with the default face for display, can be represented in a way that's
5327 \(1) different in appearance than the default face, and
5328 \(2) `close in spirit' to what the attributes specify, if not exact.
5330 Point (2) implies that a `:weight black' attribute will be satisfied by
5331 any display that can display bold, and a `:foreground \"yellow\"' as long
5332 as it can display a yellowish color, but `:slant italic' will _not_ be
5333 satisfied by the tty display code's automatic substitution of a `dim'
5334 face for italic. */)
5335 (attributes
, display
)
5336 Lisp_Object attributes
, display
;
5338 int supports
= 0, i
;
5341 struct face
*def_face
;
5342 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5344 if (noninteractive
|| !initialized
)
5345 /* We may not be able to access low-level face information in batch
5346 mode, or before being dumped, and this function is not going to
5347 be very useful in those cases anyway, so just give up. */
5351 frame
= selected_frame
;
5352 else if (FRAMEP (display
))
5356 /* Find any frame on DISPLAY. */
5357 Lisp_Object fl_tail
;
5360 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5362 frame
= XCAR (fl_tail
);
5363 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5364 XFRAME (frame
)->param_alist
)),
5370 CHECK_LIVE_FRAME (frame
);
5373 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5374 attrs
[i
] = Qunspecified
;
5375 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5377 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5378 if (def_face
== NULL
)
5380 if (! realize_basic_faces (f
))
5381 error ("Cannot realize default face");
5382 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5383 if (def_face
== NULL
)
5384 abort (); /* realize_basic_faces must have set it up */
5387 /* Dispatch to the appropriate handler. */
5388 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5389 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5390 #ifdef HAVE_WINDOW_SYSTEM
5392 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5395 return supports
? Qt
: Qnil
;
5399 /***********************************************************************
5401 ***********************************************************************/
5403 DEFUN ("internal-set-font-selection-order",
5404 Finternal_set_font_selection_order
,
5405 Sinternal_set_font_selection_order
, 1, 1, 0,
5406 doc
: /* Set font selection order for face font selection to ORDER.
5407 ORDER must be a list of length 4 containing the symbols `:width',
5408 `:height', `:weight', and `:slant'. Face attributes appearing
5409 first in ORDER are matched first, e.g. if `:height' appears before
5410 `:weight' in ORDER, font selection first tries to find a font with
5411 a suitable height, and then tries to match the font weight.
5418 int indices
[DIM (font_sort_order
)];
5421 bzero (indices
, sizeof indices
);
5425 CONSP (list
) && i
< DIM (indices
);
5426 list
= XCDR (list
), ++i
)
5428 Lisp_Object attr
= XCAR (list
);
5431 if (EQ (attr
, QCwidth
))
5433 else if (EQ (attr
, QCheight
))
5434 xlfd
= XLFD_POINT_SIZE
;
5435 else if (EQ (attr
, QCweight
))
5437 else if (EQ (attr
, QCslant
))
5442 if (indices
[i
] != 0)
5447 if (!NILP (list
) || i
!= DIM (indices
))
5448 signal_error ("Invalid font sort order", order
);
5449 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5450 if (indices
[i
] == 0)
5451 signal_error ("Invalid font sort order", order
);
5453 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5455 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5456 free_all_realized_faces (Qnil
);
5459 font_update_sort_order (font_sort_order
);
5465 DEFUN ("internal-set-alternative-font-family-alist",
5466 Finternal_set_alternative_font_family_alist
,
5467 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5468 doc
: /* Define alternative font families to try in face font selection.
5469 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5470 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5471 be found. Value is ALIST. */)
5475 Lisp_Object entry
, tail
, tail2
;
5478 alist
= Fcopy_sequence (alist
);
5479 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5481 entry
= XCAR (tail
);
5483 entry
= Fcopy_sequence (entry
);
5484 XSETCAR (tail
, entry
);
5485 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5486 XSETCAR (tail2
, Fintern (XCAR (tail2
), Qnil
));
5489 Vface_alternative_font_family_alist
= alist
;
5490 free_all_realized_faces (Qnil
);
5495 DEFUN ("internal-set-alternative-font-registry-alist",
5496 Finternal_set_alternative_font_registry_alist
,
5497 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5498 doc
: /* Define alternative font registries to try in face font selection.
5499 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5500 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5501 be found. Value is ALIST. */)
5505 Lisp_Object entry
, tail
, tail2
;
5508 alist
= Fcopy_sequence (alist
);
5509 for (tail
= alist
; CONSP (tail
); tail
= XCDR (tail
))
5511 entry
= XCAR (tail
);
5513 entry
= Fcopy_sequence (entry
);
5514 XSETCAR (tail
, entry
);
5515 for (tail2
= entry
; CONSP (tail2
); tail2
= XCDR (tail2
))
5516 XSETCAR (tail2
, Fdowncase (XCAR (tail2
)));
5518 Vface_alternative_font_registry_alist
= alist
;
5519 free_all_realized_faces (Qnil
);
5524 #ifdef HAVE_WINDOW_SYSTEM
5526 /* Ignore the difference of font point size less than this value. */
5528 #define FONT_POINT_SIZE_QUANTUM 5
5530 /* Return the fontset id of the base fontset name or alias name given
5531 by the fontset attribute of ATTRS. Value is -1 if the fontset
5532 attribute of ATTRS doesn't name a fontset. */
5535 face_fontset (attrs
)
5540 name
= attrs
[LFACE_FONTSET_INDEX
];
5541 if (!STRINGP (name
))
5543 return fs_query_fontset (name
, 0);
5546 #endif /* HAVE_WINDOW_SYSTEM */
5550 /***********************************************************************
5552 ***********************************************************************/
5554 /* Realize basic faces on frame F. Value is zero if frame parameters
5555 of F don't contain enough information needed to realize the default
5559 realize_basic_faces (f
)
5563 int count
= SPECPDL_INDEX ();
5565 /* Block input here so that we won't be surprised by an X expose
5566 event, for instance, without having the faces set up. */
5568 specbind (Qscalable_fonts_allowed
, Qt
);
5570 if (realize_default_face (f
))
5572 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5573 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5574 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5575 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5576 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5577 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5578 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5579 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5580 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5581 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5582 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5584 /* Reflect changes in the `menu' face in menu bars. */
5585 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5587 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5588 #ifdef USE_X_TOOLKIT
5589 if (FRAME_WINDOW_P (f
))
5590 x_update_menu_appearance (f
);
5597 unbind_to (count
, Qnil
);
5603 /* Realize the default face on frame F. If the face is not fully
5604 specified, make it fully-specified. Attributes of the default face
5605 that are not explicitly specified are taken from frame parameters. */
5608 realize_default_face (f
)
5611 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5613 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5616 /* If the `default' face is not yet known, create it. */
5617 lface
= lface_from_face_name (f
, Qdefault
, 0);
5621 XSETFRAME (frame
, f
);
5622 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5625 #ifdef HAVE_WINDOW_SYSTEM
5626 if (FRAME_WINDOW_P (f
))
5628 Lisp_Object font_object
;
5630 XSETFONT (font_object
, FRAME_FONT (f
));
5631 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5632 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5633 f
->default_face_done_p
= 1;
5635 #endif /* HAVE_WINDOW_SYSTEM */
5637 if (!FRAME_WINDOW_P (f
))
5639 LFACE_FAMILY (lface
) = build_string ("default");
5640 LFACE_FOUNDRY (lface
) = LFACE_FAMILY (lface
);
5641 LFACE_SWIDTH (lface
) = Qnormal
;
5642 LFACE_HEIGHT (lface
) = make_number (1);
5643 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5644 LFACE_WEIGHT (lface
) = Qnormal
;
5645 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5646 LFACE_SLANT (lface
) = Qnormal
;
5647 if (UNSPECIFIEDP (LFACE_FONTSET (lface
)))
5648 LFACE_FONTSET (lface
) = Qnil
;
5651 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5652 LFACE_UNDERLINE (lface
) = Qnil
;
5654 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5655 LFACE_OVERLINE (lface
) = Qnil
;
5657 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5658 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5660 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5661 LFACE_BOX (lface
) = Qnil
;
5663 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5664 LFACE_INVERSE (lface
) = Qnil
;
5666 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5668 /* This function is called so early that colors are not yet
5669 set in the frame parameter list. */
5670 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5672 if (CONSP (color
) && STRINGP (XCDR (color
)))
5673 LFACE_FOREGROUND (lface
) = XCDR (color
);
5674 else if (FRAME_WINDOW_P (f
))
5676 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5677 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5682 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5684 /* This function is called so early that colors are not yet
5685 set in the frame parameter list. */
5686 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5687 if (CONSP (color
) && STRINGP (XCDR (color
)))
5688 LFACE_BACKGROUND (lface
) = XCDR (color
);
5689 else if (FRAME_WINDOW_P (f
))
5691 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5692 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5697 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5698 LFACE_STIPPLE (lface
) = Qnil
;
5700 /* Realize the face; it must be fully-specified now. */
5701 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5702 check_lface (lface
);
5703 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5704 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5706 #ifdef HAVE_WINDOW_SYSTEM
5707 #ifdef HAVE_X_WINDOWS
5708 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5710 /* This can happen when making a frame on a display that does
5711 not support the default font. */
5715 /* Otherwise, the font specified for the frame was not
5716 acceptable as a font for the default face (perhaps because
5717 auto-scaled fonts are rejected), so we must adjust the frame
5719 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5721 #endif /* HAVE_X_WINDOWS */
5722 #endif /* HAVE_WINDOW_SYSTEM */
5727 /* Realize basic faces other than the default face in face cache C.
5728 SYMBOL is the face name, ID is the face id the realized face must
5729 have. The default face must have been realized already. */
5732 realize_named_face (f
, symbol
, id
)
5737 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5738 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5739 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5740 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5741 struct face
*new_face
;
5743 /* The default face must exist and be fully specified. */
5744 get_lface_attributes_no_remap (f
, Qdefault
, attrs
, 1);
5745 check_lface_attrs (attrs
);
5746 xassert (lface_fully_specified_p (attrs
));
5748 /* If SYMBOL isn't know as a face, create it. */
5752 XSETFRAME (frame
, f
);
5753 lface
= Finternal_make_lisp_face (symbol
, frame
);
5756 /* Merge SYMBOL's face with the default face. */
5757 get_lface_attributes_no_remap (f
, symbol
, symbol_attrs
, 1);
5758 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5760 /* Realize the face. */
5761 new_face
= realize_face (c
, attrs
, id
);
5765 /* Realize the fully-specified face with attributes ATTRS in face
5766 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5767 non-negative, it is an ID of face to remove before caching the new
5768 face. Value is a pointer to the newly created realized face. */
5770 static struct face
*
5771 realize_face (cache
, attrs
, former_face_id
)
5772 struct face_cache
*cache
;
5778 /* LFACE must be fully specified. */
5779 xassert (cache
!= NULL
);
5780 check_lface_attrs (attrs
);
5782 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5784 /* Remove the former face. */
5785 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5786 uncache_face (cache
, former_face
);
5787 free_realized_face (cache
->f
, former_face
);
5788 SET_FRAME_GARBAGED (cache
->f
);
5791 if (FRAME_WINDOW_P (cache
->f
))
5792 face
= realize_x_face (cache
, attrs
);
5793 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5794 face
= realize_tty_face (cache
, attrs
);
5795 else if (FRAME_INITIAL_P (cache
->f
))
5797 /* Create a dummy face. */
5798 face
= make_realized_face (attrs
);
5803 /* Insert the new face. */
5804 cache_face (cache
, face
, lface_hash (attrs
));
5809 #ifdef HAVE_WINDOW_SYSTEM
5810 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5811 same attributes as BASE_FACE except for the font on frame F.
5812 FONT-OBJECT may be nil, in which case, realized a face of
5815 static struct face
*
5816 realize_non_ascii_face (f
, font_object
, base_face
)
5818 Lisp_Object font_object
;
5819 struct face
*base_face
;
5821 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5824 face
= (struct face
*) xmalloc (sizeof *face
);
5829 = (! NILP (font_object
)
5830 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5831 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5833 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5834 face
->colors_copied_bitwise_p
= 1;
5835 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5838 cache_face (cache
, face
, face
->hash
);
5842 #endif /* HAVE_WINDOW_SYSTEM */
5845 /* Realize the fully-specified face with attributes ATTRS in face
5846 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5847 the new face doesn't share font with the default face, a fontname
5848 is allocated from the heap and set in `font_name' of the new face,
5849 but it is not yet loaded here. Value is a pointer to the newly
5850 created realized face. */
5852 static struct face
*
5853 realize_x_face (cache
, attrs
)
5854 struct face_cache
*cache
;
5857 struct face
*face
= NULL
;
5858 #ifdef HAVE_WINDOW_SYSTEM
5859 struct face
*default_face
;
5861 Lisp_Object stipple
, overline
, strike_through
, box
;
5863 xassert (FRAME_WINDOW_P (cache
->f
));
5865 /* Allocate a new realized face. */
5866 face
= make_realized_face (attrs
);
5867 face
->ascii_face
= face
;
5871 /* Determine the font to use. Most of the time, the font will be
5872 the same as the font of the default face, so try that first. */
5873 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5875 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5877 face
->font
= default_face
->font
;
5879 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
5883 /* If the face attribute ATTRS specifies a fontset, use it as
5884 the base of a new realized fontset. Otherwise, use the same
5885 base fontset as of the default face. The base determines
5886 registry and encoding of a font. It may also determine
5887 foundry and family. The other fields of font name pattern
5888 are constructed from ATTRS. */
5889 int fontset
= face_fontset (attrs
);
5891 /* If we are realizing the default face, ATTRS should specify a
5892 fontset. In other words, if FONTSET is -1, we are not
5893 realizing the default face, thus the default face should have
5894 already been realized. */
5898 fontset
= default_face
->fontset
;
5902 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5903 attrs
[LFACE_FONT_INDEX
]
5904 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5905 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5907 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5908 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5918 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5919 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5920 face
->overstrike
= 1;
5922 /* Load colors, and set remaining attributes. */
5924 load_face_colors (f
, face
, attrs
);
5927 box
= attrs
[LFACE_BOX_INDEX
];
5930 /* A simple box of line width 1 drawn in color given by
5932 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5934 face
->box
= FACE_SIMPLE_BOX
;
5935 face
->box_line_width
= 1;
5937 else if (INTEGERP (box
))
5939 /* Simple box of specified line width in foreground color of the
5941 xassert (XINT (box
) != 0);
5942 face
->box
= FACE_SIMPLE_BOX
;
5943 face
->box_line_width
= XINT (box
);
5944 face
->box_color
= face
->foreground
;
5945 face
->box_color_defaulted_p
= 1;
5947 else if (CONSP (box
))
5949 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5950 being one of `raised' or `sunken'. */
5951 face
->box
= FACE_SIMPLE_BOX
;
5952 face
->box_color
= face
->foreground
;
5953 face
->box_color_defaulted_p
= 1;
5954 face
->box_line_width
= 1;
5958 Lisp_Object keyword
, value
;
5960 keyword
= XCAR (box
);
5968 if (EQ (keyword
, QCline_width
))
5970 if (INTEGERP (value
) && XINT (value
) != 0)
5971 face
->box_line_width
= XINT (value
);
5973 else if (EQ (keyword
, QCcolor
))
5975 if (STRINGP (value
))
5977 face
->box_color
= load_color (f
, face
, value
,
5979 face
->use_box_color_for_shadows_p
= 1;
5982 else if (EQ (keyword
, QCstyle
))
5984 if (EQ (value
, Qreleased_button
))
5985 face
->box
= FACE_RAISED_BOX
;
5986 else if (EQ (value
, Qpressed_button
))
5987 face
->box
= FACE_SUNKEN_BOX
;
5992 /* Text underline, overline, strike-through. */
5994 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5996 /* Use default color (same as foreground color). */
5997 face
->underline_p
= 1;
5998 face
->underline_defaulted_p
= 1;
5999 face
->underline_color
= 0;
6001 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6003 /* Use specified color. */
6004 face
->underline_p
= 1;
6005 face
->underline_defaulted_p
= 0;
6006 face
->underline_color
6007 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6008 LFACE_UNDERLINE_INDEX
);
6010 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6012 face
->underline_p
= 0;
6013 face
->underline_defaulted_p
= 0;
6014 face
->underline_color
= 0;
6017 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6018 if (STRINGP (overline
))
6020 face
->overline_color
6021 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6022 LFACE_OVERLINE_INDEX
);
6023 face
->overline_p
= 1;
6025 else if (EQ (overline
, Qt
))
6027 face
->overline_color
= face
->foreground
;
6028 face
->overline_color_defaulted_p
= 1;
6029 face
->overline_p
= 1;
6032 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6033 if (STRINGP (strike_through
))
6035 face
->strike_through_color
6036 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6037 LFACE_STRIKE_THROUGH_INDEX
);
6038 face
->strike_through_p
= 1;
6040 else if (EQ (strike_through
, Qt
))
6042 face
->strike_through_color
= face
->foreground
;
6043 face
->strike_through_color_defaulted_p
= 1;
6044 face
->strike_through_p
= 1;
6047 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6048 if (!NILP (stipple
))
6049 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6050 #endif /* HAVE_WINDOW_SYSTEM */
6056 /* Map a specified color of face FACE on frame F to a tty color index.
6057 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6058 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6059 default foreground/background colors. */
6062 map_tty_color (f
, face
, idx
, defaulted
)
6065 enum lface_attribute_index idx
;
6068 Lisp_Object frame
, color
, def
;
6069 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6070 unsigned long default_pixel
, default_other_pixel
, pixel
;
6072 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6076 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6077 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6081 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6082 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6085 XSETFRAME (frame
, f
);
6086 color
= face
->lface
[idx
];
6090 && CONSP (Vtty_defined_color_alist
)
6091 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6094 /* Associations in tty-defined-color-alist are of the form
6095 (NAME INDEX R G B). We need the INDEX part. */
6096 pixel
= XINT (XCAR (XCDR (def
)));
6099 if (pixel
== default_pixel
&& STRINGP (color
))
6101 pixel
= load_color (f
, face
, color
, idx
);
6104 /* If the foreground of the default face is the default color,
6105 use the foreground color defined by the frame. */
6106 if (FRAME_MSDOS_P (f
))
6108 if (pixel
== default_pixel
6109 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6112 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6114 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6115 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6118 else if (pixel
== default_other_pixel
)
6121 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6123 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6124 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6132 face
->foreground
= pixel
;
6134 face
->background
= pixel
;
6138 /* Realize the fully-specified face with attributes ATTRS in face
6139 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6140 Value is a pointer to the newly created realized face. */
6142 static struct face
*
6143 realize_tty_face (cache
, attrs
)
6144 struct face_cache
*cache
;
6149 int face_colors_defaulted
= 0;
6150 struct frame
*f
= cache
->f
;
6152 /* Frame must be a termcap frame. */
6153 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6155 /* Allocate a new realized face. */
6156 face
= make_realized_face (attrs
);
6158 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6161 /* Map face attributes to TTY appearances. We map slant to
6162 dimmed text because we want italic text to appear differently
6163 and because dimmed text is probably used infrequently. */
6164 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
6165 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
6167 face
->tty_bold_p
= 1;
6168 if (weight
< 100 || slant
!= 100)
6169 face
->tty_dim_p
= 1;
6170 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6171 face
->tty_underline_p
= 1;
6172 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6173 face
->tty_reverse_p
= 1;
6175 /* Map color names to color indices. */
6176 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6177 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6179 /* Swap colors if face is inverse-video. If the colors are taken
6180 from the frame colors, they are already inverted, since the
6181 frame-creation function calls x-handle-reverse-video. */
6182 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6184 unsigned long tem
= face
->foreground
;
6185 face
->foreground
= face
->background
;
6186 face
->background
= tem
;
6189 if (tty_suppress_bold_inverse_default_colors_p
6191 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6192 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6193 face
->tty_bold_p
= 0;
6199 DEFUN ("tty-suppress-bold-inverse-default-colors",
6200 Ftty_suppress_bold_inverse_default_colors
,
6201 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6202 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6203 SUPPRESS non-nil means suppress it.
6204 This affects bold faces on TTYs whose foreground is the default background
6205 color of the display and whose background is the default foreground color.
6206 For such faces, the bold face attribute is ignored if this variable
6209 Lisp_Object suppress
;
6211 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6212 ++face_change_count
;
6218 /***********************************************************************
6220 ***********************************************************************/
6222 /* Return the ID of the face to use to display character CH with face
6223 property PROP on frame F in current_buffer. */
6226 compute_char_face (f
, ch
, prop
)
6233 if (NILP (current_buffer
->enable_multibyte_characters
))
6238 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6239 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6243 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6244 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6245 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6246 merge_face_ref (f
, prop
, attrs
, 1, 0);
6247 face_id
= lookup_face (f
, attrs
);
6253 /* Return the face ID associated with buffer position POS for
6254 displaying ASCII characters. Return in *ENDPTR the position at
6255 which a different face is needed, as far as text properties and
6256 overlays are concerned. W is a window displaying current_buffer.
6258 REGION_BEG, REGION_END delimit the region, so it can be
6261 LIMIT is a position not to scan beyond. That is to limit the time
6262 this function can take.
6264 If MOUSE is non-zero, use the character's mouse-face, not its face.
6266 BASE_FACE_ID, if non-negative, specifies a base face id to use
6267 instead of DEFAULT_FACE_ID.
6269 The face returned is suitable for displaying ASCII characters. */
6272 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6273 endptr
, limit
, mouse
, base_face_id
)
6276 EMACS_INT region_beg
, region_end
;
6282 struct frame
*f
= XFRAME (w
->frame
);
6283 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6284 Lisp_Object prop
, position
;
6286 Lisp_Object
*overlay_vec
;
6289 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6290 Lisp_Object limit1
, end
;
6291 struct face
*default_face
;
6293 /* W must display the current buffer. We could write this function
6294 to use the frame and buffer of W, but right now it doesn't. */
6295 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6297 XSETFRAME (frame
, f
);
6298 XSETFASTINT (position
, pos
);
6301 if (pos
< region_beg
&& region_beg
< endpos
)
6302 endpos
= region_beg
;
6304 /* Get the `face' or `mouse_face' text property at POS, and
6305 determine the next position at which the property changes. */
6306 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6307 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6308 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6310 endpos
= XINT (end
);
6312 /* Look at properties from overlays. */
6314 EMACS_INT next_overlay
;
6316 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6317 if (next_overlay
< endpos
)
6318 endpos
= next_overlay
;
6323 default_face
= FACE_FROM_ID (f
, base_face_id
>= 0 ? base_face_id
6324 : NILP (Vface_remapping_alist
) ? DEFAULT_FACE_ID
6325 : lookup_basic_face (f
, DEFAULT_FACE_ID
));
6327 /* Optimize common cases where we can use the default face. */
6330 && !(pos
>= region_beg
&& pos
< region_end
))
6331 return default_face
->id
;
6333 /* Begin with attributes from the default face. */
6334 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6336 /* Merge in attributes specified via text properties. */
6338 merge_face_ref (f
, prop
, attrs
, 1, 0);
6340 /* Now merge the overlay data. */
6341 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6342 for (i
= 0; i
< noverlays
; i
++)
6347 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6349 merge_face_ref (f
, prop
, attrs
, 1, 0);
6351 oend
= OVERLAY_END (overlay_vec
[i
]);
6352 oendpos
= OVERLAY_POSITION (oend
);
6353 if (oendpos
< endpos
)
6357 /* If in the region, merge in the region face. */
6358 if (pos
>= region_beg
&& pos
< region_end
)
6360 merge_named_face (f
, Qregion
, attrs
, 0);
6362 if (region_end
< endpos
)
6363 endpos
= region_end
;
6368 /* Look up a realized face with the given face attributes,
6369 or realize a new one for ASCII characters. */
6370 return lookup_face (f
, attrs
);
6373 /* Return the face ID at buffer position POS for displaying ASCII
6374 characters associated with overlay strings for overlay OVERLAY.
6376 Like face_at_buffer_position except for OVERLAY. Currently it
6377 simply disregards the `face' properties of all overlays. */
6380 face_for_overlay_string (w
, pos
, region_beg
, region_end
,
6381 endptr
, limit
, mouse
, overlay
)
6384 EMACS_INT region_beg
, region_end
;
6388 Lisp_Object overlay
;
6390 struct frame
*f
= XFRAME (w
->frame
);
6391 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6392 Lisp_Object prop
, position
;
6395 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6396 Lisp_Object limit1
, end
;
6397 struct face
*default_face
;
6399 /* W must display the current buffer. We could write this function
6400 to use the frame and buffer of W, but right now it doesn't. */
6401 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6403 XSETFRAME (frame
, f
);
6404 XSETFASTINT (position
, pos
);
6407 if (pos
< region_beg
&& region_beg
< endpos
)
6408 endpos
= region_beg
;
6410 /* Get the `face' or `mouse_face' text property at POS, and
6411 determine the next position at which the property changes. */
6412 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6413 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6414 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6416 endpos
= XINT (end
);
6420 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6422 /* Optimize common cases where we can use the default face. */
6424 && !(pos
>= region_beg
&& pos
< region_end
))
6425 return DEFAULT_FACE_ID
;
6427 /* Begin with attributes from the default face. */
6428 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6430 /* Merge in attributes specified via text properties. */
6432 merge_face_ref (f
, prop
, attrs
, 1, 0);
6434 /* If in the region, merge in the region face. */
6435 if (pos
>= region_beg
&& pos
< region_end
)
6437 merge_named_face (f
, Qregion
, attrs
, 0);
6439 if (region_end
< endpos
)
6440 endpos
= region_end
;
6445 /* Look up a realized face with the given face attributes,
6446 or realize a new one for ASCII characters. */
6447 return lookup_face (f
, attrs
);
6451 /* Compute the face at character position POS in Lisp string STRING on
6452 window W, for ASCII characters.
6454 If STRING is an overlay string, it comes from position BUFPOS in
6455 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6456 not an overlay string. W must display the current buffer.
6457 REGION_BEG and REGION_END give the start and end positions of the
6458 region; both are -1 if no region is visible.
6460 BASE_FACE_ID is the id of a face to merge with. For strings coming
6461 from overlays or the `display' property it is the face at BUFPOS.
6463 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6465 Set *ENDPTR to the next position where to check for faces in
6466 STRING; -1 if the face is constant from POS to the end of the
6469 Value is the id of the face to use. The face returned is suitable
6470 for displaying ASCII characters. */
6473 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6474 region_end
, endptr
, base_face_id
, mouse_p
)
6477 EMACS_INT pos
, bufpos
;
6478 EMACS_INT region_beg
, region_end
;
6480 enum face_id base_face_id
;
6483 Lisp_Object prop
, position
, end
, limit
;
6484 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6485 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6486 struct face
*base_face
;
6487 int multibyte_p
= STRING_MULTIBYTE (string
);
6488 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6490 /* Get the value of the face property at the current position within
6491 STRING. Value is nil if there is no face property. */
6492 XSETFASTINT (position
, pos
);
6493 prop
= Fget_text_property (position
, prop_name
, string
);
6495 /* Get the next position at which to check for faces. Value of end
6496 is nil if face is constant all the way to the end of the string.
6497 Otherwise it is a string position where to check faces next.
6498 Limit is the maximum position up to which to check for property
6499 changes in Fnext_single_property_change. Strings are usually
6500 short, so set the limit to the end of the string. */
6501 XSETFASTINT (limit
, SCHARS (string
));
6502 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6504 *endptr
= XFASTINT (end
);
6508 base_face
= FACE_FROM_ID (f
, base_face_id
);
6509 xassert (base_face
);
6511 /* Optimize the default case that there is no face property and we
6512 are not in the region. */
6514 && (base_face_id
!= DEFAULT_FACE_ID
6515 /* BUFPOS <= 0 means STRING is not an overlay string, so
6516 that the region doesn't have to be taken into account. */
6518 || bufpos
< region_beg
6519 || bufpos
>= region_end
)
6521 /* We can't realize faces for different charsets differently
6522 if we don't have fonts, so we can stop here if not working
6523 on a window-system frame. */
6524 || !FRAME_WINDOW_P (f
)
6525 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6526 return base_face
->id
;
6528 /* Begin with attributes from the base face. */
6529 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6531 /* Merge in attributes specified via text properties. */
6533 merge_face_ref (f
, prop
, attrs
, 1, 0);
6535 /* If in the region, merge in the region face. */
6537 && bufpos
>= region_beg
6538 && bufpos
< region_end
)
6539 merge_named_face (f
, Qregion
, attrs
, 0);
6541 /* Look up a realized face with the given face attributes,
6542 or realize a new one for ASCII characters. */
6543 return lookup_face (f
, attrs
);
6547 /* Merge a face into a realized face.
6549 F is frame where faces are (to be) realized.
6551 FACE_NAME is named face to merge.
6553 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6555 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6557 BASE_FACE_ID is realized face to merge into.
6563 merge_faces (f
, face_name
, face_id
, base_face_id
)
6565 Lisp_Object face_name
;
6566 int face_id
, base_face_id
;
6568 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6569 struct face
*base_face
;
6571 base_face
= FACE_FROM_ID (f
, base_face_id
);
6573 return base_face_id
;
6575 if (EQ (face_name
, Qt
))
6577 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6578 return base_face_id
;
6579 face_name
= lface_id_to_name
[face_id
];
6580 /* When called during make-frame, lookup_derived_face may fail
6581 if the faces are uninitialized. Don't signal an error. */
6582 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 0);
6583 return (face_id
>= 0 ? face_id
: base_face_id
);
6586 /* Begin with attributes from the base face. */
6587 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6589 if (!NILP (face_name
))
6591 if (!merge_named_face (f
, face_name
, attrs
, 0))
6592 return base_face_id
;
6598 return base_face_id
;
6599 face
= FACE_FROM_ID (f
, face_id
);
6601 return base_face_id
;
6602 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6605 /* Look up a realized face with the given face attributes,
6606 or realize a new one for ASCII characters. */
6607 return lookup_face (f
, attrs
);
6612 #ifndef HAVE_X_WINDOWS
6613 DEFUN ("x-load-color-file", Fx_load_color_file
,
6614 Sx_load_color_file
, 1, 1, 0,
6615 doc
: /* Create an alist of color entries from an external file.
6617 The file should define one named RGB color per line like so:
6619 where R,G,B are numbers between 0 and 255 and name is an arbitrary string. */)
6621 Lisp_Object filename
;
6624 Lisp_Object cmap
= Qnil
;
6625 Lisp_Object abspath
;
6627 CHECK_STRING (filename
);
6628 abspath
= Fexpand_file_name (filename
, Qnil
);
6630 fp
= fopen (SDATA (abspath
), "rt");
6634 int red
, green
, blue
;
6639 while (fgets (buf
, sizeof (buf
), fp
) != NULL
) {
6640 if (sscanf (buf
, "%u %u %u %n", &red
, &green
, &blue
, &num
) == 3)
6642 char *name
= buf
+ num
;
6643 num
= strlen (name
) - 1;
6644 if (num
>= 0 && name
[num
] == '\n')
6646 cmap
= Fcons (Fcons (build_string (name
),
6648 make_number (RGB (red
, green
, blue
))),
6650 make_number ((red
<< 16) | (green
<< 8) | blue
)),
6665 /***********************************************************************
6667 ***********************************************************************/
6671 /* Print the contents of the realized face FACE to stderr. */
6674 dump_realized_face (face
)
6677 fprintf (stderr
, "ID: %d\n", face
->id
);
6678 #ifdef HAVE_X_WINDOWS
6679 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6681 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6683 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6684 fprintf (stderr
, "background: 0x%lx (%s)\n",
6686 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6688 fprintf (stderr
, "font_name: %s (%s)\n",
6689 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6690 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6691 #ifdef HAVE_X_WINDOWS
6692 fprintf (stderr
, "font = %p\n", face
->font
);
6694 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6695 fprintf (stderr
, "underline: %d (%s)\n",
6697 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6698 fprintf (stderr
, "hash: %d\n", face
->hash
);
6702 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6710 fprintf (stderr
, "font selection order: ");
6711 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6712 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6713 fprintf (stderr
, "\n");
6715 fprintf (stderr
, "alternative fonts: ");
6716 debug_print (Vface_alternative_font_family_alist
);
6717 fprintf (stderr
, "\n");
6719 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6720 Fdump_face (make_number (i
));
6726 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6728 error ("Not a valid face");
6729 dump_realized_face (face
);
6736 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6737 0, 0, 0, doc
: /* */)
6740 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6741 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6742 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6746 #endif /* GLYPH_DEBUG != 0 */
6750 /***********************************************************************
6752 ***********************************************************************/
6757 Qface
= intern_c_string ("face");
6759 Qface_no_inherit
= intern_c_string ("face-no-inherit");
6760 staticpro (&Qface_no_inherit
);
6761 Qbitmap_spec_p
= intern_c_string ("bitmap-spec-p");
6762 staticpro (&Qbitmap_spec_p
);
6763 Qframe_set_background_mode
= intern_c_string ("frame-set-background-mode");
6764 staticpro (&Qframe_set_background_mode
);
6766 /* Lisp face attribute keywords. */
6767 QCfamily
= intern_c_string (":family");
6768 staticpro (&QCfamily
);
6769 QCheight
= intern_c_string (":height");
6770 staticpro (&QCheight
);
6771 QCweight
= intern_c_string (":weight");
6772 staticpro (&QCweight
);
6773 QCslant
= intern_c_string (":slant");
6774 staticpro (&QCslant
);
6775 QCunderline
= intern_c_string (":underline");
6776 staticpro (&QCunderline
);
6777 QCinverse_video
= intern_c_string (":inverse-video");
6778 staticpro (&QCinverse_video
);
6779 QCreverse_video
= intern_c_string (":reverse-video");
6780 staticpro (&QCreverse_video
);
6781 QCforeground
= intern_c_string (":foreground");
6782 staticpro (&QCforeground
);
6783 QCbackground
= intern_c_string (":background");
6784 staticpro (&QCbackground
);
6785 QCstipple
= intern_c_string (":stipple");
6786 staticpro (&QCstipple
);
6787 QCwidth
= intern_c_string (":width");
6788 staticpro (&QCwidth
);
6789 QCfont
= intern_c_string (":font");
6790 staticpro (&QCfont
);
6791 QCfontset
= intern_c_string (":fontset");
6792 staticpro (&QCfontset
);
6793 QCbold
= intern_c_string (":bold");
6794 staticpro (&QCbold
);
6795 QCitalic
= intern_c_string (":italic");
6796 staticpro (&QCitalic
);
6797 QCoverline
= intern_c_string (":overline");
6798 staticpro (&QCoverline
);
6799 QCstrike_through
= intern_c_string (":strike-through");
6800 staticpro (&QCstrike_through
);
6801 QCbox
= intern_c_string (":box");
6803 QCinherit
= intern_c_string (":inherit");
6804 staticpro (&QCinherit
);
6806 /* Symbols used for Lisp face attribute values. */
6807 QCcolor
= intern_c_string (":color");
6808 staticpro (&QCcolor
);
6809 QCline_width
= intern_c_string (":line-width");
6810 staticpro (&QCline_width
);
6811 QCstyle
= intern_c_string (":style");
6812 staticpro (&QCstyle
);
6813 Qreleased_button
= intern_c_string ("released-button");
6814 staticpro (&Qreleased_button
);
6815 Qpressed_button
= intern_c_string ("pressed-button");
6816 staticpro (&Qpressed_button
);
6817 Qnormal
= intern_c_string ("normal");
6818 staticpro (&Qnormal
);
6819 Qultra_light
= intern_c_string ("ultra-light");
6820 staticpro (&Qultra_light
);
6821 Qextra_light
= intern_c_string ("extra-light");
6822 staticpro (&Qextra_light
);
6823 Qlight
= intern_c_string ("light");
6824 staticpro (&Qlight
);
6825 Qsemi_light
= intern_c_string ("semi-light");
6826 staticpro (&Qsemi_light
);
6827 Qsemi_bold
= intern_c_string ("semi-bold");
6828 staticpro (&Qsemi_bold
);
6829 Qbold
= intern_c_string ("bold");
6831 Qextra_bold
= intern_c_string ("extra-bold");
6832 staticpro (&Qextra_bold
);
6833 Qultra_bold
= intern_c_string ("ultra-bold");
6834 staticpro (&Qultra_bold
);
6835 Qoblique
= intern_c_string ("oblique");
6836 staticpro (&Qoblique
);
6837 Qitalic
= intern_c_string ("italic");
6838 staticpro (&Qitalic
);
6839 Qreverse_oblique
= intern_c_string ("reverse-oblique");
6840 staticpro (&Qreverse_oblique
);
6841 Qreverse_italic
= intern_c_string ("reverse-italic");
6842 staticpro (&Qreverse_italic
);
6843 Qultra_condensed
= intern_c_string ("ultra-condensed");
6844 staticpro (&Qultra_condensed
);
6845 Qextra_condensed
= intern_c_string ("extra-condensed");
6846 staticpro (&Qextra_condensed
);
6847 Qcondensed
= intern_c_string ("condensed");
6848 staticpro (&Qcondensed
);
6849 Qsemi_condensed
= intern_c_string ("semi-condensed");
6850 staticpro (&Qsemi_condensed
);
6851 Qsemi_expanded
= intern_c_string ("semi-expanded");
6852 staticpro (&Qsemi_expanded
);
6853 Qexpanded
= intern_c_string ("expanded");
6854 staticpro (&Qexpanded
);
6855 Qextra_expanded
= intern_c_string ("extra-expanded");
6856 staticpro (&Qextra_expanded
);
6857 Qultra_expanded
= intern_c_string ("ultra-expanded");
6858 staticpro (&Qultra_expanded
);
6859 Qbackground_color
= intern_c_string ("background-color");
6860 staticpro (&Qbackground_color
);
6861 Qforeground_color
= intern_c_string ("foreground-color");
6862 staticpro (&Qforeground_color
);
6863 Qunspecified
= intern_c_string ("unspecified");
6864 staticpro (&Qunspecified
);
6865 Qignore_defface
= intern_c_string (":ignore-defface");
6866 staticpro (&Qignore_defface
);
6868 Qface_alias
= intern_c_string ("face-alias");
6869 staticpro (&Qface_alias
);
6870 Qdefault
= intern_c_string ("default");
6871 staticpro (&Qdefault
);
6872 Qtool_bar
= intern_c_string ("tool-bar");
6873 staticpro (&Qtool_bar
);
6874 Qregion
= intern_c_string ("region");
6875 staticpro (&Qregion
);
6876 Qfringe
= intern_c_string ("fringe");
6877 staticpro (&Qfringe
);
6878 Qheader_line
= intern_c_string ("header-line");
6879 staticpro (&Qheader_line
);
6880 Qscroll_bar
= intern_c_string ("scroll-bar");
6881 staticpro (&Qscroll_bar
);
6882 Qmenu
= intern_c_string ("menu");
6884 Qcursor
= intern_c_string ("cursor");
6885 staticpro (&Qcursor
);
6886 Qborder
= intern_c_string ("border");
6887 staticpro (&Qborder
);
6888 Qmouse
= intern_c_string ("mouse");
6889 staticpro (&Qmouse
);
6890 Qmode_line_inactive
= intern_c_string ("mode-line-inactive");
6891 staticpro (&Qmode_line_inactive
);
6892 Qvertical_border
= intern_c_string ("vertical-border");
6893 staticpro (&Qvertical_border
);
6894 Qtty_color_desc
= intern_c_string ("tty-color-desc");
6895 staticpro (&Qtty_color_desc
);
6896 Qtty_color_standard_values
= intern_c_string ("tty-color-standard-values");
6897 staticpro (&Qtty_color_standard_values
);
6898 Qtty_color_by_index
= intern_c_string ("tty-color-by-index");
6899 staticpro (&Qtty_color_by_index
);
6900 Qtty_color_alist
= intern_c_string ("tty-color-alist");
6901 staticpro (&Qtty_color_alist
);
6902 Qscalable_fonts_allowed
= intern_c_string ("scalable-fonts-allowed");
6903 staticpro (&Qscalable_fonts_allowed
);
6905 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6906 staticpro (&Vparam_value_alist
);
6907 Vface_alternative_font_family_alist
= Qnil
;
6908 staticpro (&Vface_alternative_font_family_alist
);
6909 Vface_alternative_font_registry_alist
= Qnil
;
6910 staticpro (&Vface_alternative_font_registry_alist
);
6912 defsubr (&Sinternal_make_lisp_face
);
6913 defsubr (&Sinternal_lisp_face_p
);
6914 defsubr (&Sinternal_set_lisp_face_attribute
);
6915 #ifdef HAVE_WINDOW_SYSTEM
6916 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6918 defsubr (&Scolor_gray_p
);
6919 defsubr (&Scolor_supported_p
);
6920 #ifndef HAVE_X_WINDOWS
6921 defsubr (&Sx_load_color_file
);
6923 defsubr (&Sface_attribute_relative_p
);
6924 defsubr (&Smerge_face_attribute
);
6925 defsubr (&Sinternal_get_lisp_face_attribute
);
6926 defsubr (&Sinternal_lisp_face_attribute_values
);
6927 defsubr (&Sinternal_lisp_face_equal_p
);
6928 defsubr (&Sinternal_lisp_face_empty_p
);
6929 defsubr (&Sinternal_copy_lisp_face
);
6930 defsubr (&Sinternal_merge_in_global_face
);
6931 defsubr (&Sface_font
);
6932 defsubr (&Sframe_face_alist
);
6933 defsubr (&Sdisplay_supports_face_attributes_p
);
6934 defsubr (&Scolor_distance
);
6935 defsubr (&Sinternal_set_font_selection_order
);
6936 defsubr (&Sinternal_set_alternative_font_family_alist
);
6937 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6938 defsubr (&Sface_attributes_as_vector
);
6940 defsubr (&Sdump_face
);
6941 defsubr (&Sshow_face_resources
);
6942 #endif /* GLYPH_DEBUG */
6943 defsubr (&Sclear_face_cache
);
6944 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6946 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6947 defsubr (&Sdump_colors
);
6950 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6951 doc
: /* *Limit for font matching.
6952 If an integer > 0, font matching functions won't load more than
6953 that number of fonts when searching for a matching font. */);
6954 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6956 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6957 doc
: /* List of global face definitions (for internal use only.) */);
6958 Vface_new_frame_defaults
= Qnil
;
6960 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6961 doc
: /* *Default stipple pattern used on monochrome displays.
6962 This stipple pattern is used on monochrome displays
6963 instead of shades of gray for a face background color.
6964 See `set-face-stipple' for possible values for this variable. */);
6965 Vface_default_stipple
= make_pure_c_string ("gray3");
6967 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
6968 doc
: /* An alist of defined terminal colors and their RGB values. */);
6969 Vtty_defined_color_alist
= Qnil
;
6971 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6972 doc
: /* Allowed scalable fonts.
6973 A value of nil means don't allow any scalable fonts.
6974 A value of t means allow any scalable font.
6975 Otherwise, value must be a list of regular expressions. A font may be
6976 scaled if its name matches a regular expression in the list.
6977 Note that if value is nil, a scalable font might still be used, if no
6978 other font of the appropriate family and registry is available. */);
6979 Vscalable_fonts_allowed
= Qnil
;
6981 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
6982 doc
: /* List of ignored fonts.
6983 Each element is a regular expression that matches names of fonts to
6985 Vface_ignored_fonts
= Qnil
;
6987 DEFVAR_LISP ("face-remapping-alist", &Vface_remapping_alist
,
6988 doc
: /* Alist of face remappings.
6989 Each element is of the form:
6991 (FACE REPLACEMENT...),
6993 which causes display of the face FACE to use REPLACEMENT... instead.
6994 REPLACEMENT... is interpreted the same way the value of a `face' text
6995 property is: it may be (1) A face name, (2) A list of face names, (3) A
6996 property-list of face attribute/value pairs, or (4) A list of face names
6997 intermixed with lists containing face attribute/value pairs.
6999 Multiple entries in REPLACEMENT... are merged together to form the final
7000 result, with faces or attributes earlier in the list taking precedence
7001 over those that are later.
7003 Face-name remapping cycles are suppressed; recursive references use the
7004 underlying face instead of the remapped face. So a remapping of the form:
7006 (FACE EXTRA-FACE... FACE)
7010 (FACE (FACE-ATTR VAL ...) FACE)
7012 will cause EXTRA-FACE... or (FACE-ATTR VAL ...) to be _merged_ with the
7013 existing definition of FACE. Note that for the default face, this isn't
7014 necessary, as every face inherits from the default face.
7016 Making this variable buffer-local is a good way to allow buffer-specific
7017 face definitions. For instance, the mode my-mode could define a face
7018 `my-mode-default', and then in the mode setup function, do:
7020 (set (make-local-variable 'face-remapping-alist)
7021 '((default my-mode-default)))). */);
7022 Vface_remapping_alist
= Qnil
;
7024 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7025 doc
: /* Alist of fonts vs the rescaling factors.
7026 Each element is a cons (FONT-PATTERN . RESCALE-RATIO), where
7027 FONT-PATTERN is a font-spec or a regular expression matching a font name, and
7028 RESCALE-RATIO is a floating point number to specify how much larger
7029 \(or smaller) font we should use. For instance, if a face requests
7030 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7031 Vface_font_rescale_alist
= Qnil
;
7033 #ifdef HAVE_WINDOW_SYSTEM
7034 defsubr (&Sbitmap_spec_p
);
7035 defsubr (&Sx_list_fonts
);
7036 defsubr (&Sinternal_face_x_get_resource
);
7037 defsubr (&Sx_family_fonts
);
7041 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
7042 (do not change this comment) */