1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
3 2005, 2006, 2007, 2008 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, or (at your option)
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; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. 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 */
209 #include "character.h"
211 #include "keyboard.h"
213 #include "termhooks.h"
215 #ifdef HAVE_X_WINDOWS
219 #include <Xm/XmStrDefs.h>
220 #endif /* USE_MOTIF */
221 #endif /* HAVE_X_WINDOWS */
230 /* Redefine X specifics to W32 equivalents to avoid cluttering the
231 code with #ifdef blocks. */
232 #undef FRAME_X_DISPLAY_INFO
233 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
234 #define x_display_info w32_display_info
235 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
236 #define check_x check_w32
237 #define x_list_fonts w32_list_fonts
238 #define GCGraphicsExposures 0
239 #endif /* WINDOWSNT */
243 #define x_display_info mac_display_info
244 #define check_x check_mac
248 #include "dispextern.h"
249 #include "blockinput.h"
251 #include "intervals.h"
252 #include "termchar.h"
254 #ifdef HAVE_WINDOW_SYSTEM
257 #endif /* HAVE_WINDOW_SYSTEM */
259 #ifdef HAVE_X_WINDOWS
261 /* Compensate for a bug in Xos.h on some systems, on which it requires
262 time.h. On some such systems, Xos.h tries to redefine struct
263 timeval and struct timezone if USG is #defined while it is
266 #ifdef XOS_NEEDS_TIME_H
272 #else /* not XOS_NEEDS_TIME_H */
274 #endif /* not XOS_NEEDS_TIME_H */
276 #endif /* HAVE_X_WINDOWS */
280 /* Number of pt per inch (from the TeXbook). */
282 #define PT_PER_INCH 72.27
284 /* Non-zero if face attribute ATTR is unspecified. */
286 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
288 /* Non-zero if face attribute ATTR is `ignore-defface'. */
290 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)
292 /* Value is the number of elements of VECTOR. */
294 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
296 /* Make a copy of string S on the stack using alloca. Value is a pointer
299 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
301 /* Make a copy of the contents of Lisp string S on the stack using
302 alloca. Value is a pointer to the copy. */
304 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
306 /* Size of hash table of realized faces in face caches (should be a
309 #define FACE_CACHE_BUCKETS_SIZE 1001
311 /* Keyword symbols used for face attribute names. */
313 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
314 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
315 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
316 Lisp_Object QCreverse_video
;
317 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
318 Lisp_Object QCfontset
;
320 /* Keywords symbols used for font properties. */
321 extern Lisp_Object QCfoundry
, QCadstyle
, QCregistry
;
322 extern Lisp_Object QCspacing
, QCsize
, QCavgwidth
;
323 extern Lisp_Object Qp
;
325 /* Symbols used for attribute values. */
327 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
328 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
329 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
330 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
331 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
332 Lisp_Object Qultra_expanded
;
333 Lisp_Object Qreleased_button
, Qpressed_button
;
334 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
335 Lisp_Object Qunspecified
;
336 Lisp_Object Qignore_defface
;
338 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
340 /* The name of the function to call when the background of the frame
341 has changed, frame_set_background_mode. */
343 Lisp_Object Qframe_set_background_mode
;
345 /* Names of basic faces. */
347 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
348 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
349 Lisp_Object Qmode_line_inactive
, Qvertical_border
;
350 extern Lisp_Object Qmode_line
;
352 /* The symbol `face-alias'. A symbols having that property is an
353 alias for another face. Value of the property is the name of
356 Lisp_Object Qface_alias
;
358 extern Lisp_Object Qcircular_list
;
360 /* Default stipple pattern used on monochrome displays. This stipple
361 pattern is used on monochrome displays instead of shades of gray
362 for a face background color. See `set-face-stipple' for possible
363 values for this variable. */
365 Lisp_Object Vface_default_stipple
;
367 /* Alist of alternative font families. Each element is of the form
368 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
369 try FAMILY1, then FAMILY2, ... */
371 Lisp_Object Vface_alternative_font_family_alist
;
373 /* Alist of alternative font registries. Each element is of the form
374 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
375 loaded, try REGISTRY1, then REGISTRY2, ... */
377 Lisp_Object Vface_alternative_font_registry_alist
;
379 /* Allowed scalable fonts. A value of nil means don't allow any
380 scalable fonts. A value of t means allow the use of any scalable
381 font. Otherwise, value must be a list of regular expressions. A
382 font may be scaled if its name matches a regular expression in the
385 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
387 /* List of regular expressions that matches names of fonts to ignore. */
389 Lisp_Object Vface_ignored_fonts
;
391 /* Alist of font name patterns vs the rescaling factor. */
393 Lisp_Object Vface_font_rescale_alist
;
395 /* Maximum number of fonts to consider in font_list. If not an
396 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
398 Lisp_Object Vfont_list_limit
;
399 #define DEFAULT_FONT_LIST_LIMIT 100
401 /* The symbols `foreground-color' and `background-color' which can be
402 used as part of a `face' property. This is for compatibility with
405 Lisp_Object Qforeground_color
, Qbackground_color
;
407 /* The symbols `face' and `mouse-face' used as text properties. */
410 extern Lisp_Object Qmouse_face
;
412 /* Property for basic faces which other faces cannot inherit. */
414 Lisp_Object Qface_no_inherit
;
416 /* Error symbol for wrong_type_argument in load_pixmap. */
418 Lisp_Object Qbitmap_spec_p
;
420 /* Alist of global face definitions. Each element is of the form
421 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
422 is a Lisp vector of face attributes. These faces are used
423 to initialize faces for new frames. */
425 Lisp_Object Vface_new_frame_defaults
;
427 /* The next ID to assign to Lisp faces. */
429 static int next_lface_id
;
431 /* A vector mapping Lisp face Id's to face names. */
433 static Lisp_Object
*lface_id_to_name
;
434 static int lface_id_to_name_size
;
436 /* TTY color-related functions (defined in tty-colors.el). */
438 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
440 /* The name of the function used to compute colors on TTYs. */
442 Lisp_Object Qtty_color_alist
;
444 /* An alist of defined terminal colors and their RGB values. */
446 Lisp_Object Vtty_defined_color_alist
;
448 /* Counter for calls to clear_face_cache. If this counter reaches
449 CLEAR_FONT_TABLE_COUNT, and a frame has more than
450 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
452 static int clear_font_table_count
;
453 #define CLEAR_FONT_TABLE_COUNT 100
454 #define CLEAR_FONT_TABLE_NFONTS 10
456 /* Non-zero means face attributes have been changed since the last
457 redisplay. Used in redisplay_internal. */
459 int face_change_count
;
461 /* Non-zero means don't display bold text if a face's foreground
462 and background colors are the inverse of the default colors of the
463 display. This is a kluge to suppress `bold black' foreground text
464 which is hard to read on an LCD monitor. */
466 int tty_suppress_bold_inverse_default_colors_p
;
468 /* A list of the form `((x . y))' used to avoid consing in
469 Finternal_set_lisp_face_attribute. */
471 static Lisp_Object Vparam_value_alist
;
473 /* The total number of colors currently allocated. */
476 static int ncolors_allocated
;
477 static int npixmaps_allocated
;
481 /* Non-zero means the definition of the `menu' face for new frames has
484 int menu_face_changed_default
;
487 /* Function prototypes. */
491 struct named_merge_point
;
493 static void map_tty_color
P_ ((struct frame
*, struct face
*,
494 enum lface_attribute_index
, int *));
495 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
, int));
496 static int may_use_scalable_font_p
P_ ((const char *));
497 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
498 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
500 static int x_face_list_fonts
P_ ((struct frame
*, char *,
501 struct font_name
**, int, int));
502 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
503 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
504 static unsigned char *xstrlwr
P_ ((unsigned char *));
505 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
506 static void load_face_font
P_ ((struct frame
*, struct face
*));
507 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
508 static void free_face_colors
P_ ((struct frame
*, struct face
*));
509 static int face_color_gray_p
P_ ((struct frame
*, char *));
510 static char *build_font_name
P_ ((struct font_name
*));
511 static void free_font_names
P_ ((struct font_name
*, int));
512 static int sorted_font_list
P_ ((struct frame
*, char *,
513 int (*cmpfn
) P_ ((const void *, const void *)),
514 struct font_name
**));
515 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
516 Lisp_Object
, struct font_name
**));
517 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
518 Lisp_Object
, struct font_name
**));
519 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
520 Lisp_Object
, Lisp_Object
, struct font_name
**));
521 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
522 Lisp_Object
, struct font_name
**));
523 static int cmp_font_names
P_ ((const void *, const void *));
524 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
526 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, Lisp_Object
,
528 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
529 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
530 static int realize_basic_faces
P_ ((struct frame
*));
531 static int realize_default_face
P_ ((struct frame
*));
532 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
533 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
534 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
535 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
536 static unsigned lface_hash
P_ ((Lisp_Object
*));
537 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
538 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
539 static void clear_face_gcs
P_ ((struct face_cache
*));
540 static void free_face_cache
P_ ((struct face_cache
*));
541 static int face_fontset
P_ ((Lisp_Object
*));
542 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
543 struct named_merge_point
*));
544 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
545 int, struct named_merge_point
*));
546 static int set_lface_from_font
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
548 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
549 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
550 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
551 struct font_name
*, int, int, int *));
552 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
553 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
555 #ifdef HAVE_WINDOW_SYSTEM
557 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
558 static void x_free_gc
P_ ((struct frame
*, GC
));
561 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
562 #endif /* WINDOWSNT */
565 static void x_update_menu_appearance
P_ ((struct frame
*));
567 extern void free_frame_menubar
P_ ((struct frame
*));
568 #endif /* USE_X_TOOLKIT */
570 #endif /* HAVE_WINDOW_SYSTEM */
573 /***********************************************************************
575 ***********************************************************************/
577 #ifdef HAVE_X_WINDOWS
579 #ifdef DEBUG_X_COLORS
581 /* The following is a poor mans infrastructure for debugging X color
582 allocation problems on displays with PseudoColor-8. Some X servers
583 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
584 color reference counts completely so that they don't signal an
585 error when a color is freed whose reference count is already 0.
586 Other X servers do. To help me debug this, the following code
587 implements a simple reference counting schema of its own, for a
588 single display/screen. --gerd. */
590 /* Reference counts for pixel colors. */
592 int color_count
[256];
594 /* Register color PIXEL as allocated. */
597 register_color (pixel
)
600 xassert (pixel
< 256);
601 ++color_count
[pixel
];
605 /* Register color PIXEL as deallocated. */
608 unregister_color (pixel
)
611 xassert (pixel
< 256);
612 if (color_count
[pixel
] > 0)
613 --color_count
[pixel
];
619 /* Register N colors from PIXELS as deallocated. */
622 unregister_colors (pixels
, n
)
623 unsigned long *pixels
;
627 for (i
= 0; i
< n
; ++i
)
628 unregister_color (pixels
[i
]);
632 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
633 doc
: /* Dump currently allocated colors to stderr. */)
638 fputc ('\n', stderr
);
640 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
643 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
646 fputc ('\n', stderr
);
648 fputc ('\t', stderr
);
652 fputc ('\n', stderr
);
656 #endif /* DEBUG_X_COLORS */
659 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
660 color values. Interrupt input must be blocked when this function
664 x_free_colors (f
, pixels
, npixels
)
666 unsigned long *pixels
;
669 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
671 /* If display has an immutable color map, freeing colors is not
672 necessary and some servers don't allow it. So don't do it. */
673 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
675 #ifdef DEBUG_X_COLORS
676 unregister_colors (pixels
, npixels
);
678 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
684 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
685 color values. Interrupt input must be blocked when this function
689 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
693 unsigned long *pixels
;
696 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
697 int class = dpyinfo
->visual
->class;
699 /* If display has an immutable color map, freeing colors is not
700 necessary and some servers don't allow it. So don't do it. */
701 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
703 #ifdef DEBUG_X_COLORS
704 unregister_colors (pixels
, npixels
);
706 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
711 /* Create and return a GC for use on frame F. GC values and mask
712 are given by XGCV and MASK. */
715 x_create_gc (f
, mask
, xgcv
)
722 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
729 /* Free GC which was used on frame F. */
736 eassert (interrupt_input_blocked
);
737 IF_DEBUG (xassert (--ngcs
>= 0));
738 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
741 #endif /* HAVE_X_WINDOWS */
744 /* W32 emulation of GCs */
747 x_create_gc (f
, mask
, xgcv
)
754 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
761 /* Free GC which was used on frame F. */
768 IF_DEBUG (xassert (--ngcs
>= 0));
772 #endif /* WINDOWSNT */
775 /* Mac OS emulation of GCs */
778 x_create_gc (f
, mask
, xgcv
)
785 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
796 eassert (interrupt_input_blocked
);
797 IF_DEBUG (xassert (--ngcs
>= 0));
798 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
803 /* Like stricmp. Used to compare parts of font names which are in
808 const unsigned char *s1
, *s2
;
812 unsigned char c1
= tolower (*s1
);
813 unsigned char c2
= tolower (*s2
);
815 return c1
< c2
? -1 : 1;
820 return *s2
== 0 ? 0 : -1;
825 /* Like strlwr, which might not always be available. */
827 static unsigned char *
831 unsigned char *p
= s
;
834 /* On Mac OS X 10.3, tolower also converts non-ASCII characters
843 /* If FRAME is nil, return a pointer to the selected frame.
844 Otherwise, check that FRAME is a live frame, and return a pointer
845 to it. NPARAM is the parameter number of FRAME, for
846 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
847 Lisp function definitions. */
849 static INLINE
struct frame
*
850 frame_or_selected_frame (frame
, nparam
)
855 frame
= selected_frame
;
857 CHECK_LIVE_FRAME (frame
);
858 return XFRAME (frame
);
862 /***********************************************************************
864 ***********************************************************************/
866 /* Initialize face cache and basic faces for frame F. */
872 /* Make a face cache, if F doesn't have one. */
873 if (FRAME_FACE_CACHE (f
) == NULL
)
874 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
876 #ifdef HAVE_WINDOW_SYSTEM
877 /* Make the image cache. */
878 if (FRAME_WINDOW_P (f
))
880 if (FRAME_IMAGE_CACHE (f
) == NULL
)
881 /* Is that ever possible?? --Stef */
882 FRAME_IMAGE_CACHE (f
) = make_image_cache ();
883 ++FRAME_IMAGE_CACHE (f
)->refcount
;
885 #endif /* HAVE_WINDOW_SYSTEM */
887 /* Realize basic faces. Must have enough information in frame
888 parameters to realize basic faces at this point. */
889 #ifdef HAVE_X_WINDOWS
890 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
893 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
896 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
898 if (!realize_basic_faces (f
))
903 /* Free face cache of frame F. Called from Fdelete_frame. */
909 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
913 free_face_cache (face_cache
);
914 FRAME_FACE_CACHE (f
) = NULL
;
917 #ifdef HAVE_WINDOW_SYSTEM
918 if (FRAME_WINDOW_P (f
))
920 struct image_cache
*image_cache
= FRAME_IMAGE_CACHE (f
);
923 --image_cache
->refcount
;
924 if (image_cache
->refcount
== 0)
925 free_image_cache (f
);
928 #endif /* HAVE_WINDOW_SYSTEM */
932 /* Clear face caches, and recompute basic faces for frame F. Call
933 this after changing frame parameters on which those faces depend,
934 or when realized faces have been freed due to changing attributes
938 recompute_basic_faces (f
)
941 if (FRAME_FACE_CACHE (f
))
943 clear_face_cache (0);
944 if (!realize_basic_faces (f
))
950 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
951 try to free unused fonts, too. */
954 clear_face_cache (clear_fonts_p
)
957 #ifdef HAVE_WINDOW_SYSTEM
958 Lisp_Object tail
, frame
;
962 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
964 struct x_display_info
*dpyinfo
;
967 /* Not yet implemented. */
968 clear_font_cache (frame
);
972 /* From time to time see if we can unload some fonts. This also
973 frees all realized faces on all frames. Fonts needed by
974 faces will be loaded again when faces are realized again. */
975 clear_font_table_count
= 0;
977 FOR_EACH_FRAME (tail
, frame
)
979 struct frame
*f
= XFRAME (frame
);
980 if (FRAME_WINDOW_P (f
)
981 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
982 free_all_realized_faces (frame
);
987 /* Clear GCs of realized faces. */
988 FOR_EACH_FRAME (tail
, frame
)
991 if (FRAME_WINDOW_P (f
))
992 clear_face_gcs (FRAME_FACE_CACHE (f
));
994 clear_image_caches (Qnil
);
996 #endif /* HAVE_WINDOW_SYSTEM */
1000 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1001 doc
: /* Clear face caches on all frames.
1002 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1004 Lisp_Object thoroughly
;
1006 clear_face_cache (!NILP (thoroughly
));
1007 ++face_change_count
;
1008 ++windows_or_buffers_changed
;
1013 /***********************************************************************
1015 ***********************************************************************/
1017 #ifdef HAVE_WINDOW_SYSTEM
1019 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1020 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1021 A bitmap specification is either a string, a file name, or a list
1022 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1023 HEIGHT is its height, and DATA is a string containing the bits of
1024 the pixmap. Bits are stored row by row, each row occupies
1025 \(WIDTH + 7)/8 bytes. */)
1031 if (STRINGP (object
))
1032 /* If OBJECT is a string, it's a file name. */
1034 else if (CONSP (object
))
1036 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1037 HEIGHT must be integers > 0, and DATA must be string large
1038 enough to hold a bitmap of the specified size. */
1039 Lisp_Object width
, height
, data
;
1041 height
= width
= data
= Qnil
;
1045 width
= XCAR (object
);
1046 object
= XCDR (object
);
1049 height
= XCAR (object
);
1050 object
= XCDR (object
);
1052 data
= XCAR (object
);
1056 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1058 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1060 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1065 return pixmap_p
? Qt
: Qnil
;
1069 /* Load a bitmap according to NAME (which is either a file name or a
1070 pixmap spec) for use on frame F. Value is the bitmap_id (see
1071 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1072 bitmap cannot be loaded, display a message saying so, and return
1073 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1074 if these pointers are not null. */
1077 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1080 unsigned int *w_ptr
, *h_ptr
;
1087 CHECK_TYPE (!NILP (Fbitmap_spec_p (name
)), Qbitmap_spec_p
, name
);
1092 /* Decode a bitmap spec into a bitmap. */
1097 w
= XINT (Fcar (name
));
1098 h
= XINT (Fcar (Fcdr (name
)));
1099 bits
= Fcar (Fcdr (Fcdr (name
)));
1101 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1106 /* It must be a string -- a file name. */
1107 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1113 add_to_log ("Invalid or undefined bitmap `%s'", name
, Qnil
);
1124 ++npixmaps_allocated
;
1127 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1130 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1136 #endif /* HAVE_WINDOW_SYSTEM */
1140 /***********************************************************************
1142 ***********************************************************************/
1144 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1145 RGB_LIST should contain (at least) 3 lisp integers.
1146 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1149 parse_rgb_list (rgb_list
, color
)
1150 Lisp_Object rgb_list
;
1153 #define PARSE_RGB_LIST_FIELD(field) \
1154 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1156 color->field = XINT (XCAR (rgb_list)); \
1157 rgb_list = XCDR (rgb_list); \
1162 PARSE_RGB_LIST_FIELD (red
);
1163 PARSE_RGB_LIST_FIELD (green
);
1164 PARSE_RGB_LIST_FIELD (blue
);
1170 /* Lookup on frame F the color described by the lisp string COLOR.
1171 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1172 non-zero, then the `standard' definition of the same color is
1176 tty_lookup_color (f
, color
, tty_color
, std_color
)
1179 XColor
*tty_color
, *std_color
;
1181 Lisp_Object frame
, color_desc
;
1183 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1186 XSETFRAME (frame
, f
);
1188 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1189 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1193 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1196 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1198 rgb
= XCDR (XCDR (color_desc
));
1199 if (! parse_rgb_list (rgb
, tty_color
))
1202 /* Should we fill in STD_COLOR too? */
1205 /* Default STD_COLOR to the same as TTY_COLOR. */
1206 *std_color
= *tty_color
;
1208 /* Do a quick check to see if the returned descriptor is
1209 actually _exactly_ equal to COLOR, otherwise we have to
1210 lookup STD_COLOR separately. If it's impossible to lookup
1211 a standard color, we just give up and use TTY_COLOR. */
1212 if ((!STRINGP (XCAR (color_desc
))
1213 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1214 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1216 /* Look up STD_COLOR separately. */
1217 rgb
= call1 (Qtty_color_standard_values
, color
);
1218 if (! parse_rgb_list (rgb
, std_color
))
1225 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1226 /* We were called early during startup, and the colors are not
1227 yet set up in tty-defined-color-alist. Don't return a failure
1228 indication, since this produces the annoying "Unable to
1229 load color" messages in the *Messages* buffer. */
1232 /* tty-color-desc seems to have returned a bad value. */
1236 /* A version of defined_color for non-X frames. */
1239 tty_defined_color (f
, color_name
, color_def
, alloc
)
1248 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1250 color_def
->blue
= 0;
1251 color_def
->green
= 0;
1254 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1256 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1258 if (strcmp (color_name
, "unspecified-fg") == 0)
1259 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1260 else if (strcmp (color_name
, "unspecified-bg") == 0)
1261 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1264 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1271 /* Decide if color named COLOR_NAME is valid for the display
1272 associated with the frame F; if so, return the rgb values in
1273 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1275 This does the right thing for any type of frame. */
1278 defined_color (f
, color_name
, color_def
, alloc
)
1284 if (!FRAME_WINDOW_P (f
))
1285 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1286 #ifdef HAVE_X_WINDOWS
1287 else if (FRAME_X_P (f
))
1288 return x_defined_color (f
, color_name
, color_def
, alloc
);
1291 else if (FRAME_W32_P (f
))
1292 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1295 else if (FRAME_MAC_P (f
))
1296 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1303 /* Given the index IDX of a tty color on frame F, return its name, a
1307 tty_color_name (f
, idx
)
1311 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1314 Lisp_Object coldesc
;
1316 XSETFRAME (frame
, f
);
1317 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1319 if (!NILP (coldesc
))
1320 return XCAR (coldesc
);
1323 /* We can have an MSDOG frame under -nw for a short window of
1324 opportunity before internal_terminal_init is called. DTRT. */
1325 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1326 return msdos_stdcolor_name (idx
);
1329 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1330 return build_string (unspecified_fg
);
1331 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1332 return build_string (unspecified_bg
);
1334 return Qunspecified
;
1338 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1341 The criterion implemented here is not a terribly sophisticated one. */
1344 face_color_gray_p (f
, color_name
)
1351 if (defined_color (f
, color_name
, &color
, 0))
1352 gray_p
= (/* Any color sufficiently close to black counts as grey. */
1353 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1355 ((eabs (color
.red
- color
.green
)
1356 < max (color
.red
, color
.green
) / 20)
1357 && (eabs (color
.green
- color
.blue
)
1358 < max (color
.green
, color
.blue
) / 20)
1359 && (eabs (color
.blue
- color
.red
)
1360 < max (color
.blue
, color
.red
) / 20)));
1368 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1369 BACKGROUND_P non-zero means the color will be used as background
1373 face_color_supported_p (f
, color_name
, background_p
)
1381 XSETFRAME (frame
, f
);
1383 #ifdef HAVE_WINDOW_SYSTEM
1385 ? (!NILP (Fxw_display_color_p (frame
))
1386 || xstricmp (color_name
, "black") == 0
1387 || xstricmp (color_name
, "white") == 0
1389 && face_color_gray_p (f
, color_name
))
1390 || (!NILP (Fx_display_grayscale_p (frame
))
1391 && face_color_gray_p (f
, color_name
)))
1394 tty_defined_color (f
, color_name
, ¬_used
, 0);
1398 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1399 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1400 FRAME specifies the frame and thus the display for interpreting COLOR.
1401 If FRAME is nil or omitted, use the selected frame. */)
1403 Lisp_Object color
, frame
;
1407 CHECK_STRING (color
);
1409 frame
= selected_frame
;
1411 CHECK_FRAME (frame
);
1413 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1417 DEFUN ("color-supported-p", Fcolor_supported_p
,
1418 Scolor_supported_p
, 1, 3, 0,
1419 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1420 BACKGROUND-P non-nil means COLOR is used as a background.
1421 Otherwise, this function tells whether it can be used as a foreground.
1422 If FRAME is nil or omitted, use the selected frame.
1423 COLOR must be a valid color name. */)
1424 (color
, frame
, background_p
)
1425 Lisp_Object frame
, color
, background_p
;
1429 CHECK_STRING (color
);
1431 frame
= selected_frame
;
1433 CHECK_FRAME (frame
);
1435 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1441 /* Load color with name NAME for use by face FACE on frame F.
1442 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1443 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1444 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1445 pixel color. If color cannot be loaded, display a message, and
1446 return the foreground, background or underline color of F, but
1447 record that fact in flags of the face so that we don't try to free
1451 load_color (f
, face
, name
, target_index
)
1455 enum lface_attribute_index target_index
;
1459 xassert (STRINGP (name
));
1460 xassert (target_index
== LFACE_FOREGROUND_INDEX
1461 || target_index
== LFACE_BACKGROUND_INDEX
1462 || target_index
== LFACE_UNDERLINE_INDEX
1463 || target_index
== LFACE_OVERLINE_INDEX
1464 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1465 || target_index
== LFACE_BOX_INDEX
);
1467 /* if the color map is full, defined_color will return a best match
1468 to the values in an existing cell. */
1469 if (!defined_color (f
, SDATA (name
), &color
, 1))
1471 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1473 switch (target_index
)
1475 case LFACE_FOREGROUND_INDEX
:
1476 face
->foreground_defaulted_p
= 1;
1477 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1480 case LFACE_BACKGROUND_INDEX
:
1481 face
->background_defaulted_p
= 1;
1482 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1485 case LFACE_UNDERLINE_INDEX
:
1486 face
->underline_defaulted_p
= 1;
1487 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1490 case LFACE_OVERLINE_INDEX
:
1491 face
->overline_color_defaulted_p
= 1;
1492 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1495 case LFACE_STRIKE_THROUGH_INDEX
:
1496 face
->strike_through_color_defaulted_p
= 1;
1497 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1500 case LFACE_BOX_INDEX
:
1501 face
->box_color_defaulted_p
= 1;
1502 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1511 ++ncolors_allocated
;
1518 #ifdef HAVE_WINDOW_SYSTEM
1520 /* Load colors for face FACE which is used on frame F. Colors are
1521 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1522 of ATTRS. If the background color specified is not supported on F,
1523 try to emulate gray colors with a stipple from Vface_default_stipple. */
1526 load_face_colors (f
, face
, attrs
)
1533 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1534 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1536 /* Swap colors if face is inverse-video. */
1537 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1545 /* Check for support for foreground, not for background because
1546 face_color_supported_p is smart enough to know that grays are
1547 "supported" as background because we are supposed to use stipple
1549 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1550 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1552 x_destroy_bitmap (f
, face
->stipple
);
1553 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1554 &face
->pixmap_w
, &face
->pixmap_h
);
1557 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1558 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1562 /* Free color PIXEL on frame F. */
1565 unload_color (f
, pixel
)
1567 unsigned long pixel
;
1569 #ifdef HAVE_X_WINDOWS
1573 x_free_colors (f
, &pixel
, 1);
1580 /* Free colors allocated for FACE. */
1583 free_face_colors (f
, face
)
1587 #ifdef HAVE_X_WINDOWS
1588 if (face
->colors_copied_bitwise_p
)
1593 if (!face
->foreground_defaulted_p
)
1595 x_free_colors (f
, &face
->foreground
, 1);
1596 IF_DEBUG (--ncolors_allocated
);
1599 if (!face
->background_defaulted_p
)
1601 x_free_colors (f
, &face
->background
, 1);
1602 IF_DEBUG (--ncolors_allocated
);
1605 if (face
->underline_p
1606 && !face
->underline_defaulted_p
)
1608 x_free_colors (f
, &face
->underline_color
, 1);
1609 IF_DEBUG (--ncolors_allocated
);
1612 if (face
->overline_p
1613 && !face
->overline_color_defaulted_p
)
1615 x_free_colors (f
, &face
->overline_color
, 1);
1616 IF_DEBUG (--ncolors_allocated
);
1619 if (face
->strike_through_p
1620 && !face
->strike_through_color_defaulted_p
)
1622 x_free_colors (f
, &face
->strike_through_color
, 1);
1623 IF_DEBUG (--ncolors_allocated
);
1626 if (face
->box
!= FACE_NO_BOX
1627 && !face
->box_color_defaulted_p
)
1629 x_free_colors (f
, &face
->box_color
, 1);
1630 IF_DEBUG (--ncolors_allocated
);
1634 #endif /* HAVE_X_WINDOWS */
1637 #endif /* HAVE_WINDOW_SYSTEM */
1641 /***********************************************************************
1643 ***********************************************************************/
1645 /* An enumerator for each field of an XLFD font name. */
1666 /* An enumerator for each possible slant value of a font. Taken from
1667 the XLFD specification. */
1675 XLFD_SLANT_REVERSE_ITALIC
,
1676 XLFD_SLANT_REVERSE_OBLIQUE
,
1680 /* Relative font weight according to XLFD documentation. */
1684 XLFD_WEIGHT_UNKNOWN
,
1685 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1686 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1687 XLFD_WEIGHT_LIGHT
, /* 30 */
1688 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1689 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1690 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1691 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1692 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1693 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1696 /* Relative proportionate width. */
1700 XLFD_SWIDTH_UNKNOWN
,
1701 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1702 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1703 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1704 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1705 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1706 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1707 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1708 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1709 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1712 /* Structure used for tables mapping XLFD weight, slant, and width
1713 names to numeric and symbolic values. */
1719 Lisp_Object
*symbol
;
1722 /* Table of XLFD slant names and their numeric and symbolic
1723 representations. This table must be sorted by slant names in
1726 static struct table_entry slant_table
[] =
1728 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1729 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1730 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1731 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1732 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1733 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1736 /* Table of XLFD weight names. This table must be sorted by weight
1737 names in ascending order. */
1739 static struct table_entry weight_table
[] =
1741 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1742 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1743 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1744 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1745 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1746 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1747 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1748 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1749 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1750 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1751 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1752 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1753 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1754 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1755 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1756 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1759 /* Table of XLFD width names. This table must be sorted by width
1760 names in ascending order. */
1762 static struct table_entry swidth_table
[] =
1764 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1765 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1766 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1767 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1768 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1769 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1770 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1771 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1772 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1773 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1774 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1775 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1776 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1777 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1778 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1781 /* The frame in effect when sorting font names. Set temporarily in
1782 sort_fonts so that it is available in font comparison functions. */
1784 static struct frame
*font_frame
;
1786 /* Order by which font selection chooses fonts. The default values
1787 mean `first, find a best match for the font width, then for the
1788 font height, then for weight, then for slant.' This variable can be
1789 set via set-face-font-sort-order. */
1792 static int font_sort_order
[4] = {
1793 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1796 static int font_sort_order
[4];
1800 #ifdef HAVE_WINDOW_SYSTEM
1802 /* Return a rescaling ratio of a font of NAME. */
1805 font_rescale_ratio (name
)
1808 Lisp_Object tail
, elt
;
1810 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
1813 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
1814 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
1815 return XFLOAT_DATA (XCDR (elt
));
1820 static enum font_property_index font_props_for_sorting
[FONT_SIZE_INDEX
];
1823 compare_fonts_by_sort_order (v1
, v2
)
1824 const void *v1
, *v2
;
1826 Lisp_Object font1
= *(Lisp_Object
*) v1
;
1827 Lisp_Object font2
= *(Lisp_Object
*) v2
;
1830 for (i
= 0; i
< FONT_SIZE_INDEX
; i
++)
1832 enum font_property_index idx
= font_props_for_sorting
[i
];
1833 Lisp_Object val1
= AREF (font1
, idx
), val2
= AREF (font2
, idx
);
1836 if (idx
<= FONT_REGISTRY_INDEX
)
1839 result
= STRINGP (val2
) ? strcmp (SDATA (val1
), SDATA (val2
)) : -1;
1841 result
= STRINGP (val2
) ? 1 : 0;
1845 if (INTEGERP (val1
))
1846 result
= INTEGERP (val2
) ? XINT (val1
) - XINT (val2
) : -1;
1848 result
= INTEGERP (val2
) ? 1 : 0;
1856 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
1857 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
1858 If FAMILY is omitted or nil, list all families.
1859 Otherwise, FAMILY must be a string, possibly containing wildcards
1861 If FRAME is omitted or nil, use the selected frame.
1862 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
1863 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
1864 FAMILY is the font family name. POINT-SIZE is the size of the
1865 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
1866 width, weight and slant of the font. These symbols are the same as for
1867 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
1868 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
1869 giving the registry and encoding of the font.
1870 The result list is sorted according to the current setting of
1871 the face font sort order. */)
1873 Lisp_Object family
, frame
;
1875 struct frame
*f
= check_x_frame (frame
);
1876 Lisp_Object font_spec
= Qnil
, vec
;
1882 CHECK_STRING (family
);
1883 font_spec
= Ffont_spec (0, NULL
);
1884 Ffont_put (font_spec
, QCfamily
, family
);
1886 vec
= font_list_entities (frame
, font_spec
);
1887 nfonts
= ASIZE (vec
);
1892 for (i
= 0; i
< 4; i
++)
1893 switch (font_sort_order
[i
])
1896 font_props_for_sorting
[i
] = FONT_WIDTH_INDEX
; break;
1897 case XLFD_POINT_SIZE
:
1898 font_props_for_sorting
[i
] = FONT_SIZE_INDEX
; break;
1900 font_props_for_sorting
[i
] = FONT_WEIGHT_INDEX
; break;
1902 font_props_for_sorting
[i
] = FONT_SLANT_INDEX
; break;
1904 font_props_for_sorting
[i
++] = FONT_FAMILY_INDEX
;
1905 font_props_for_sorting
[i
++] = FONT_FOUNDRY_INDEX
;
1906 font_props_for_sorting
[i
++] = FONT_ADSTYLE_INDEX
;
1907 font_props_for_sorting
[i
++] = FONT_REGISTRY_INDEX
;
1909 qsort (XVECTOR (vec
)->contents
, nfonts
, sizeof (Lisp_Object
),
1910 compare_fonts_by_sort_order
);
1914 for (i
= nfonts
- 1; i
>= 0; --i
)
1916 Lisp_Object font
= AREF (vec
, i
);
1917 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
1919 Lisp_Object spacing
;
1921 ASET (v
, 0, AREF (font
, FONT_FAMILY_INDEX
));
1922 ASET (v
, 1, FONT_WIDTH_SYMBOLIC (font
));
1923 point
= PIXEL_TO_POINT (XINT (AREF (font
, FONT_SIZE_INDEX
)) * 10,
1925 ASET (v
, 2, make_number (point
));
1926 ASET (v
, 3, FONT_WEIGHT_SYMBOLIC (font
));
1927 ASET (v
, 4, FONT_SLANT_SYMBOLIC (font
));
1928 spacing
= Ffont_get (font
, QCspacing
);
1929 ASET (v
, 5, (NILP (spacing
) || EQ (spacing
, Qp
)) ? Qnil
: Qt
);
1930 ASET (v
, 6, AREF (font
, FONT_NAME_INDEX
));
1931 ASET (v
, 7, AREF (font
, FONT_REGISTRY_INDEX
));
1933 result
= Fcons (v
, result
);
1940 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
1942 doc
: /* Return a list of available font families on FRAME.
1943 If FRAME is omitted or nil, use the selected frame.
1944 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
1945 is a font family, and FIXED-P is non-nil if fonts of that family
1946 are fixed-pitch. */)
1950 return Ffont_family_list (frame
);
1954 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
1955 doc
: /* Return a list of the names of available fonts matching PATTERN.
1956 If optional arguments FACE and FRAME are specified, return only fonts
1957 the same size as FACE on FRAME.
1958 PATTERN is a string, perhaps with wildcard characters;
1959 the * character matches any substring, and
1960 the ? character matches any single character.
1961 PATTERN is case-insensitive.
1962 FACE is a face name--a symbol.
1964 The return value is a list of strings, suitable as arguments to
1967 Fonts Emacs can't use may or may not be excluded
1968 even if they match PATTERN and FACE.
1969 The optional fourth argument MAXIMUM sets a limit on how many
1970 fonts to match. The first MAXIMUM fonts are reported.
1971 The optional fifth argument WIDTH, if specified, is a number of columns
1972 occupied by a character of a font. In that case, return only fonts
1973 the WIDTH times as wide as FACE on FRAME. */)
1974 (pattern
, face
, frame
, maximum
, width
)
1975 Lisp_Object pattern
, face
, frame
, maximum
, width
;
1981 CHECK_STRING (pattern
);
1983 if (! NILP (maximum
))
1984 CHECK_NATNUM (maximum
);
1987 CHECK_NUMBER (width
);
1989 /* We can't simply call check_x_frame because this function may be
1990 called before any frame is created. */
1992 frame
= selected_frame
;
1993 f
= frame_or_selected_frame (frame
, 2);
1994 if (! FRAME_WINDOW_P (f
))
1996 /* Perhaps we have not yet created any frame. */
2002 /* Determine the width standard for comparison with the fonts we find. */
2008 /* This is of limited utility since it works with character
2009 widths. Keep it for compatibility. --gerd. */
2010 int face_id
= lookup_named_face (f
, face
, 0);
2011 struct face
*face
= (face_id
< 0
2013 : FACE_FROM_ID (f
, face_id
));
2015 if (face
&& face
->font
)
2017 size
= face
->font
->pixel_size
;
2018 avgwidth
= face
->font
->average_width
;
2022 size
= FRAME_FONT (f
)->pixel_size
;
2023 avgwidth
= FRAME_FONT (f
)->average_width
;
2026 avgwidth
*= XINT (width
);
2030 Lisp_Object font_spec
;
2031 Lisp_Object args
[2];
2033 font_spec
= font_spec_from_name (pattern
);
2036 Ffont_put (font_spec
, QCsize
, make_number (size
));
2037 Ffont_put (font_spec
, QCavgwidth
, make_number (avgwidth
));
2039 args
[0] = Flist_fonts (font_spec
, frame
, maximum
, Qnil
);
2041 /* We don't have to check fontsets. */
2043 args
[1] = list_fontsets (f
, pattern
, size
);
2044 return Fnconc (2, args
);
2048 #endif /* HAVE_WINDOW_SYSTEM */
2052 /***********************************************************************
2054 ***********************************************************************/
2056 /* Access face attributes of face LFACE, a Lisp vector. */
2058 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2059 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2060 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2061 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2062 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2063 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2064 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2065 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2066 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2067 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2068 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2069 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2070 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2071 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2072 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2073 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
2075 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2076 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2078 #define LFACEP(LFACE) \
2080 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2081 && EQ (AREF (LFACE, 0), Qface))
2086 /* Check consistency of Lisp face attribute vector ATTRS. */
2089 check_lface_attrs (attrs
)
2092 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2093 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
2094 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2095 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2096 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
2097 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2098 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2099 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
2100 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2101 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2102 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2103 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2104 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
2105 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2106 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2107 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
2108 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2109 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2110 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
2111 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2112 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2113 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2114 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
2115 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2116 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2117 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2118 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2119 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2120 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2121 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2122 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
2123 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2124 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2125 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2126 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2127 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2128 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
2129 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2130 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2131 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
2132 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2133 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2134 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
2135 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2136 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2137 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
2138 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2139 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2140 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2141 #ifdef HAVE_WINDOW_SYSTEM
2142 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2143 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
2144 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2145 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2146 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2147 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
2148 || FONTP (attrs
[LFACE_FONT_INDEX
]));
2149 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
2150 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
2155 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2163 xassert (LFACEP (lface
));
2164 check_lface_attrs (XVECTOR (lface
)->contents
);
2168 #else /* GLYPH_DEBUG == 0 */
2170 #define check_lface_attrs(attrs) (void) 0
2171 #define check_lface(lface) (void) 0
2173 #endif /* GLYPH_DEBUG == 0 */
2177 /* Face-merge cycle checking. */
2179 /* A `named merge point' is simply a point during face-merging where we
2180 look up a face by name. We keep a stack of which named lookups we're
2181 currently processing so that we can easily detect cycles, using a
2182 linked- list of struct named_merge_point structures, typically
2183 allocated on the stack frame of the named lookup functions which are
2184 active (so no consing is required). */
2185 struct named_merge_point
2187 Lisp_Object face_name
;
2188 struct named_merge_point
*prev
;
2192 /* If a face merging cycle is detected for FACE_NAME, return 0,
2193 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
2194 FACE_NAME, as the head of the linked list pointed to by
2195 NAMED_MERGE_POINTS, and return 1. */
2198 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
2199 Lisp_Object face_name
,
2200 struct named_merge_point
**named_merge_points
)
2202 struct named_merge_point
*prev
;
2204 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
2205 if (EQ (face_name
, prev
->face_name
))
2208 new_named_merge_point
->face_name
= face_name
;
2209 new_named_merge_point
->prev
= *named_merge_points
;
2211 *named_merge_points
= new_named_merge_point
;
2218 #if 0 /* Seems to be unused. */
2220 internal_resolve_face_name (nargs
, args
)
2224 return Fget (args
[0], args
[1]);
2228 resolve_face_name_error (ignore
)
2235 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2236 to make it a symbol. If FACE_NAME is an alias for another face,
2237 return that face's name.
2239 Return default face in case of errors. */
2242 resolve_face_name (face_name
, signal_p
)
2243 Lisp_Object face_name
;
2246 Lisp_Object orig_face
;
2247 Lisp_Object tortoise
, hare
;
2249 if (STRINGP (face_name
))
2250 face_name
= intern (SDATA (face_name
));
2252 if (NILP (face_name
) || !SYMBOLP (face_name
))
2255 orig_face
= face_name
;
2256 tortoise
= hare
= face_name
;
2261 hare
= Fget (hare
, Qface_alias
);
2262 if (NILP (hare
) || !SYMBOLP (hare
))
2266 hare
= Fget (hare
, Qface_alias
);
2267 if (NILP (hare
) || !SYMBOLP (hare
))
2270 tortoise
= Fget (tortoise
, Qface_alias
);
2271 if (EQ (hare
, tortoise
))
2274 xsignal1 (Qcircular_list
, orig_face
);
2283 /* Return the face definition of FACE_NAME on frame F. F null means
2284 return the definition for new frames. FACE_NAME may be a string or
2285 a symbol (apparently Emacs 20.2 allowed strings as face names in
2286 face text properties; Ediff uses that). If FACE_NAME is an alias
2287 for another face, return that face's definition. If SIGNAL_P is
2288 non-zero, signal an error if FACE_NAME is not a valid face name.
2289 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2292 static INLINE Lisp_Object
2293 lface_from_face_name (f
, face_name
, signal_p
)
2295 Lisp_Object face_name
;
2300 face_name
= resolve_face_name (face_name
, signal_p
);
2303 lface
= assq_no_quit (face_name
, f
->face_alist
);
2305 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2308 lface
= XCDR (lface
);
2310 signal_error ("Invalid face", face_name
);
2312 check_lface (lface
);
2317 /* Get face attributes of face FACE_NAME from frame-local faces on
2318 frame F. Store the resulting attributes in ATTRS which must point
2319 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2320 is non-zero, signal an error if FACE_NAME does not name a face.
2321 Otherwise, value is zero if FACE_NAME is not a face. */
2324 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2326 Lisp_Object face_name
;
2333 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2336 bcopy (XVECTOR (lface
)->contents
, attrs
,
2337 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2347 /* Non-zero if all attributes in face attribute vector ATTRS are
2348 specified, i.e. are non-nil. */
2351 lface_fully_specified_p (attrs
)
2356 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2357 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2358 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
]))
2360 /* MAC_TODO: No stipple support on Mac OS yet, this index is
2361 always unspecified. */
2362 && i
!= LFACE_STIPPLE_INDEX
2367 return i
== LFACE_VECTOR_SIZE
;
2370 #ifdef HAVE_WINDOW_SYSTEM
2372 /* Set font-related attributes of Lisp face LFACE from FONT-OBJECT.
2373 If FORCE_P is zero, set only unspecified attributes of LFACE. The
2374 exception is `font' attribute. It is set to FONT_OBJECT regardless
2378 set_lface_from_font (f
, lface
, font_object
, force_p
)
2380 Lisp_Object lface
, font_object
;
2384 struct font
*font
= XFONT_OBJECT (font_object
);
2386 /* Set attributes only if unspecified, otherwise face defaults for
2387 new frames would never take effect. If the font doesn't have a
2388 specific property, set a normal value for that. */
2390 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
2392 Lisp_Object foundry
= AREF (font_object
, FONT_FOUNDRY_INDEX
);
2393 Lisp_Object family
= AREF (font_object
, FONT_FAMILY_INDEX
);
2395 if (! NILP (foundry
))
2397 if (! NILP (family
))
2398 val
= concat3 (SYMBOL_NAME (foundry
), build_string ("-"),
2399 SYMBOL_NAME (family
));
2401 val
= concat2 (SYMBOL_NAME (foundry
), build_string ("-*"));
2405 if (! NILP (family
))
2406 val
= SYMBOL_NAME (family
);
2408 val
= build_string ("*");
2410 LFACE_FAMILY (lface
) = val
;
2413 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
2415 int pt
= PIXEL_TO_POINT (font
->pixel_size
* 10, f
->resy
);
2418 LFACE_HEIGHT (lface
) = make_number (pt
);
2421 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
2423 val
= FONT_WEIGHT_FOR_FACE (font_object
);
2424 LFACE_WEIGHT (lface
) = ! NILP (val
) ? val
:Qnormal
;
2426 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
2428 val
= FONT_SLANT_FOR_FACE (font_object
);
2429 LFACE_SLANT (lface
) = ! NILP (val
) ? val
: Qnormal
;
2431 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
2433 val
= FONT_WIDTH_FOR_FACE (font_object
);
2434 LFACE_SWIDTH (lface
) = ! NILP (val
) ? val
: Qnormal
;
2437 LFACE_FONT (lface
) = font_object
;
2441 #endif /* HAVE_WINDOW_SYSTEM */
2444 /* Merges the face height FROM with the face height TO, and returns the
2445 merged height. If FROM is an invalid height, then INVALID is
2446 returned instead. FROM and TO may be either absolute face heights or
2447 `relative' heights; the returned value is always an absolute height
2448 unless both FROM and TO are relative. GCPRO is a lisp value that
2449 will be protected from garbage-collection if this function makes a
2453 merge_face_heights (from
, to
, invalid
)
2454 Lisp_Object from
, to
, invalid
;
2456 Lisp_Object result
= invalid
;
2458 if (INTEGERP (from
))
2459 /* FROM is absolute, just use it as is. */
2461 else if (FLOATP (from
))
2462 /* FROM is a scale, use it to adjust TO. */
2465 /* relative X absolute => absolute */
2466 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
2467 else if (FLOATP (to
))
2468 /* relative X relative => relative */
2469 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
2470 else if (UNSPECIFIEDP (to
))
2473 else if (FUNCTIONP (from
))
2474 /* FROM is a function, which use to adjust TO. */
2476 /* Call function with current height as argument.
2477 From is the new height. */
2478 Lisp_Object args
[2];
2482 result
= safe_call (2, args
);
2484 /* Ensure that if TO was absolute, so is the result. */
2485 if (INTEGERP (to
) && !INTEGERP (result
))
2493 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
2494 store the resulting attributes in TO, which must be already be
2495 completely specified and contain only absolute attributes. Every
2496 specified attribute of FROM overrides the corresponding attribute of
2497 TO; relative attributes in FROM are merged with the absolute value in
2498 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
2499 loops in face inheritance; it should be 0 when called from other
2503 merge_face_vectors (f
, from
, to
, named_merge_points
)
2505 Lisp_Object
*from
, *to
;
2506 struct named_merge_point
*named_merge_points
;
2510 /* If FROM inherits from some other faces, merge their attributes into
2511 TO before merging FROM's direct attributes. Note that an :inherit
2512 attribute of `unspecified' is the same as one of nil; we never
2513 merge :inherit attributes, so nil is more correct, but lots of
2514 other code uses `unspecified' as a generic value for face attributes. */
2515 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
2516 && !NILP (from
[LFACE_INHERIT_INDEX
]))
2517 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
2519 i
= LFACE_FONT_INDEX
;
2520 if (!UNSPECIFIEDP (from
[i
]))
2522 if (!UNSPECIFIEDP (to
[i
]))
2523 to
[i
] = Fmerge_font_spec (from
[i
], to
[i
]);
2525 to
[i
] = Fcopy_font_spec (from
[i
]);
2526 ASET (to
[i
], FONT_SIZE_INDEX
, Qnil
);
2529 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2530 if (!UNSPECIFIEDP (from
[i
]))
2532 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
2534 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
2535 font_clear_prop (to
, FONT_SIZE_INDEX
);
2537 else if (i
!= LFACE_FONT_INDEX
)
2540 if (i
>= LFACE_FAMILY_INDEX
&& i
<=LFACE_SLANT_INDEX
)
2541 font_clear_prop (to
,
2542 (i
== LFACE_FAMILY_INDEX
? FONT_FAMILY_INDEX
2543 : i
== LFACE_SWIDTH_INDEX
? FONT_WIDTH_INDEX
2544 : i
== LFACE_HEIGHT_INDEX
? FONT_SIZE_INDEX
2545 : i
== LFACE_WEIGHT_INDEX
? FONT_WEIGHT_INDEX
2546 : FONT_SLANT_INDEX
));
2550 /* If `font' attribute is specified, reflect the font properties in
2551 it to the other attributes. */
2552 if (0 && !UNSPECIFIEDP (to
[LFACE_FONT_INDEX
]))
2553 font_update_lface (f
, to
);
2555 /* TO is always an absolute face, which should inherit from nothing.
2556 We blindly copy the :inherit attribute above and fix it up here. */
2557 to
[LFACE_INHERIT_INDEX
] = Qnil
;
2560 /* Merge the named face FACE_NAME on frame F, into the vector of face
2561 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
2562 inheritance. Returns true if FACE_NAME is a valid face name and
2563 merging succeeded. */
2566 merge_named_face (f
, face_name
, to
, named_merge_points
)
2568 Lisp_Object face_name
;
2570 struct named_merge_point
*named_merge_points
;
2572 struct named_merge_point named_merge_point
;
2574 if (push_named_merge_point (&named_merge_point
,
2575 face_name
, &named_merge_points
))
2577 struct gcpro gcpro1
;
2578 Lisp_Object from
[LFACE_VECTOR_SIZE
];
2579 int ok
= get_lface_attributes (f
, face_name
, from
, 0);
2583 GCPRO1 (named_merge_point
.face_name
);
2584 merge_face_vectors (f
, from
, to
, named_merge_points
);
2595 /* Merge face attributes from the lisp `face reference' FACE_REF on
2596 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
2597 problems with FACE_REF cause an error message to be shown. Return
2598 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
2599 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
2600 list structure; it may be 0 for most callers.
2602 FACE_REF may be a single face specification or a list of such
2603 specifications. Each face specification can be:
2605 1. A symbol or string naming a Lisp face.
2607 2. A property list of the form (KEYWORD VALUE ...) where each
2608 KEYWORD is a face attribute name, and value is an appropriate value
2611 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
2612 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
2613 for compatibility with 20.2.
2615 Face specifications earlier in lists take precedence over later
2619 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
2621 Lisp_Object face_ref
;
2624 struct named_merge_point
*named_merge_points
;
2626 int ok
= 1; /* Succeed without an error? */
2628 if (CONSP (face_ref
))
2630 Lisp_Object first
= XCAR (face_ref
);
2632 if (EQ (first
, Qforeground_color
)
2633 || EQ (first
, Qbackground_color
))
2635 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
2636 . COLOR). COLOR must be a string. */
2637 Lisp_Object color_name
= XCDR (face_ref
);
2638 Lisp_Object color
= first
;
2640 if (STRINGP (color_name
))
2642 if (EQ (color
, Qforeground_color
))
2643 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
2645 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
2650 add_to_log ("Invalid face color", color_name
, Qnil
);
2654 else if (SYMBOLP (first
)
2655 && *SDATA (SYMBOL_NAME (first
)) == ':')
2657 /* Assume this is the property list form. */
2658 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
2660 Lisp_Object keyword
= XCAR (face_ref
);
2661 Lisp_Object value
= XCAR (XCDR (face_ref
));
2664 /* Specifying `unspecified' is a no-op. */
2665 if (EQ (value
, Qunspecified
))
2667 else if (EQ (keyword
, QCfamily
))
2669 if (STRINGP (value
))
2671 to
[LFACE_FAMILY_INDEX
] = value
;
2672 font_clear_prop (to
, FONT_FAMILY_INDEX
);
2677 else if (EQ (keyword
, QCheight
))
2679 Lisp_Object new_height
=
2680 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
2682 if (! NILP (new_height
))
2684 to
[LFACE_HEIGHT_INDEX
] = new_height
;
2685 font_clear_prop (to
, FONT_SIZE_INDEX
);
2690 else if (EQ (keyword
, QCweight
))
2692 if (SYMBOLP (value
) && FONT_WEIGHT_NAME_NUMERIC (value
) >= 0)
2694 to
[LFACE_WEIGHT_INDEX
] = value
;
2695 font_clear_prop (to
, FONT_WEIGHT_INDEX
);
2700 else if (EQ (keyword
, QCslant
))
2702 if (SYMBOLP (value
) && FONT_SLANT_NAME_NUMERIC (value
) >= 0)
2704 to
[LFACE_SLANT_INDEX
] = value
;
2705 font_clear_prop (to
, FONT_SLANT_INDEX
);
2710 else if (EQ (keyword
, QCunderline
))
2715 to
[LFACE_UNDERLINE_INDEX
] = value
;
2719 else if (EQ (keyword
, QCoverline
))
2724 to
[LFACE_OVERLINE_INDEX
] = value
;
2728 else if (EQ (keyword
, QCstrike_through
))
2733 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
2737 else if (EQ (keyword
, QCbox
))
2740 value
= make_number (1);
2741 if (INTEGERP (value
)
2745 to
[LFACE_BOX_INDEX
] = value
;
2749 else if (EQ (keyword
, QCinverse_video
)
2750 || EQ (keyword
, QCreverse_video
))
2752 if (EQ (value
, Qt
) || NILP (value
))
2753 to
[LFACE_INVERSE_INDEX
] = value
;
2757 else if (EQ (keyword
, QCforeground
))
2759 if (STRINGP (value
))
2760 to
[LFACE_FOREGROUND_INDEX
] = value
;
2764 else if (EQ (keyword
, QCbackground
))
2766 if (STRINGP (value
))
2767 to
[LFACE_BACKGROUND_INDEX
] = value
;
2771 else if (EQ (keyword
, QCstipple
))
2773 #ifdef HAVE_X_WINDOWS
2774 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
2775 if (!NILP (pixmap_p
))
2776 to
[LFACE_STIPPLE_INDEX
] = value
;
2781 else if (EQ (keyword
, QCwidth
))
2783 if (SYMBOLP (value
) && FONT_WIDTH_NAME_NUMERIC (value
) >= 0)
2785 to
[LFACE_SWIDTH_INDEX
] = value
;
2786 font_clear_prop (to
, FONT_WIDTH_INDEX
);
2791 else if (EQ (keyword
, QCinherit
))
2793 /* This is not really very useful; it's just like a
2794 normal face reference. */
2795 if (! merge_face_ref (f
, value
, to
,
2796 err_msgs
, named_merge_points
))
2804 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
2808 face_ref
= XCDR (XCDR (face_ref
));
2813 /* This is a list of face refs. Those at the beginning of the
2814 list take precedence over what follows, so we have to merge
2815 from the end backwards. */
2816 Lisp_Object next
= XCDR (face_ref
);
2819 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
2821 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
2827 /* FACE_REF ought to be a face name. */
2828 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
2829 if (!ok
&& err_msgs
)
2830 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
2837 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
2838 Sinternal_make_lisp_face
, 1, 2, 0,
2839 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
2840 If FACE was not known as a face before, create a new one.
2841 If optional argument FRAME is specified, make a frame-local face
2842 for that frame. Otherwise operate on the global face definition.
2843 Value is a vector of face attributes. */)
2845 Lisp_Object face
, frame
;
2847 Lisp_Object global_lface
, lface
;
2851 CHECK_SYMBOL (face
);
2852 global_lface
= lface_from_face_name (NULL
, face
, 0);
2856 CHECK_LIVE_FRAME (frame
);
2858 lface
= lface_from_face_name (f
, face
, 0);
2861 f
= NULL
, lface
= Qnil
;
2863 /* Add a global definition if there is none. */
2864 if (NILP (global_lface
))
2866 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2868 ASET (global_lface
, 0, Qface
);
2869 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
2870 Vface_new_frame_defaults
);
2872 /* Assign the new Lisp face a unique ID. The mapping from Lisp
2873 face id to Lisp face is given by the vector lface_id_to_name.
2874 The mapping from Lisp face to Lisp face id is given by the
2875 property `face' of the Lisp face name. */
2876 if (next_lface_id
== lface_id_to_name_size
)
2878 int new_size
= max (50, 2 * lface_id_to_name_size
);
2879 int sz
= new_size
* sizeof *lface_id_to_name
;
2880 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
2881 lface_id_to_name_size
= new_size
;
2884 lface_id_to_name
[next_lface_id
] = face
;
2885 Fput (face
, Qface
, make_number (next_lface_id
));
2889 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2890 ASET (global_lface
, i
, Qunspecified
);
2892 /* Add a frame-local definition. */
2897 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
2899 ASET (lface
, 0, Qface
);
2900 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
2903 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2904 ASET (lface
, i
, Qunspecified
);
2907 lface
= global_lface
;
2909 /* Changing a named face means that all realized faces depending on
2910 that face are invalid. Since we cannot tell which realized faces
2911 depend on the face, make sure they are all removed. This is done
2912 by incrementing face_change_count. The next call to
2913 init_iterator will then free realized faces. */
2914 if (NILP (Fget (face
, Qface_no_inherit
)))
2916 ++face_change_count
;
2917 ++windows_or_buffers_changed
;
2920 xassert (LFACEP (lface
));
2921 check_lface (lface
);
2926 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
2927 Sinternal_lisp_face_p
, 1, 2, 0,
2928 doc
: /* Return non-nil if FACE names a face.
2929 If optional second argument FRAME is non-nil, check for the
2930 existence of a frame-local face with name FACE on that frame.
2931 Otherwise check for the existence of a global face. */)
2933 Lisp_Object face
, frame
;
2937 face
= resolve_face_name (face
, 1);
2941 CHECK_LIVE_FRAME (frame
);
2942 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
2945 lface
= lface_from_face_name (NULL
, face
, 0);
2951 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
2952 Sinternal_copy_lisp_face
, 4, 4, 0,
2953 doc
: /* Copy face FROM to TO.
2954 If FRAME is t, copy the global face definition of FROM.
2955 Otherwise, copy the frame-local definition of FROM on FRAME.
2956 If NEW-FRAME is a frame, copy that data into the frame-local
2957 definition of TO on NEW-FRAME. If NEW-FRAME is nil.
2958 FRAME controls where the data is copied to.
2960 The value is TO. */)
2961 (from
, to
, frame
, new_frame
)
2962 Lisp_Object from
, to
, frame
, new_frame
;
2964 Lisp_Object lface
, copy
;
2966 CHECK_SYMBOL (from
);
2971 /* Copy global definition of FROM. We don't make copies of
2972 strings etc. because 20.2 didn't do it either. */
2973 lface
= lface_from_face_name (NULL
, from
, 1);
2974 copy
= Finternal_make_lisp_face (to
, Qnil
);
2978 /* Copy frame-local definition of FROM. */
2979 if (NILP (new_frame
))
2981 CHECK_LIVE_FRAME (frame
);
2982 CHECK_LIVE_FRAME (new_frame
);
2983 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
2984 copy
= Finternal_make_lisp_face (to
, new_frame
);
2987 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
2988 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
2990 /* Changing a named face means that all realized faces depending on
2991 that face are invalid. Since we cannot tell which realized faces
2992 depend on the face, make sure they are all removed. This is done
2993 by incrementing face_change_count. The next call to
2994 init_iterator will then free realized faces. */
2995 if (NILP (Fget (to
, Qface_no_inherit
)))
2997 ++face_change_count
;
2998 ++windows_or_buffers_changed
;
3005 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3006 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3007 doc
: /* Set attribute ATTR of FACE to VALUE.
3008 FRAME being a frame means change the face on that frame.
3009 FRAME nil means change the face of the selected frame.
3010 FRAME t means change the default for new frames.
3011 FRAME 0 means change the face on all frames, and change the default
3013 (face
, attr
, value
, frame
)
3014 Lisp_Object face
, attr
, value
, frame
;
3017 Lisp_Object old_value
= Qnil
;
3018 /* Set one of enum font_property_index (> 0) if ATTR is one of
3019 font-related attributes other than QCfont and QCfontset. */
3020 enum font_property_index prop_index
= 0;
3022 CHECK_SYMBOL (face
);
3023 CHECK_SYMBOL (attr
);
3025 face
= resolve_face_name (face
, 1);
3027 /* If FRAME is 0, change face on all frames, and change the
3028 default for new frames. */
3029 if (INTEGERP (frame
) && XINT (frame
) == 0)
3032 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3033 FOR_EACH_FRAME (tail
, frame
)
3034 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3038 /* Set lface to the Lisp attribute vector of FACE. */
3041 lface
= lface_from_face_name (NULL
, face
, 1);
3043 /* When updating face-new-frame-defaults, we put :ignore-defface
3044 where the caller wants `unspecified'. This forces the frame
3045 defaults to ignore the defface value. Otherwise, the defface
3046 will take effect, which is generally not what is intended.
3047 The value of that attribute will be inherited from some other
3048 face during face merging. See internal_merge_in_global_face. */
3049 if (UNSPECIFIEDP (value
))
3050 value
= Qignore_defface
;
3055 frame
= selected_frame
;
3057 CHECK_LIVE_FRAME (frame
);
3058 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3060 /* If a frame-local face doesn't exist yet, create one. */
3062 lface
= Finternal_make_lisp_face (face
, frame
);
3065 if (EQ (attr
, QCfamily
))
3067 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3069 CHECK_STRING (value
);
3070 if (SCHARS (value
) == 0)
3071 signal_error ("Invalid face family", value
);
3073 old_value
= LFACE_FAMILY (lface
);
3074 LFACE_FAMILY (lface
) = value
;
3075 prop_index
= FONT_FAMILY_INDEX
;
3077 else if (EQ (attr
, QCheight
))
3079 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3083 test
= (EQ (face
, Qdefault
)
3085 /* The default face must have an absolute size,
3086 otherwise, we do a test merge with a random
3087 height to see if VALUE's ok. */
3088 : merge_face_heights (value
, make_number (10), Qnil
));
3090 if (!INTEGERP (test
) || XINT (test
) <= 0)
3091 signal_error ("Invalid face height", value
);
3094 old_value
= LFACE_HEIGHT (lface
);
3095 LFACE_HEIGHT (lface
) = value
;
3096 prop_index
= FONT_SIZE_INDEX
;
3098 else if (EQ (attr
, QCweight
))
3100 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3102 CHECK_SYMBOL (value
);
3103 if (FONT_WEIGHT_NAME_NUMERIC (value
) < 0)
3104 signal_error ("Invalid face weight", value
);
3106 old_value
= LFACE_WEIGHT (lface
);
3107 LFACE_WEIGHT (lface
) = value
;
3108 prop_index
= FONT_WEIGHT_INDEX
;
3110 else if (EQ (attr
, QCslant
))
3112 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3114 CHECK_SYMBOL (value
);
3115 if (FONT_SLANT_NAME_NUMERIC (value
) < 0)
3116 signal_error ("Invalid face slant", value
);
3118 old_value
= LFACE_SLANT (lface
);
3119 LFACE_SLANT (lface
) = value
;
3120 prop_index
= FONT_SLANT_INDEX
;
3122 else if (EQ (attr
, QCunderline
))
3124 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3125 if ((SYMBOLP (value
)
3127 && !EQ (value
, Qnil
))
3128 /* Underline color. */
3130 && SCHARS (value
) == 0))
3131 signal_error ("Invalid face underline", value
);
3133 old_value
= LFACE_UNDERLINE (lface
);
3134 LFACE_UNDERLINE (lface
) = value
;
3136 else if (EQ (attr
, QCoverline
))
3138 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3139 if ((SYMBOLP (value
)
3141 && !EQ (value
, Qnil
))
3142 /* Overline color. */
3144 && SCHARS (value
) == 0))
3145 signal_error ("Invalid face overline", value
);
3147 old_value
= LFACE_OVERLINE (lface
);
3148 LFACE_OVERLINE (lface
) = value
;
3150 else if (EQ (attr
, QCstrike_through
))
3152 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3153 if ((SYMBOLP (value
)
3155 && !EQ (value
, Qnil
))
3156 /* Strike-through color. */
3158 && SCHARS (value
) == 0))
3159 signal_error ("Invalid face strike-through", value
);
3161 old_value
= LFACE_STRIKE_THROUGH (lface
);
3162 LFACE_STRIKE_THROUGH (lface
) = value
;
3164 else if (EQ (attr
, QCbox
))
3168 /* Allow t meaning a simple box of width 1 in foreground color
3171 value
= make_number (1);
3173 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
3175 else if (NILP (value
))
3177 else if (INTEGERP (value
))
3178 valid_p
= XINT (value
) != 0;
3179 else if (STRINGP (value
))
3180 valid_p
= SCHARS (value
) > 0;
3181 else if (CONSP (value
))
3197 if (EQ (k
, QCline_width
))
3199 if (!INTEGERP (v
) || XINT (v
) == 0)
3202 else if (EQ (k
, QCcolor
))
3204 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
3207 else if (EQ (k
, QCstyle
))
3209 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3216 valid_p
= NILP (tem
);
3222 signal_error ("Invalid face box", value
);
3224 old_value
= LFACE_BOX (lface
);
3225 LFACE_BOX (lface
) = value
;
3227 else if (EQ (attr
, QCinverse_video
)
3228 || EQ (attr
, QCreverse_video
))
3230 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3232 CHECK_SYMBOL (value
);
3233 if (!EQ (value
, Qt
) && !NILP (value
))
3234 signal_error ("Invalid inverse-video face attribute value", value
);
3236 old_value
= LFACE_INVERSE (lface
);
3237 LFACE_INVERSE (lface
) = value
;
3239 else if (EQ (attr
, QCforeground
))
3241 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3243 /* Don't check for valid color names here because it depends
3244 on the frame (display) whether the color will be valid
3245 when the face is realized. */
3246 CHECK_STRING (value
);
3247 if (SCHARS (value
) == 0)
3248 signal_error ("Empty foreground color value", value
);
3250 old_value
= LFACE_FOREGROUND (lface
);
3251 LFACE_FOREGROUND (lface
) = value
;
3253 else if (EQ (attr
, QCbackground
))
3255 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3257 /* Don't check for valid color names here because it depends
3258 on the frame (display) whether the color will be valid
3259 when the face is realized. */
3260 CHECK_STRING (value
);
3261 if (SCHARS (value
) == 0)
3262 signal_error ("Empty background color value", value
);
3264 old_value
= LFACE_BACKGROUND (lface
);
3265 LFACE_BACKGROUND (lface
) = value
;
3267 else if (EQ (attr
, QCstipple
))
3269 #ifdef HAVE_X_WINDOWS
3270 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3272 && NILP (Fbitmap_spec_p (value
)))
3273 signal_error ("Invalid stipple attribute", value
);
3274 old_value
= LFACE_STIPPLE (lface
);
3275 LFACE_STIPPLE (lface
) = value
;
3276 #endif /* HAVE_X_WINDOWS */
3278 else if (EQ (attr
, QCwidth
))
3280 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3282 CHECK_SYMBOL (value
);
3283 if (FONT_WIDTH_NAME_NUMERIC (value
) < 0)
3284 signal_error ("Invalid face width", value
);
3286 old_value
= LFACE_SWIDTH (lface
);
3287 LFACE_SWIDTH (lface
) = value
;
3288 prop_index
= FONT_WIDTH_INDEX
;
3290 else if (EQ (attr
, QCfont
))
3292 #ifdef HAVE_WINDOW_SYSTEM
3293 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3295 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
3299 old_value
= LFACE_FONT (lface
);
3300 if (! FONTP (value
))
3302 if (STRINGP (value
))
3304 int fontset
= fs_query_fontset (value
, 0);
3307 value
= fontset_ascii (fontset
);
3309 value
= font_spec_from_name (value
);
3312 signal_error ("Invalid font or font-spec", value
);
3315 f
= XFRAME (selected_frame
);
3318 if (! FONT_OBJECT_P (value
))
3320 Lisp_Object
*attrs
= XVECTOR (lface
)->contents
;
3321 Lisp_Object font_object
;
3323 font_object
= font_load_for_lface (f
, attrs
, value
);
3324 if (NILP (font_object
))
3325 signal_error ("Font not available", value
);
3326 value
= font_object
;
3328 set_lface_from_font (f
, lface
, value
, 1);
3331 LFACE_FONT (lface
) = value
;
3333 #endif /* HAVE_WINDOW_SYSTEM */
3335 else if (EQ (attr
, QCfontset
))
3337 #ifdef HAVE_WINDOW_SYSTEM
3338 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
3342 old_value
= LFACE_FONTSET (lface
);
3343 tmp
= Fquery_fontset (value
, Qnil
);
3345 signal_error ("Invalid fontset name", value
);
3346 LFACE_FONTSET (lface
) = value
= tmp
;
3348 #endif /* HAVE_WINDOW_SYSTEM */
3350 else if (EQ (attr
, QCinherit
))
3353 if (SYMBOLP (value
))
3356 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3357 if (!SYMBOLP (XCAR (tail
)))
3360 LFACE_INHERIT (lface
) = value
;
3362 signal_error ("Invalid face inheritance", value
);
3364 else if (EQ (attr
, QCbold
))
3366 old_value
= LFACE_WEIGHT (lface
);
3367 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3368 prop_index
= FONT_WEIGHT_INDEX
;
3370 else if (EQ (attr
, QCitalic
))
3373 old_value
= LFACE_SLANT (lface
);
3374 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3375 prop_index
= FONT_SLANT_INDEX
;
3378 signal_error ("Invalid face attribute name", attr
);
3381 /* If a font-related attribute other than QCfont and QCfontset is
3382 specified, and if the original QCfont attribute has a font
3383 (font-spec or font-object), set the corresponding property in
3384 the font to nil so that the font selector doesn't think that
3385 the attribute is mandatory. */
3386 font_clear_prop (XVECTOR (lface
)->contents
, prop_index
);
3388 /* Changing a named face means that all realized faces depending on
3389 that face are invalid. Since we cannot tell which realized faces
3390 depend on the face, make sure they are all removed. This is done
3391 by incrementing face_change_count. The next call to
3392 init_iterator will then free realized faces. */
3394 && NILP (Fget (face
, Qface_no_inherit
))
3395 && NILP (Fequal (old_value
, value
)))
3397 ++face_change_count
;
3398 ++windows_or_buffers_changed
;
3401 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
3402 && NILP (Fequal (old_value
, value
)))
3408 if (EQ (face
, Qdefault
))
3410 #ifdef HAVE_WINDOW_SYSTEM
3411 /* Changed font-related attributes of the `default' face are
3412 reflected in changed `font' frame parameters. */
3414 && (prop_index
|| EQ (attr
, QCfont
))
3415 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3416 set_font_frame_param (frame
, lface
);
3418 #endif /* HAVE_WINDOW_SYSTEM */
3420 if (EQ (attr
, QCforeground
))
3421 param
= Qforeground_color
;
3422 else if (EQ (attr
, QCbackground
))
3423 param
= Qbackground_color
;
3425 #ifdef HAVE_WINDOW_SYSTEM
3427 else if (EQ (face
, Qscroll_bar
))
3429 /* Changing the colors of `scroll-bar' sets frame parameters
3430 `scroll-bar-foreground' and `scroll-bar-background'. */
3431 if (EQ (attr
, QCforeground
))
3432 param
= Qscroll_bar_foreground
;
3433 else if (EQ (attr
, QCbackground
))
3434 param
= Qscroll_bar_background
;
3436 #endif /* not WINDOWSNT */
3437 else if (EQ (face
, Qborder
))
3439 /* Changing background color of `border' sets frame parameter
3441 if (EQ (attr
, QCbackground
))
3442 param
= Qborder_color
;
3444 else if (EQ (face
, Qcursor
))
3446 /* Changing background color of `cursor' sets frame parameter
3448 if (EQ (attr
, QCbackground
))
3449 param
= Qcursor_color
;
3451 else if (EQ (face
, Qmouse
))
3453 /* Changing background color of `mouse' sets frame parameter
3455 if (EQ (attr
, QCbackground
))
3456 param
= Qmouse_color
;
3458 #endif /* HAVE_WINDOW_SYSTEM */
3459 else if (EQ (face
, Qmenu
))
3461 /* Indicate that we have to update the menu bar when
3462 realizing faces on FRAME. FRAME t change the
3463 default for new frames. We do this by setting
3464 setting the flag in new face caches */
3467 struct frame
*f
= XFRAME (frame
);
3468 if (FRAME_FACE_CACHE (f
) == NULL
)
3469 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
3470 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
3473 menu_face_changed_default
= 1;
3479 /* Update `default-frame-alist', which is used for new frames. */
3481 store_in_alist (&Vdefault_frame_alist
, param
, value
);
3484 /* Update the current frame's parameters. */
3487 cons
= XCAR (Vparam_value_alist
);
3488 XSETCAR (cons
, param
);
3489 XSETCDR (cons
, value
);
3490 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
3499 #ifdef HAVE_WINDOW_SYSTEM
3501 /* Set the `font' frame parameter of FRAME determined from the
3502 font-object set in `default' face attributes LFACE. */
3505 set_font_frame_param (frame
, lface
)
3506 Lisp_Object frame
, lface
;
3508 struct frame
*f
= XFRAME (frame
);
3510 if (FRAME_WINDOW_P (f
))
3512 Lisp_Object font
= LFACE_FONT (lface
);
3514 if (FONT_SPEC_P (font
))
3516 font
= font_load_for_lface (f
, XVECTOR (lface
)->contents
, font
);
3519 LFACE_FONT (lface
) = font
;
3521 f
->default_face_done_p
= 0;
3522 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font
), Qnil
));
3527 /* Update the corresponding face when frame parameter PARAM on frame F
3528 has been assigned the value NEW_VALUE. */
3531 update_face_from_frame_parameter (f
, param
, new_value
)
3533 Lisp_Object param
, new_value
;
3535 Lisp_Object face
= Qnil
;
3538 /* If there are no faces yet, give up. This is the case when called
3539 from Fx_create_frame, and we do the necessary things later in
3540 face-set-after-frame-defaults. */
3541 if (NILP (f
->face_alist
))
3544 if (EQ (param
, Qforeground_color
))
3547 lface
= lface_from_face_name (f
, face
, 1);
3548 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
3549 ? new_value
: Qunspecified
);
3550 realize_basic_faces (f
);
3552 else if (EQ (param
, Qbackground_color
))
3556 /* Changing the background color might change the background
3557 mode, so that we have to load new defface specs.
3558 Call frame-set-background-mode to do that. */
3559 XSETFRAME (frame
, f
);
3560 call1 (Qframe_set_background_mode
, frame
);
3563 lface
= lface_from_face_name (f
, face
, 1);
3564 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3565 ? new_value
: Qunspecified
);
3566 realize_basic_faces (f
);
3568 else if (EQ (param
, Qborder_color
))
3571 lface
= lface_from_face_name (f
, face
, 1);
3572 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3573 ? new_value
: Qunspecified
);
3575 else if (EQ (param
, Qcursor_color
))
3578 lface
= lface_from_face_name (f
, face
, 1);
3579 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3580 ? new_value
: Qunspecified
);
3582 else if (EQ (param
, Qmouse_color
))
3585 lface
= lface_from_face_name (f
, face
, 1);
3586 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
3587 ? new_value
: Qunspecified
);
3590 /* Changing a named face means that all realized faces depending on
3591 that face are invalid. Since we cannot tell which realized faces
3592 depend on the face, make sure they are all removed. This is done
3593 by incrementing face_change_count. The next call to
3594 init_iterator will then free realized faces. */
3596 && NILP (Fget (face
, Qface_no_inherit
)))
3598 ++face_change_count
;
3599 ++windows_or_buffers_changed
;
3604 /* Get the value of X resource RESOURCE, class CLASS for the display
3605 of frame FRAME. This is here because ordinary `x-get-resource'
3606 doesn't take a frame argument. */
3608 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
3609 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
3610 (resource
, class, frame
)
3611 Lisp_Object resource
, class, frame
;
3613 Lisp_Object value
= Qnil
;
3614 CHECK_STRING (resource
);
3615 CHECK_STRING (class);
3616 CHECK_LIVE_FRAME (frame
);
3618 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
3619 resource
, class, Qnil
, Qnil
);
3625 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
3626 If VALUE is "on" or "true", return t. If VALUE is "off" or
3627 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
3628 error; if SIGNAL_P is zero, return 0. */
3631 face_boolean_x_resource_value (value
, signal_p
)
3635 Lisp_Object result
= make_number (0);
3637 xassert (STRINGP (value
));
3639 if (xstricmp (SDATA (value
), "on") == 0
3640 || xstricmp (SDATA (value
), "true") == 0)
3642 else if (xstricmp (SDATA (value
), "off") == 0
3643 || xstricmp (SDATA (value
), "false") == 0)
3645 else if (xstricmp (SDATA (value
), "unspecified") == 0)
3646 result
= Qunspecified
;
3648 signal_error ("Invalid face attribute value from X resource", value
);
3654 DEFUN ("internal-set-lisp-face-attribute-from-resource",
3655 Finternal_set_lisp_face_attribute_from_resource
,
3656 Sinternal_set_lisp_face_attribute_from_resource
,
3657 3, 4, 0, doc
: /* */)
3658 (face
, attr
, value
, frame
)
3659 Lisp_Object face
, attr
, value
, frame
;
3661 CHECK_SYMBOL (face
);
3662 CHECK_SYMBOL (attr
);
3663 CHECK_STRING (value
);
3665 if (xstricmp (SDATA (value
), "unspecified") == 0)
3666 value
= Qunspecified
;
3667 else if (EQ (attr
, QCheight
))
3669 value
= Fstring_to_number (value
, make_number (10));
3670 if (XINT (value
) <= 0)
3671 signal_error ("Invalid face height from X resource", value
);
3673 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
3674 value
= face_boolean_x_resource_value (value
, 1);
3675 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
3676 value
= intern (SDATA (value
));
3677 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
3678 value
= face_boolean_x_resource_value (value
, 1);
3679 else if (EQ (attr
, QCunderline
)
3680 || EQ (attr
, QCoverline
)
3681 || EQ (attr
, QCstrike_through
))
3683 Lisp_Object boolean_value
;
3685 /* If the result of face_boolean_x_resource_value is t or nil,
3686 VALUE does NOT specify a color. */
3687 boolean_value
= face_boolean_x_resource_value (value
, 0);
3688 if (SYMBOLP (boolean_value
))
3689 value
= boolean_value
;
3691 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
3692 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
3694 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3697 #endif /* HAVE_WINDOW_SYSTEM */
3700 /***********************************************************************
3702 ***********************************************************************/
3704 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
3706 /* Make menus on frame F appear as specified by the `menu' face. */
3709 x_update_menu_appearance (f
)
3712 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
3716 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
3720 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
3721 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
3722 const char *myname
= SDATA (Vx_resource_name
);
3725 const char *popup_path
= "popup_menu";
3727 const char *popup_path
= "menu.popup";
3730 if (STRINGP (LFACE_FOREGROUND (lface
)))
3732 sprintf (line
, "%s.%s*foreground: %s",
3734 SDATA (LFACE_FOREGROUND (lface
)));
3735 XrmPutLineResource (&rdb
, line
);
3736 sprintf (line
, "%s.pane.menubar*foreground: %s",
3737 myname
, SDATA (LFACE_FOREGROUND (lface
)));
3738 XrmPutLineResource (&rdb
, line
);
3742 if (STRINGP (LFACE_BACKGROUND (lface
)))
3744 sprintf (line
, "%s.%s*background: %s",
3746 SDATA (LFACE_BACKGROUND (lface
)));
3747 XrmPutLineResource (&rdb
, line
);
3748 sprintf (line
, "%s.pane.menubar*background: %s",
3749 myname
, SDATA (LFACE_BACKGROUND (lface
)));
3750 XrmPutLineResource (&rdb
, line
);
3755 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
3756 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
3757 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3758 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
3759 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
3761 Lisp_Object xlfd
= Ffont_xlfd_name (LFACE_FONT (lface
));
3763 const char *suffix
= "List";
3766 #if defined HAVE_X_I18N
3768 const char *suffix
= "Set";
3770 const char *suffix
= "";
3777 #if defined HAVE_X_I18N
3778 extern char *xic_create_fontsetname
3779 P_ ((char *base_fontname
, Bool motif
));
3780 char *fontsetname
= xic_create_fontsetname (SDATA (xlfd
), motif
);
3782 char *fontsetname
= (char *) SDATA (xlfd
);
3784 sprintf (line
, "%s.pane.menubar*font%s: %s",
3785 myname
, suffix
, fontsetname
);
3786 XrmPutLineResource (&rdb
, line
);
3787 sprintf (line
, "%s.%s*font%s: %s",
3788 myname
, popup_path
, suffix
, fontsetname
);
3789 XrmPutLineResource (&rdb
, line
);
3791 if (fontsetname
!= (char *) SDATA (xlfd
))
3792 xfree (fontsetname
);
3796 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
3797 free_frame_menubar (f
);
3801 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
3804 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
3805 Sface_attribute_relative_p
,
3807 doc
: /* Check whether a face attribute value is relative.
3808 Specifically, this function returns t if the attribute ATTRIBUTE
3809 with the value VALUE is relative.
3811 A relative value is one that doesn't entirely override whatever is
3812 inherited from another face. For most possible attributes,
3813 the only relative value that users see is `unspecified'.
3814 However, for :height, floating point values are also relative. */)
3816 Lisp_Object attribute
, value
;
3818 if (EQ (value
, Qunspecified
) || (EQ (value
, Qignore_defface
)))
3820 else if (EQ (attribute
, QCheight
))
3821 return INTEGERP (value
) ? Qnil
: Qt
;
3826 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
3828 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
3829 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
3830 the result will be absolute, otherwise it will be relative. */)
3831 (attribute
, value1
, value2
)
3832 Lisp_Object attribute
, value1
, value2
;
3834 if (EQ (value1
, Qunspecified
) || EQ (value1
, Qignore_defface
))
3836 else if (EQ (attribute
, QCheight
))
3837 return merge_face_heights (value1
, value2
, value1
);
3843 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
3844 Sinternal_get_lisp_face_attribute
,
3846 doc
: /* Return face attribute KEYWORD of face SYMBOL.
3847 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
3848 face attribute name, signal an error.
3849 If the optional argument FRAME is given, report on face SYMBOL in that
3850 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
3851 frames). If FRAME is omitted or nil, use the selected frame. */)
3852 (symbol
, keyword
, frame
)
3853 Lisp_Object symbol
, keyword
, frame
;
3855 Lisp_Object lface
, value
= Qnil
;
3857 CHECK_SYMBOL (symbol
);
3858 CHECK_SYMBOL (keyword
);
3861 lface
= lface_from_face_name (NULL
, symbol
, 1);
3865 frame
= selected_frame
;
3866 CHECK_LIVE_FRAME (frame
);
3867 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
3870 if (EQ (keyword
, QCfamily
))
3871 value
= LFACE_FAMILY (lface
);
3872 else if (EQ (keyword
, QCheight
))
3873 value
= LFACE_HEIGHT (lface
);
3874 else if (EQ (keyword
, QCweight
))
3875 value
= LFACE_WEIGHT (lface
);
3876 else if (EQ (keyword
, QCslant
))
3877 value
= LFACE_SLANT (lface
);
3878 else if (EQ (keyword
, QCunderline
))
3879 value
= LFACE_UNDERLINE (lface
);
3880 else if (EQ (keyword
, QCoverline
))
3881 value
= LFACE_OVERLINE (lface
);
3882 else if (EQ (keyword
, QCstrike_through
))
3883 value
= LFACE_STRIKE_THROUGH (lface
);
3884 else if (EQ (keyword
, QCbox
))
3885 value
= LFACE_BOX (lface
);
3886 else if (EQ (keyword
, QCinverse_video
)
3887 || EQ (keyword
, QCreverse_video
))
3888 value
= LFACE_INVERSE (lface
);
3889 else if (EQ (keyword
, QCforeground
))
3890 value
= LFACE_FOREGROUND (lface
);
3891 else if (EQ (keyword
, QCbackground
))
3892 value
= LFACE_BACKGROUND (lface
);
3893 else if (EQ (keyword
, QCstipple
))
3894 value
= LFACE_STIPPLE (lface
);
3895 else if (EQ (keyword
, QCwidth
))
3896 value
= LFACE_SWIDTH (lface
);
3897 else if (EQ (keyword
, QCinherit
))
3898 value
= LFACE_INHERIT (lface
);
3899 else if (EQ (keyword
, QCfont
))
3900 value
= LFACE_FONT (lface
);
3901 else if (EQ (keyword
, QCfontset
))
3902 value
= LFACE_FONTSET (lface
);
3904 signal_error ("Invalid face attribute name", keyword
);
3906 if (IGNORE_DEFFACE_P (value
))
3907 return Qunspecified
;
3913 DEFUN ("internal-lisp-face-attribute-values",
3914 Finternal_lisp_face_attribute_values
,
3915 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
3916 doc
: /* Return a list of valid discrete values for face attribute ATTR.
3917 Value is nil if ATTR doesn't have a discrete set of valid values. */)
3921 Lisp_Object result
= Qnil
;
3923 CHECK_SYMBOL (attr
);
3925 if (EQ (attr
, QCunderline
))
3926 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3927 else if (EQ (attr
, QCoverline
))
3928 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3929 else if (EQ (attr
, QCstrike_through
))
3930 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3931 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
3932 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
3938 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
3939 Sinternal_merge_in_global_face
, 2, 2, 0,
3940 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
3941 Default face attributes override any local face attributes. */)
3943 Lisp_Object face
, frame
;
3946 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
3948 CHECK_LIVE_FRAME (frame
);
3949 global_lface
= lface_from_face_name (NULL
, face
, 1);
3950 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3951 if (NILP (local_lface
))
3952 local_lface
= Finternal_make_lisp_face (face
, frame
);
3954 /* Make every specified global attribute override the local one.
3955 BEWARE!! This is only used from `face-set-after-frame-default' where
3956 the local frame is defined from default specs in `face-defface-spec'
3957 and those should be overridden by global settings. Hence the strange
3958 "global before local" priority. */
3959 lvec
= XVECTOR (local_lface
)->contents
;
3960 gvec
= XVECTOR (global_lface
)->contents
;
3961 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3962 if (! UNSPECIFIEDP (gvec
[i
]))
3964 if (IGNORE_DEFFACE_P (gvec
[i
]))
3965 lvec
[i
] = Qunspecified
;
3974 /* The following function is implemented for compatibility with 20.2.
3975 The function is used in x-resolve-fonts when it is asked to
3976 return fonts with the same size as the font of a face. This is
3977 done in fontset.el. */
3979 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
3980 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
3981 The font name is, by default, for ASCII characters.
3982 If the optional argument FRAME is given, report on face FACE in that frame.
3983 If FRAME is t, report on the defaults for face FACE (for new frames).
3984 The font default for a face is either nil, or a list
3985 of the form (bold), (italic) or (bold italic).
3986 If FRAME is omitted or nil, use the selected frame. And, in this case,
3987 if the optional third argument CHARACTER is given,
3988 return the font name used for CHARACTER. */)
3989 (face
, frame
, character
)
3990 Lisp_Object face
, frame
, character
;
3994 Lisp_Object result
= Qnil
;
3995 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
3997 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
3998 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
3999 result
= Fcons (Qbold
, result
);
4001 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4002 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4003 result
= Fcons (Qitalic
, result
);
4009 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4010 int face_id
= lookup_named_face (f
, face
, 1);
4011 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4015 #ifdef HAVE_WINDOW_SYSTEM
4016 if (FRAME_WINDOW_P (f
) && !NILP (character
))
4018 CHECK_CHARACTER (character
);
4019 face_id
= FACE_FOR_CHAR (f
, face
, XINT (character
), -1, Qnil
);
4020 face
= FACE_FROM_ID (f
, face_id
);
4024 ? face
->font
->props
[FONT_NAME_INDEX
]
4030 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
4031 all attributes are `equal'. Tries to be fast because this function
4032 is called quite often. */
4035 face_attr_equal_p (v1
, v2
)
4038 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4039 and the other is specified. */
4040 if (XTYPE (v1
) != XTYPE (v2
))
4049 if (SBYTES (v1
) != SBYTES (v2
))
4052 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
4059 return !NILP (Fequal (v1
, v2
));
4064 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4065 all attributes are `equal'. Tries to be fast because this function
4066 is called quite often. */
4069 lface_equal_p (v1
, v2
)
4070 Lisp_Object
*v1
, *v2
;
4074 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4075 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
4081 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4082 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4083 doc
: /* True if FACE1 and FACE2 are equal.
4084 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
4085 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
4086 If FRAME is omitted or nil, use the selected frame. */)
4087 (face1
, face2
, frame
)
4088 Lisp_Object face1
, face2
, frame
;
4092 Lisp_Object lface1
, lface2
;
4097 /* Don't use check_x_frame here because this function is called
4098 before X frames exist. At that time, if FRAME is nil,
4099 selected_frame will be used which is the frame dumped with
4100 Emacs. That frame is not an X frame. */
4101 f
= frame_or_selected_frame (frame
, 2);
4103 lface1
= lface_from_face_name (f
, face1
, 1);
4104 lface2
= lface_from_face_name (f
, face2
, 1);
4105 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4106 XVECTOR (lface2
)->contents
);
4107 return equal_p
? Qt
: Qnil
;
4111 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4112 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4113 doc
: /* True if FACE has no attribute specified.
4114 If the optional argument FRAME is given, report on face FACE in that frame.
4115 If FRAME is t, report on the defaults for face FACE (for new frames).
4116 If FRAME is omitted or nil, use the selected frame. */)
4118 Lisp_Object face
, frame
;
4125 frame
= selected_frame
;
4126 CHECK_LIVE_FRAME (frame
);
4130 lface
= lface_from_face_name (NULL
, face
, 1);
4132 lface
= lface_from_face_name (f
, face
, 1);
4134 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4135 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4138 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4142 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4144 doc
: /* Return an alist of frame-local faces defined on FRAME.
4145 For internal use only. */)
4149 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4150 return f
->face_alist
;
4154 /* Return a hash code for Lisp string STRING with case ignored. Used
4155 below in computing a hash value for a Lisp face. */
4157 static INLINE
unsigned
4158 hash_string_case_insensitive (string
)
4161 const unsigned char *s
;
4163 xassert (STRINGP (string
));
4164 for (s
= SDATA (string
); *s
; ++s
)
4165 hash
= (hash
<< 1) ^ tolower (*s
);
4170 /* Return a hash code for face attribute vector V. */
4172 static INLINE
unsigned
4176 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4177 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4178 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4179 ^ XHASH (v
[LFACE_WEIGHT_INDEX
])
4180 ^ XHASH (v
[LFACE_SLANT_INDEX
])
4181 ^ XHASH (v
[LFACE_SWIDTH_INDEX
])
4182 ^ XHASH (v
[LFACE_HEIGHT_INDEX
]));
4186 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4187 considering charsets/registries). They do if they specify the same
4188 family, point size, weight, width, slant, and font. Both
4189 LFACE1 and LFACE2 must be fully-specified. */
4192 lface_same_font_attributes_p (lface1
, lface2
)
4193 Lisp_Object
*lface1
, *lface2
;
4195 xassert (lface_fully_specified_p (lface1
)
4196 && lface_fully_specified_p (lface2
));
4197 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
4198 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4199 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4200 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4201 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4202 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4203 && EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4204 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
4205 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
4206 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
4207 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
4208 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
4214 /***********************************************************************
4216 ***********************************************************************/
4218 /* Allocate and return a new realized face for Lisp face attribute
4221 static struct face
*
4222 make_realized_face (attr
)
4225 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4226 bzero (face
, sizeof *face
);
4227 face
->ascii_face
= face
;
4228 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4233 /* Free realized face FACE, including its X resources. FACE may
4237 free_realized_face (f
, face
)
4243 #ifdef HAVE_WINDOW_SYSTEM
4244 if (FRAME_WINDOW_P (f
))
4246 /* Free fontset of FACE if it is ASCII face. */
4247 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4248 free_face_fontset (f
, face
);
4253 font_done_for_face (f
, face
);
4254 x_free_gc (f
, face
->gc
);
4259 free_face_colors (f
, face
);
4260 x_destroy_bitmap (f
, face
->stipple
);
4262 #endif /* HAVE_WINDOW_SYSTEM */
4269 /* Prepare face FACE for subsequent display on frame F. This
4270 allocated GCs if they haven't been allocated yet or have been freed
4271 by clearing the face cache. */
4274 prepare_face_for_display (f
, face
)
4278 #ifdef HAVE_WINDOW_SYSTEM
4279 xassert (FRAME_WINDOW_P (f
));
4284 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4286 xgcv
.foreground
= face
->foreground
;
4287 xgcv
.background
= face
->background
;
4288 #ifdef HAVE_X_WINDOWS
4289 xgcv
.graphics_exposures
= False
;
4293 #ifdef HAVE_X_WINDOWS
4296 xgcv
.fill_style
= FillOpaqueStippled
;
4297 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4298 mask
|= GCFillStyle
| GCStipple
;
4301 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4303 font_prepare_for_face (f
, face
);
4306 #endif /* HAVE_WINDOW_SYSTEM */
4310 /* Returns the `distance' between the colors X and Y. */
4313 color_distance (x
, y
)
4316 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
4317 Quoting from that paper:
4319 This formula has results that are very close to L*u*v* (with the
4320 modified lightness curve) and, more importantly, it is a more even
4321 algorithm: it does not have a range of colours where it suddenly
4322 gives far from optimal results.
4324 See <http://www.compuphase.com/cmetric.htm> for more info. */
4326 long r
= (x
->red
- y
->red
) >> 8;
4327 long g
= (x
->green
- y
->green
) >> 8;
4328 long b
= (x
->blue
- y
->blue
) >> 8;
4329 long r_mean
= (x
->red
+ y
->red
) >> 9;
4332 (((512 + r_mean
) * r
* r
) >> 8)
4334 + (((767 - r_mean
) * b
* b
) >> 8);
4338 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
4339 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
4340 COLOR1 and COLOR2 may be either strings containing the color name,
4341 or lists of the form (RED GREEN BLUE).
4342 If FRAME is unspecified or nil, the current frame is used. */)
4343 (color1
, color2
, frame
)
4344 Lisp_Object color1
, color2
, frame
;
4347 XColor cdef1
, cdef2
;
4350 frame
= selected_frame
;
4351 CHECK_LIVE_FRAME (frame
);
4354 if (!(CONSP (color1
) && parse_rgb_list (color1
, &cdef1
))
4355 && !(STRINGP (color1
) && defined_color (f
, SDATA (color1
), &cdef1
, 0)))
4356 signal_error ("Invalid color", color1
);
4357 if (!(CONSP (color2
) && parse_rgb_list (color2
, &cdef2
))
4358 && !(STRINGP (color2
) && defined_color (f
, SDATA (color2
), &cdef2
, 0)))
4359 signal_error ("Invalid color", color2
);
4361 return make_number (color_distance (&cdef1
, &cdef2
));
4365 /***********************************************************************
4367 ***********************************************************************/
4369 /* Return a new face cache for frame F. */
4371 static struct face_cache
*
4375 struct face_cache
*c
;
4378 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4379 bzero (c
, sizeof *c
);
4380 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4381 c
->buckets
= (struct face
**) xmalloc (size
);
4382 bzero (c
->buckets
, size
);
4384 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4386 c
->menu_face_changed_p
= menu_face_changed_default
;
4391 /* Clear out all graphics contexts for all realized faces, except for
4392 the basic faces. This should be done from time to time just to avoid
4393 keeping too many graphics contexts that are no longer needed. */
4397 struct face_cache
*c
;
4399 if (c
&& FRAME_WINDOW_P (c
->f
))
4401 #ifdef HAVE_WINDOW_SYSTEM
4403 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4405 struct face
*face
= c
->faces_by_id
[i
];
4406 if (face
&& face
->gc
)
4410 font_done_for_face (c
->f
, face
);
4411 x_free_gc (c
->f
, face
->gc
);
4416 #endif /* HAVE_WINDOW_SYSTEM */
4421 /* Free all realized faces in face cache C, including basic faces.
4422 C may be null. If faces are freed, make sure the frame's current
4423 matrix is marked invalid, so that a display caused by an expose
4424 event doesn't try to use faces we destroyed. */
4427 free_realized_faces (c
)
4428 struct face_cache
*c
;
4433 struct frame
*f
= c
->f
;
4435 /* We must block input here because we can't process X events
4436 safely while only some faces are freed, or when the frame's
4437 current matrix still references freed faces. */
4440 for (i
= 0; i
< c
->used
; ++i
)
4442 free_realized_face (f
, c
->faces_by_id
[i
]);
4443 c
->faces_by_id
[i
] = NULL
;
4447 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4448 bzero (c
->buckets
, size
);
4450 /* Must do a thorough redisplay the next time. Mark current
4451 matrices as invalid because they will reference faces freed
4452 above. This function is also called when a frame is
4453 destroyed. In this case, the root window of F is nil. */
4454 if (WINDOWP (f
->root_window
))
4456 clear_current_matrices (f
);
4457 ++windows_or_buffers_changed
;
4465 /* Free all realized faces that are using FONTSET on frame F. */
4468 free_realized_faces_for_fontset (f
, fontset
)
4472 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4476 /* We must block input here because we can't process X events safely
4477 while only some faces are freed, or when the frame's current
4478 matrix still references freed faces. */
4481 for (i
= 0; i
< cache
->used
; i
++)
4483 face
= cache
->faces_by_id
[i
];
4485 && face
->fontset
== fontset
)
4487 uncache_face (cache
, face
);
4488 free_realized_face (f
, face
);
4492 /* Must do a thorough redisplay the next time. Mark current
4493 matrices as invalid because they will reference faces freed
4494 above. This function is also called when a frame is destroyed.
4495 In this case, the root window of F is nil. */
4496 if (WINDOWP (f
->root_window
))
4498 clear_current_matrices (f
);
4499 ++windows_or_buffers_changed
;
4506 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
4507 This is done after attributes of a named face have been changed,
4508 because we can't tell which realized faces depend on that face. */
4511 free_all_realized_faces (frame
)
4517 FOR_EACH_FRAME (rest
, frame
)
4518 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4521 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
4525 /* Free face cache C and faces in it, including their X resources. */
4529 struct face_cache
*c
;
4533 free_realized_faces (c
);
4535 xfree (c
->faces_by_id
);
4541 /* Cache realized face FACE in face cache C. HASH is the hash value
4542 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
4543 FACE), insert the new face to the beginning of the collision list
4544 of the face hash table of C. Otherwise, add the new face to the
4545 end of the collision list. This way, lookup_face can quickly find
4546 that a requested face is not cached. */
4549 cache_face (c
, face
, hash
)
4550 struct face_cache
*c
;
4554 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4558 if (face
->ascii_face
!= face
)
4560 struct face
*last
= c
->buckets
[i
];
4571 c
->buckets
[i
] = face
;
4572 face
->prev
= face
->next
= NULL
;
4578 face
->next
= c
->buckets
[i
];
4580 face
->next
->prev
= face
;
4581 c
->buckets
[i
] = face
;
4584 /* Find a free slot in C->faces_by_id and use the index of the free
4585 slot as FACE->id. */
4586 for (i
= 0; i
< c
->used
; ++i
)
4587 if (c
->faces_by_id
[i
] == NULL
)
4591 /* Maybe enlarge C->faces_by_id. */
4594 if (c
->used
== c
->size
)
4597 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
4598 if (new_size
== c
->size
)
4599 abort (); /* Alternatives? ++kfs */
4600 sz
= new_size
* sizeof *c
->faces_by_id
;
4601 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
4608 /* Check that FACE got a unique id. */
4613 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
4614 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
4620 #endif /* GLYPH_DEBUG */
4622 c
->faces_by_id
[i
] = face
;
4626 /* Remove face FACE from cache C. */
4629 uncache_face (c
, face
)
4630 struct face_cache
*c
;
4633 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
4636 face
->prev
->next
= face
->next
;
4638 c
->buckets
[i
] = face
->next
;
4641 face
->next
->prev
= face
->prev
;
4643 c
->faces_by_id
[face
->id
] = NULL
;
4644 if (face
->id
== c
->used
)
4649 /* Look up a realized face with face attributes ATTR in the face cache
4650 of frame F. The face will be used to display ASCII characters.
4651 Value is the ID of the face found. If no suitable face is found,
4652 realize a new one. */
4655 lookup_face (f
, attr
)
4659 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4664 xassert (cache
!= NULL
);
4665 check_lface_attrs (attr
);
4667 /* Look up ATTR in the face cache. */
4668 hash
= lface_hash (attr
);
4669 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4671 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4673 if (face
->ascii_face
!= face
)
4675 /* There's no more ASCII face. */
4679 if (face
->hash
== hash
4680 && lface_equal_p (face
->lface
, attr
))
4684 /* If not found, realize a new face. */
4686 face
= realize_face (cache
, attr
, -1);
4689 xassert (face
== FACE_FROM_ID (f
, face
->id
));
4690 #endif /* GLYPH_DEBUG */
4695 #ifdef HAVE_WINDOW_SYSTEM
4696 /* Look up a realized face that has the same attributes as BASE_FACE
4697 except for the font in the face cache of frame F. If FONT-OBJECT
4698 is not nil, it is an already opened font. If FONT-OBJECT is nil,
4699 the face has no font. Value is the ID of the face found. If no
4700 suitable face is found, realize a new one. */
4703 face_for_font (f
, font_object
, base_face
)
4705 Lisp_Object font_object
;
4706 struct face
*base_face
;
4708 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
4713 xassert (cache
!= NULL
);
4714 base_face
= base_face
->ascii_face
;
4715 hash
= lface_hash (base_face
->lface
);
4716 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
4718 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
4720 if (face
->ascii_face
== face
)
4722 if (face
->ascii_face
== base_face
4723 && face
->font
== (NILP (font_object
) ? NULL
4724 : XFONT_OBJECT (font_object
))
4725 && lface_equal_p (face
->lface
, base_face
->lface
))
4729 /* If not found, realize a new face. */
4730 face
= realize_non_ascii_face (f
, font_object
, base_face
);
4733 #endif /* HAVE_WINDOW_SYSTEM */
4735 /* Return the face id of the realized face for named face SYMBOL on
4736 frame F suitable for displaying ASCII characters. Value is -1 if
4737 the face couldn't be determined, which might happen if the default
4738 face isn't realized and cannot be realized. */
4741 lookup_named_face (f
, symbol
, signal_p
)
4746 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4747 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4748 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4750 if (default_face
== NULL
)
4752 if (!realize_basic_faces (f
))
4754 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
4755 if (default_face
== NULL
)
4756 abort (); /* realize_basic_faces must have set it up */
4759 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
))
4762 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4763 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4765 return lookup_face (f
, attrs
);
4769 /* Return the ID of the realized ASCII face of Lisp face with ID
4770 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
4773 ascii_face_of_lisp_face (f
, lface_id
)
4779 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
4781 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
4782 face_id
= lookup_named_face (f
, face_name
, 1);
4791 /* Return a face for charset ASCII that is like the face with id
4792 FACE_ID on frame F, but has a font that is STEPS steps smaller.
4793 STEPS < 0 means larger. Value is the id of the face. */
4796 smaller_face (f
, face_id
, steps
)
4800 #ifdef HAVE_WINDOW_SYSTEM
4802 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4803 int pt
, last_pt
, last_height
;
4806 struct face
*new_face
;
4808 /* If not called for an X frame, just return the original face. */
4809 if (FRAME_TERMCAP_P (f
))
4812 /* Try in increments of 1/2 pt. */
4813 delta
= steps
< 0 ? 5 : -5;
4814 steps
= eabs (steps
);
4816 face
= FACE_FROM_ID (f
, face_id
);
4817 bcopy (face
->lface
, attrs
, sizeof attrs
);
4818 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
4819 new_face_id
= face_id
;
4820 last_height
= FONT_HEIGHT (face
->font
);
4824 /* Give up if we cannot find a font within 10pt. */
4825 && eabs (last_pt
- pt
) < 100)
4827 /* Look up a face for a slightly smaller/larger font. */
4829 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
4830 new_face_id
= lookup_face (f
, attrs
);
4831 new_face
= FACE_FROM_ID (f
, new_face_id
);
4833 /* If height changes, count that as one step. */
4834 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
4835 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
4838 last_height
= FONT_HEIGHT (new_face
->font
);
4845 #else /* not HAVE_WINDOW_SYSTEM */
4849 #endif /* not HAVE_WINDOW_SYSTEM */
4853 /* Return a face for charset ASCII that is like the face with id
4854 FACE_ID on frame F, but has height HEIGHT. */
4857 face_with_height (f
, face_id
, height
)
4862 #ifdef HAVE_WINDOW_SYSTEM
4864 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4866 if (FRAME_TERMCAP_P (f
)
4870 face
= FACE_FROM_ID (f
, face_id
);
4871 bcopy (face
->lface
, attrs
, sizeof attrs
);
4872 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
4873 face_id
= lookup_face (f
, attrs
);
4874 #endif /* HAVE_WINDOW_SYSTEM */
4880 /* Return the face id of the realized face for named face SYMBOL on
4881 frame F suitable for displaying ASCII characters, and use
4882 attributes of the face FACE_ID for attributes that aren't
4883 completely specified by SYMBOL. This is like lookup_named_face,
4884 except that the default attributes come from FACE_ID, not from the
4885 default face. FACE_ID is assumed to be already realized. */
4888 lookup_derived_face (f
, symbol
, face_id
, signal_p
)
4894 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
4895 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
4896 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
4901 get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
);
4902 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
4903 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
4904 return lookup_face (f
, attrs
);
4907 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
4908 Sface_attributes_as_vector
, 1, 1, 0,
4909 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
4914 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
4916 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
4923 /***********************************************************************
4924 Face capability testing
4925 ***********************************************************************/
4928 /* If the distance (as returned by color_distance) between two colors is
4929 less than this, then they are considered the same, for determining
4930 whether a color is supported or not. The range of values is 0-65535. */
4932 #define TTY_SAME_COLOR_THRESHOLD 10000
4934 #ifdef HAVE_WINDOW_SYSTEM
4936 /* Return non-zero if all the face attributes in ATTRS are supported
4937 on the window-system frame F.
4939 The definition of `supported' is somewhat heuristic, but basically means
4940 that a face containing all the attributes in ATTRS, when merged with the
4941 default face for display, can be represented in a way that's
4943 \(1) different in appearance than the default face, and
4944 \(2) `close in spirit' to what the attributes specify, if not exact. */
4947 x_supports_face_attributes_p (f
, attrs
, def_face
)
4950 struct face
*def_face
;
4952 Lisp_Object
*def_attrs
= def_face
->lface
;
4954 /* Check that other specified attributes are different that the default
4956 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
4957 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
4958 def_attrs
[LFACE_UNDERLINE_INDEX
]))
4959 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
4960 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
4961 def_attrs
[LFACE_INVERSE_INDEX
]))
4962 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
4963 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
4964 def_attrs
[LFACE_FOREGROUND_INDEX
]))
4965 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
4966 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
4967 def_attrs
[LFACE_BACKGROUND_INDEX
]))
4968 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
4969 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
4970 def_attrs
[LFACE_STIPPLE_INDEX
]))
4971 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
4972 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
4973 def_attrs
[LFACE_OVERLINE_INDEX
]))
4974 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
4975 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
4976 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
4977 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
4978 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
4979 def_attrs
[LFACE_BOX_INDEX
])))
4982 /* Check font-related attributes, as those are the most commonly
4983 "unsupported" on a window-system (because of missing fonts). */
4984 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
4985 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
4986 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
4987 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
4988 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
]))
4992 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
4995 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
4997 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
4999 face_id
= lookup_face (f
, merged_attrs
);
5000 face
= FACE_FROM_ID (f
, face_id
);
5003 error ("Cannot make face");
5005 /* If the font is the same, then not supported. */
5006 if (face
->font
== def_face
->font
)
5008 for (i
= FONT_TYPE_INDEX
; i
<= FONT_SIZE_INDEX
; i
++)
5009 if (! EQ (face
->font
->props
[i
], def_face
->font
->props
[i
]))
5013 if (i
< FONT_FOUNDRY_INDEX
|| i
> FONT_REGISTRY_INDEX
5014 || face
->font
->driver
->case_sensitive
)
5016 s1
= SYMBOL_NAME (face
->font
->props
[i
]);
5017 s2
= SYMBOL_NAME (def_face
->font
->props
[i
]);
5018 if (! EQ (Fcompare_strings (s1
, make_number (0), Qnil
,
5019 s2
, make_number (0), Qnil
, Qt
), Qt
))
5025 /* Everything checks out, this face is supported. */
5029 #endif /* HAVE_WINDOW_SYSTEM */
5031 /* Return non-zero if all the face attributes in ATTRS are supported
5034 The definition of `supported' is somewhat heuristic, but basically means
5035 that a face containing all the attributes in ATTRS, when merged
5036 with the default face for display, can be represented in a way that's
5038 \(1) different in appearance than the default face, and
5039 \(2) `close in spirit' to what the attributes specify, if not exact.
5041 Point (2) implies that a `:weight black' attribute will be satisfied
5042 by any terminal that can display bold, and a `:foreground "yellow"' as
5043 long as the terminal can display a yellowish color, but `:slant italic'
5044 will _not_ be satisfied by the tty display code's automatic
5045 substitution of a `dim' face for italic. */
5048 tty_supports_face_attributes_p (f
, attrs
, def_face
)
5051 struct face
*def_face
;
5054 Lisp_Object val
, fg
, bg
;
5055 XColor fg_tty_color
, fg_std_color
;
5056 XColor bg_tty_color
, bg_std_color
;
5057 unsigned test_caps
= 0;
5058 Lisp_Object
*def_attrs
= def_face
->lface
;
5061 /* First check some easy-to-check stuff; ttys support none of the
5062 following attributes, so we can just return false if any are requested
5063 (even if `nominal' values are specified, we should still return false,
5064 as that will be the same value that the default face uses). We
5065 consider :slant unsupportable on ttys, even though the face code
5066 actually `fakes' them using a dim attribute if possible. This is
5067 because the faked result is too different from what the face
5069 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5070 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5071 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5072 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
5073 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5074 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5075 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5076 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
5080 /* Test for terminal `capabilities' (non-color character attributes). */
5082 /* font weight (bold/dim) */
5083 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
5086 int def_weight
= FONT_WEIGHT_NAME_NUMERIC (def_attrs
[LFACE_WEIGHT_INDEX
]);
5090 if (def_weight
> 100)
5091 return 0; /* same as default */
5092 test_caps
= TTY_CAP_BOLD
;
5094 else if (weight
< 100)
5096 if (def_weight
< 100)
5097 return 0; /* same as default */
5098 test_caps
= TTY_CAP_DIM
;
5100 else if (def_weight
== 100)
5101 return 0; /* same as default */
5105 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5106 if (!UNSPECIFIEDP (val
))
5109 return 0; /* ttys can't use colored underlines */
5110 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
5111 return 0; /* same as default */
5113 test_caps
|= TTY_CAP_UNDERLINE
;
5117 val
= attrs
[LFACE_INVERSE_INDEX
];
5118 if (!UNSPECIFIEDP (val
))
5120 if (face_attr_equal_p (val
, def_attrs
[LFACE_INVERSE_INDEX
]))
5121 return 0; /* same as default */
5123 test_caps
|= TTY_CAP_INVERSE
;
5127 /* Color testing. */
5129 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5130 we use them when calling `tty_capable_p' below, even if the face
5131 specifies no colors. */
5132 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5133 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5135 /* Check if foreground color is close enough. */
5136 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5139 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
5141 if (face_attr_equal_p (fg
, def_fg
))
5142 return 0; /* same as default */
5143 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5144 return 0; /* not a valid color */
5145 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5146 > TTY_SAME_COLOR_THRESHOLD
)
5147 return 0; /* displayed color is too different */
5149 /* Make sure the color is really different than the default. */
5151 XColor def_fg_color
;
5152 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
5153 && (color_distance (&fg_tty_color
, &def_fg_color
)
5154 <= TTY_SAME_COLOR_THRESHOLD
))
5159 /* Check if background color is close enough. */
5160 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5163 Lisp_Object def_bg
= def_attrs
[LFACE_BACKGROUND_INDEX
];
5165 if (face_attr_equal_p (bg
, def_bg
))
5166 return 0; /* same as default */
5167 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5168 return 0; /* not a valid color */
5169 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5170 > TTY_SAME_COLOR_THRESHOLD
)
5171 return 0; /* displayed color is too different */
5173 /* Make sure the color is really different than the default. */
5175 XColor def_bg_color
;
5176 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
5177 && (color_distance (&bg_tty_color
, &def_bg_color
)
5178 <= TTY_SAME_COLOR_THRESHOLD
))
5183 /* If both foreground and background are requested, see if the
5184 distance between them is OK. We just check to see if the distance
5185 between the tty's foreground and background is close enough to the
5186 distance between the standard foreground and background. */
5187 if (STRINGP (fg
) && STRINGP (bg
))
5190 = (color_distance (&fg_std_color
, &bg_std_color
)
5191 - color_distance (&fg_tty_color
, &bg_tty_color
));
5192 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5193 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5198 /* See if the capabilities we selected above are supported, with the
5200 if (test_caps
!= 0 &&
5201 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5205 /* Hmmm, everything checks out, this terminal must support this face. */
5210 DEFUN ("display-supports-face-attributes-p",
5211 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
5213 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5214 The optional argument DISPLAY can be a display name, a frame, or
5215 nil (meaning the selected frame's display).
5217 The definition of `supported' is somewhat heuristic, but basically means
5218 that a face containing all the attributes in ATTRIBUTES, when merged
5219 with the default face for display, can be represented in a way that's
5221 \(1) different in appearance than the default face, and
5222 \(2) `close in spirit' to what the attributes specify, if not exact.
5224 Point (2) implies that a `:weight black' attribute will be satisfied by
5225 any display that can display bold, and a `:foreground \"yellow\"' as long
5226 as it can display a yellowish color, but `:slant italic' will _not_ be
5227 satisfied by the tty display code's automatic substitution of a `dim'
5228 face for italic. */)
5229 (attributes
, display
)
5230 Lisp_Object attributes
, display
;
5232 int supports
= 0, i
;
5235 struct face
*def_face
;
5236 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5238 if (noninteractive
|| !initialized
)
5239 /* We may not be able to access low-level face information in batch
5240 mode, or before being dumped, and this function is not going to
5241 be very useful in those cases anyway, so just give up. */
5245 frame
= selected_frame
;
5246 else if (FRAMEP (display
))
5250 /* Find any frame on DISPLAY. */
5251 Lisp_Object fl_tail
;
5254 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
5256 frame
= XCAR (fl_tail
);
5257 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
5258 XFRAME (frame
)->param_alist
)),
5264 CHECK_LIVE_FRAME (frame
);
5267 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5268 attrs
[i
] = Qunspecified
;
5269 merge_face_ref (f
, attributes
, attrs
, 1, 0);
5271 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5272 if (def_face
== NULL
)
5274 if (! realize_basic_faces (f
))
5275 error ("Cannot realize default face");
5276 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5277 if (def_face
== NULL
)
5278 abort (); /* realize_basic_faces must have set it up */
5281 /* Dispatch to the appropriate handler. */
5282 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5283 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
5284 #ifdef HAVE_WINDOW_SYSTEM
5286 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
5289 return supports
? Qt
: Qnil
;
5293 /***********************************************************************
5295 ***********************************************************************/
5297 DEFUN ("internal-set-font-selection-order",
5298 Finternal_set_font_selection_order
,
5299 Sinternal_set_font_selection_order
, 1, 1, 0,
5300 doc
: /* Set font selection order for face font selection to ORDER.
5301 ORDER must be a list of length 4 containing the symbols `:width',
5302 `:height', `:weight', and `:slant'. Face attributes appearing
5303 first in ORDER are matched first, e.g. if `:height' appears before
5304 `:weight' in ORDER, font selection first tries to find a font with
5305 a suitable height, and then tries to match the font weight.
5312 int indices
[DIM (font_sort_order
)];
5315 bzero (indices
, sizeof indices
);
5319 CONSP (list
) && i
< DIM (indices
);
5320 list
= XCDR (list
), ++i
)
5322 Lisp_Object attr
= XCAR (list
);
5325 if (EQ (attr
, QCwidth
))
5327 else if (EQ (attr
, QCheight
))
5328 xlfd
= XLFD_POINT_SIZE
;
5329 else if (EQ (attr
, QCweight
))
5331 else if (EQ (attr
, QCslant
))
5336 if (indices
[i
] != 0)
5341 if (!NILP (list
) || i
!= DIM (indices
))
5342 signal_error ("Invalid font sort order", order
);
5343 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5344 if (indices
[i
] == 0)
5345 signal_error ("Invalid font sort order", order
);
5347 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5349 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5350 free_all_realized_faces (Qnil
);
5353 font_update_sort_order (font_sort_order
);
5359 DEFUN ("internal-set-alternative-font-family-alist",
5360 Finternal_set_alternative_font_family_alist
,
5361 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5362 doc
: /* Define alternative font families to try in face font selection.
5363 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5364 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5365 be found. Value is ALIST. */)
5370 Vface_alternative_font_family_alist
= alist
;
5371 free_all_realized_faces (Qnil
);
5376 DEFUN ("internal-set-alternative-font-registry-alist",
5377 Finternal_set_alternative_font_registry_alist
,
5378 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5379 doc
: /* Define alternative font registries to try in face font selection.
5380 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5381 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5382 be found. Value is ALIST. */)
5387 Vface_alternative_font_registry_alist
= alist
;
5388 free_all_realized_faces (Qnil
);
5393 #ifdef HAVE_WINDOW_SYSTEM
5395 /* Ignore the difference of font point size less than this value. */
5397 #define FONT_POINT_SIZE_QUANTUM 5
5399 /* Return the fontset id of the base fontset name or alias name given
5400 by the fontset attribute of ATTRS. Value is -1 if the fontset
5401 attribute of ATTRS doesn't name a fontset. */
5404 face_fontset (attrs
)
5409 name
= attrs
[LFACE_FONTSET_INDEX
];
5410 if (!STRINGP (name
))
5412 return fs_query_fontset (name
, 0);
5415 #endif /* HAVE_WINDOW_SYSTEM */
5419 /***********************************************************************
5421 ***********************************************************************/
5423 /* Realize basic faces on frame F. Value is zero if frame parameters
5424 of F don't contain enough information needed to realize the default
5428 realize_basic_faces (f
)
5432 int count
= SPECPDL_INDEX ();
5434 /* Block input here so that we won't be surprised by an X expose
5435 event, for instance, without having the faces set up. */
5437 specbind (Qscalable_fonts_allowed
, Qt
);
5439 if (realize_default_face (f
))
5441 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5442 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
5443 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5444 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
5445 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5446 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5447 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5448 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5449 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5450 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5451 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
5453 /* Reflect changes in the `menu' face in menu bars. */
5454 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
5456 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
5457 #ifdef USE_X_TOOLKIT
5458 if (FRAME_WINDOW_P (f
))
5459 x_update_menu_appearance (f
);
5466 unbind_to (count
, Qnil
);
5472 /* Realize the default face on frame F. If the face is not fully
5473 specified, make it fully-specified. Attributes of the default face
5474 that are not explicitly specified are taken from frame parameters. */
5477 realize_default_face (f
)
5480 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5482 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5485 /* If the `default' face is not yet known, create it. */
5486 lface
= lface_from_face_name (f
, Qdefault
, 0);
5490 XSETFRAME (frame
, f
);
5491 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5494 #ifdef HAVE_WINDOW_SYSTEM
5495 if (FRAME_WINDOW_P (f
))
5497 Lisp_Object font_object
;
5499 XSETFONT (font_object
, FRAME_FONT (f
));
5500 set_lface_from_font (f
, lface
, font_object
, f
->default_face_done_p
);
5501 LFACE_FONTSET (lface
) = fontset_name (FRAME_FONTSET (f
));
5502 f
->default_face_done_p
= 1;
5504 #endif /* HAVE_WINDOW_SYSTEM */
5506 if (!FRAME_WINDOW_P (f
))
5508 LFACE_FAMILY (lface
) = build_string ("default");
5509 LFACE_SWIDTH (lface
) = Qnormal
;
5510 LFACE_HEIGHT (lface
) = make_number (1);
5511 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
5512 LFACE_WEIGHT (lface
) = Qnormal
;
5513 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
5514 LFACE_SLANT (lface
) = Qnormal
;
5517 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5518 LFACE_UNDERLINE (lface
) = Qnil
;
5520 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5521 LFACE_OVERLINE (lface
) = Qnil
;
5523 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
5524 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
5526 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
5527 LFACE_BOX (lface
) = Qnil
;
5529 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
5530 LFACE_INVERSE (lface
) = Qnil
;
5532 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
5534 /* This function is called so early that colors are not yet
5535 set in the frame parameter list. */
5536 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
5538 if (CONSP (color
) && STRINGP (XCDR (color
)))
5539 LFACE_FOREGROUND (lface
) = XCDR (color
);
5540 else if (FRAME_WINDOW_P (f
))
5542 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5543 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
5548 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
5550 /* This function is called so early that colors are not yet
5551 set in the frame parameter list. */
5552 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
5553 if (CONSP (color
) && STRINGP (XCDR (color
)))
5554 LFACE_BACKGROUND (lface
) = XCDR (color
);
5555 else if (FRAME_WINDOW_P (f
))
5557 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
5558 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
5563 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
5564 LFACE_STIPPLE (lface
) = Qnil
;
5566 /* Realize the face; it must be fully-specified now. */
5567 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
5568 check_lface (lface
);
5569 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
5570 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
5572 #ifdef HAVE_WINDOW_SYSTEM
5573 #ifdef HAVE_X_WINDOWS
5574 if (FRAME_X_P (f
) && face
->font
!= FRAME_FONT (f
))
5576 /* This can happen when making a frame on a display that does
5577 not support the default font. */
5581 /* Otherwise, the font specified for the frame was not
5582 acceptable as a font for the default face (perhaps because
5583 auto-scaled fonts are rejected), so we must adjust the frame
5585 x_set_font (f
, LFACE_FONT (lface
), Qnil
);
5587 #endif /* HAVE_X_WINDOWS */
5588 #endif /* HAVE_WINDOW_SYSTEM */
5593 /* Realize basic faces other than the default face in face cache C.
5594 SYMBOL is the face name, ID is the face id the realized face must
5595 have. The default face must have been realized already. */
5598 realize_named_face (f
, symbol
, id
)
5603 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5604 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
5605 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5606 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5607 struct face
*new_face
;
5609 /* The default face must exist and be fully specified. */
5610 get_lface_attributes (f
, Qdefault
, attrs
, 1);
5611 check_lface_attrs (attrs
);
5612 xassert (lface_fully_specified_p (attrs
));
5614 /* If SYMBOL isn't know as a face, create it. */
5618 XSETFRAME (frame
, f
);
5619 lface
= Finternal_make_lisp_face (symbol
, frame
);
5622 /* Merge SYMBOL's face with the default face. */
5623 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5624 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5626 /* Realize the face. */
5627 new_face
= realize_face (c
, attrs
, id
);
5631 /* Realize the fully-specified face with attributes ATTRS in face
5632 cache CACHE for ASCII characters. If FORMER_FACE_ID is
5633 non-negative, it is an ID of face to remove before caching the new
5634 face. Value is a pointer to the newly created realized face. */
5636 static struct face
*
5637 realize_face (cache
, attrs
, former_face_id
)
5638 struct face_cache
*cache
;
5644 /* LFACE must be fully specified. */
5645 xassert (cache
!= NULL
);
5646 check_lface_attrs (attrs
);
5648 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
5650 /* Remove the former face. */
5651 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
5652 uncache_face (cache
, former_face
);
5653 free_realized_face (cache
->f
, former_face
);
5656 if (FRAME_WINDOW_P (cache
->f
))
5657 face
= realize_x_face (cache
, attrs
);
5658 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
5659 face
= realize_tty_face (cache
, attrs
);
5660 else if (FRAME_INITIAL_P (cache
->f
))
5662 /* Create a dummy face. */
5663 face
= make_realized_face (attrs
);
5668 /* Insert the new face. */
5669 cache_face (cache
, face
, lface_hash (attrs
));
5674 #ifdef HAVE_WINDOW_SYSTEM
5675 /* Realize the fully-specified face that uses FONT-OBJECT and has the
5676 same attributes as BASE_FACE except for the font on frame F.
5677 FONT-OBJECT may be nil, in which case, realized a face of
5680 static struct face
*
5681 realize_non_ascii_face (f
, font_object
, base_face
)
5683 Lisp_Object font_object
;
5684 struct face
*base_face
;
5686 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5689 face
= (struct face
*) xmalloc (sizeof *face
);
5694 = (! NILP (font_object
)
5695 && FONT_WEIGHT_NAME_NUMERIC (face
->lface
[LFACE_WEIGHT_INDEX
]) > 100
5696 && FONT_WEIGHT_NUMERIC (font_object
) <= 100);
5698 /* Don't try to free the colors copied bitwise from BASE_FACE. */
5699 face
->colors_copied_bitwise_p
= 1;
5700 face
->font
= NILP (font_object
) ? NULL
: XFONT_OBJECT (font_object
);
5703 cache_face (cache
, face
, face
->hash
);
5707 #endif /* HAVE_WINDOW_SYSTEM */
5710 /* Realize the fully-specified face with attributes ATTRS in face
5711 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
5712 the new face doesn't share font with the default face, a fontname
5713 is allocated from the heap and set in `font_name' of the new face,
5714 but it is not yet loaded here. Value is a pointer to the newly
5715 created realized face. */
5717 static struct face
*
5718 realize_x_face (cache
, attrs
)
5719 struct face_cache
*cache
;
5722 struct face
*face
= NULL
;
5723 #ifdef HAVE_WINDOW_SYSTEM
5724 struct face
*default_face
;
5726 Lisp_Object stipple
, overline
, strike_through
, box
;
5728 xassert (FRAME_WINDOW_P (cache
->f
));
5730 /* Allocate a new realized face. */
5731 face
= make_realized_face (attrs
);
5732 face
->ascii_face
= face
;
5736 /* Determine the font to use. Most of the time, the font will be
5737 the same as the font of the default face, so try that first. */
5738 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5740 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
5742 face
->font
= default_face
->font
;
5743 face
->fontset
= make_fontset_for_ascii_face (f
, -1, face
);
5747 /* If the face attribute ATTRS specifies a fontset, use it as
5748 the base of a new realized fontset. Otherwise, use the same
5749 base fontset as of the default face. The base determines
5750 registry and encoding of a font. It may also determine
5751 foundry and family. The other fields of font name pattern
5752 are constructed from ATTRS. */
5753 int fontset
= face_fontset (attrs
);
5755 /* If we are realizing the default face, ATTRS should specify a
5756 fontset. In other words, if FONTSET is -1, we are not
5757 realizing the default face, thus the default face should have
5758 already been realized. */
5760 fontset
= default_face
->fontset
;
5763 if (! FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5764 attrs
[LFACE_FONT_INDEX
]
5765 = font_load_for_lface (f
, attrs
, attrs
[LFACE_FONT_INDEX
]);
5766 if (FONT_OBJECT_P (attrs
[LFACE_FONT_INDEX
]))
5768 face
->font
= XFONT_OBJECT (attrs
[LFACE_FONT_INDEX
]);
5769 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
5779 && FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]) > 100
5780 && FONT_WEIGHT_NUMERIC (attrs
[LFACE_FONT_INDEX
]) <= 100)
5781 face
->overstrike
= 1;
5783 /* Load colors, and set remaining attributes. */
5785 load_face_colors (f
, face
, attrs
);
5788 box
= attrs
[LFACE_BOX_INDEX
];
5791 /* A simple box of line width 1 drawn in color given by
5793 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
5795 face
->box
= FACE_SIMPLE_BOX
;
5796 face
->box_line_width
= 1;
5798 else if (INTEGERP (box
))
5800 /* Simple box of specified line width in foreground color of the
5802 xassert (XINT (box
) != 0);
5803 face
->box
= FACE_SIMPLE_BOX
;
5804 face
->box_line_width
= XINT (box
);
5805 face
->box_color
= face
->foreground
;
5806 face
->box_color_defaulted_p
= 1;
5808 else if (CONSP (box
))
5810 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
5811 being one of `raised' or `sunken'. */
5812 face
->box
= FACE_SIMPLE_BOX
;
5813 face
->box_color
= face
->foreground
;
5814 face
->box_color_defaulted_p
= 1;
5815 face
->box_line_width
= 1;
5819 Lisp_Object keyword
, value
;
5821 keyword
= XCAR (box
);
5829 if (EQ (keyword
, QCline_width
))
5831 if (INTEGERP (value
) && XINT (value
) != 0)
5832 face
->box_line_width
= XINT (value
);
5834 else if (EQ (keyword
, QCcolor
))
5836 if (STRINGP (value
))
5838 face
->box_color
= load_color (f
, face
, value
,
5840 face
->use_box_color_for_shadows_p
= 1;
5843 else if (EQ (keyword
, QCstyle
))
5845 if (EQ (value
, Qreleased_button
))
5846 face
->box
= FACE_RAISED_BOX
;
5847 else if (EQ (value
, Qpressed_button
))
5848 face
->box
= FACE_SUNKEN_BOX
;
5853 /* Text underline, overline, strike-through. */
5855 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
5857 /* Use default color (same as foreground color). */
5858 face
->underline_p
= 1;
5859 face
->underline_defaulted_p
= 1;
5860 face
->underline_color
= 0;
5862 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
5864 /* Use specified color. */
5865 face
->underline_p
= 1;
5866 face
->underline_defaulted_p
= 0;
5867 face
->underline_color
5868 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
5869 LFACE_UNDERLINE_INDEX
);
5871 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
5873 face
->underline_p
= 0;
5874 face
->underline_defaulted_p
= 0;
5875 face
->underline_color
= 0;
5878 overline
= attrs
[LFACE_OVERLINE_INDEX
];
5879 if (STRINGP (overline
))
5881 face
->overline_color
5882 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
5883 LFACE_OVERLINE_INDEX
);
5884 face
->overline_p
= 1;
5886 else if (EQ (overline
, Qt
))
5888 face
->overline_color
= face
->foreground
;
5889 face
->overline_color_defaulted_p
= 1;
5890 face
->overline_p
= 1;
5893 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5894 if (STRINGP (strike_through
))
5896 face
->strike_through_color
5897 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5898 LFACE_STRIKE_THROUGH_INDEX
);
5899 face
->strike_through_p
= 1;
5901 else if (EQ (strike_through
, Qt
))
5903 face
->strike_through_color
= face
->foreground
;
5904 face
->strike_through_color_defaulted_p
= 1;
5905 face
->strike_through_p
= 1;
5908 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
5909 if (!NILP (stipple
))
5910 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
5911 #endif /* HAVE_WINDOW_SYSTEM */
5917 /* Map a specified color of face FACE on frame F to a tty color index.
5918 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
5919 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
5920 default foreground/background colors. */
5923 map_tty_color (f
, face
, idx
, defaulted
)
5926 enum lface_attribute_index idx
;
5929 Lisp_Object frame
, color
, def
;
5930 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
5931 unsigned long default_pixel
, default_other_pixel
, pixel
;
5933 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
5937 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5938 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5942 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5943 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5946 XSETFRAME (frame
, f
);
5947 color
= face
->lface
[idx
];
5951 && CONSP (Vtty_defined_color_alist
)
5952 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
5955 /* Associations in tty-defined-color-alist are of the form
5956 (NAME INDEX R G B). We need the INDEX part. */
5957 pixel
= XINT (XCAR (XCDR (def
)));
5960 if (pixel
== default_pixel
&& STRINGP (color
))
5962 pixel
= load_color (f
, face
, color
, idx
);
5965 /* If the foreground of the default face is the default color,
5966 use the foreground color defined by the frame. */
5967 if (FRAME_MSDOS_P (f
))
5969 if (pixel
== default_pixel
5970 || pixel
== FACE_TTY_DEFAULT_COLOR
)
5973 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5975 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5976 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5979 else if (pixel
== default_other_pixel
)
5982 pixel
= FRAME_BACKGROUND_PIXEL (f
);
5984 pixel
= FRAME_FOREGROUND_PIXEL (f
);
5985 face
->lface
[idx
] = tty_color_name (f
, pixel
);
5993 face
->foreground
= pixel
;
5995 face
->background
= pixel
;
5999 /* Realize the fully-specified face with attributes ATTRS in face
6000 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6001 Value is a pointer to the newly created realized face. */
6003 static struct face
*
6004 realize_tty_face (cache
, attrs
)
6005 struct face_cache
*cache
;
6010 int face_colors_defaulted
= 0;
6011 struct frame
*f
= cache
->f
;
6013 /* Frame must be a termcap frame. */
6014 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6016 /* Allocate a new realized face. */
6017 face
= make_realized_face (attrs
);
6019 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6022 /* Map face attributes to TTY appearances. We map slant to
6023 dimmed text because we want italic text to appear differently
6024 and because dimmed text is probably used infrequently. */
6025 weight
= FONT_WEIGHT_NAME_NUMERIC (attrs
[LFACE_WEIGHT_INDEX
]);
6026 slant
= FONT_SLANT_NAME_NUMERIC (attrs
[LFACE_SLANT_INDEX
]);
6028 face
->tty_bold_p
= 1;
6029 if (weight
< 100 || slant
!= 100)
6030 face
->tty_dim_p
= 1;
6031 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6032 face
->tty_underline_p
= 1;
6033 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6034 face
->tty_reverse_p
= 1;
6036 /* Map color names to color indices. */
6037 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6038 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6040 /* Swap colors if face is inverse-video. If the colors are taken
6041 from the frame colors, they are already inverted, since the
6042 frame-creation function calls x-handle-reverse-video. */
6043 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6045 unsigned long tem
= face
->foreground
;
6046 face
->foreground
= face
->background
;
6047 face
->background
= tem
;
6050 if (tty_suppress_bold_inverse_default_colors_p
6052 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6053 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6054 face
->tty_bold_p
= 0;
6060 DEFUN ("tty-suppress-bold-inverse-default-colors",
6061 Ftty_suppress_bold_inverse_default_colors
,
6062 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6063 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6064 SUPPRESS non-nil means suppress it.
6065 This affects bold faces on TTYs whose foreground is the default background
6066 color of the display and whose background is the default foreground color.
6067 For such faces, the bold face attribute is ignored if this variable
6070 Lisp_Object suppress
;
6072 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6073 ++face_change_count
;
6079 /***********************************************************************
6081 ***********************************************************************/
6083 /* Return the ID of the face to use to display character CH with face
6084 property PROP on frame F in current_buffer. */
6087 compute_char_face (f
, ch
, prop
)
6094 if (NILP (current_buffer
->enable_multibyte_characters
))
6099 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6100 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
6104 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6105 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6106 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6107 merge_face_ref (f
, prop
, attrs
, 1, 0);
6108 face_id
= lookup_face (f
, attrs
);
6114 /* Return the face ID associated with buffer position POS for
6115 displaying ASCII characters. Return in *ENDPTR the position at
6116 which a different face is needed, as far as text properties and
6117 overlays are concerned. W is a window displaying current_buffer.
6119 REGION_BEG, REGION_END delimit the region, so it can be
6122 LIMIT is a position not to scan beyond. That is to limit the time
6123 this function can take.
6125 If MOUSE is non-zero, use the character's mouse-face, not its face.
6127 The face returned is suitable for displaying ASCII characters. */
6130 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6131 endptr
, limit
, mouse
)
6134 EMACS_INT region_beg
, region_end
;
6139 struct frame
*f
= XFRAME (w
->frame
);
6140 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6141 Lisp_Object prop
, position
;
6143 Lisp_Object
*overlay_vec
;
6146 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6147 Lisp_Object limit1
, end
;
6148 struct face
*default_face
;
6150 /* W must display the current buffer. We could write this function
6151 to use the frame and buffer of W, but right now it doesn't. */
6152 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6154 XSETFRAME (frame
, f
);
6155 XSETFASTINT (position
, pos
);
6158 if (pos
< region_beg
&& region_beg
< endpos
)
6159 endpos
= region_beg
;
6161 /* Get the `face' or `mouse_face' text property at POS, and
6162 determine the next position at which the property changes. */
6163 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6164 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6165 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6167 endpos
= XINT (end
);
6169 /* Look at properties from overlays. */
6171 EMACS_INT next_overlay
;
6173 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
6174 if (next_overlay
< endpos
)
6175 endpos
= next_overlay
;
6180 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6182 /* Optimize common cases where we can use the default face. */
6185 && !(pos
>= region_beg
&& pos
< region_end
))
6186 return DEFAULT_FACE_ID
;
6188 /* Begin with attributes from the default face. */
6189 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6191 /* Merge in attributes specified via text properties. */
6193 merge_face_ref (f
, prop
, attrs
, 1, 0);
6195 /* Now merge the overlay data. */
6196 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6197 for (i
= 0; i
< noverlays
; i
++)
6202 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6204 merge_face_ref (f
, prop
, attrs
, 1, 0);
6206 oend
= OVERLAY_END (overlay_vec
[i
]);
6207 oendpos
= OVERLAY_POSITION (oend
);
6208 if (oendpos
< endpos
)
6212 /* If in the region, merge in the region face. */
6213 if (pos
>= region_beg
&& pos
< region_end
)
6215 merge_named_face (f
, Qregion
, attrs
, 0);
6217 if (region_end
< endpos
)
6218 endpos
= region_end
;
6223 /* Look up a realized face with the given face attributes,
6224 or realize a new one for ASCII characters. */
6225 return lookup_face (f
, attrs
);
6228 /* Return the face ID at buffer position POS for displaying ASCII
6229 characters associated with overlay strings for overlay OVERLAY.
6231 Like face_at_buffer_position except for OVERLAY. Currently it
6232 simply disregards the `face' properties of all overlays. */
6235 face_for_overlay_string (w
, pos
, region_beg
, region_end
,
6236 endptr
, limit
, mouse
, overlay
)
6239 EMACS_INT region_beg
, region_end
;
6243 Lisp_Object overlay
;
6245 struct frame
*f
= XFRAME (w
->frame
);
6246 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6247 Lisp_Object prop
, position
;
6250 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6251 Lisp_Object limit1
, end
;
6252 struct face
*default_face
;
6254 /* W must display the current buffer. We could write this function
6255 to use the frame and buffer of W, but right now it doesn't. */
6256 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6258 XSETFRAME (frame
, f
);
6259 XSETFASTINT (position
, pos
);
6262 if (pos
< region_beg
&& region_beg
< endpos
)
6263 endpos
= region_beg
;
6265 /* Get the `face' or `mouse_face' text property at POS, and
6266 determine the next position at which the property changes. */
6267 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6268 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6269 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6271 endpos
= XINT (end
);
6275 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6277 /* Optimize common cases where we can use the default face. */
6279 && !(pos
>= region_beg
&& pos
< region_end
))
6280 return DEFAULT_FACE_ID
;
6282 /* Begin with attributes from the default face. */
6283 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6285 /* Merge in attributes specified via text properties. */
6287 merge_face_ref (f
, prop
, attrs
, 1, 0);
6289 /* If in the region, merge in the region face. */
6290 if (pos
>= region_beg
&& pos
< region_end
)
6292 merge_named_face (f
, Qregion
, attrs
, 0);
6294 if (region_end
< endpos
)
6295 endpos
= region_end
;
6300 /* Look up a realized face with the given face attributes,
6301 or realize a new one for ASCII characters. */
6302 return lookup_face (f
, attrs
);
6306 /* Compute the face at character position POS in Lisp string STRING on
6307 window W, for ASCII characters.
6309 If STRING is an overlay string, it comes from position BUFPOS in
6310 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6311 not an overlay string. W must display the current buffer.
6312 REGION_BEG and REGION_END give the start and end positions of the
6313 region; both are -1 if no region is visible.
6315 BASE_FACE_ID is the id of a face to merge with. For strings coming
6316 from overlays or the `display' property it is the face at BUFPOS.
6318 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6320 Set *ENDPTR to the next position where to check for faces in
6321 STRING; -1 if the face is constant from POS to the end of the
6324 Value is the id of the face to use. The face returned is suitable
6325 for displaying ASCII characters. */
6328 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6329 region_end
, endptr
, base_face_id
, mouse_p
)
6332 EMACS_INT pos
, bufpos
;
6333 EMACS_INT region_beg
, region_end
;
6335 enum face_id base_face_id
;
6338 Lisp_Object prop
, position
, end
, limit
;
6339 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6340 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6341 struct face
*base_face
;
6342 int multibyte_p
= STRING_MULTIBYTE (string
);
6343 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6345 /* Get the value of the face property at the current position within
6346 STRING. Value is nil if there is no face property. */
6347 XSETFASTINT (position
, pos
);
6348 prop
= Fget_text_property (position
, prop_name
, string
);
6350 /* Get the next position at which to check for faces. Value of end
6351 is nil if face is constant all the way to the end of the string.
6352 Otherwise it is a string position where to check faces next.
6353 Limit is the maximum position up to which to check for property
6354 changes in Fnext_single_property_change. Strings are usually
6355 short, so set the limit to the end of the string. */
6356 XSETFASTINT (limit
, SCHARS (string
));
6357 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6359 *endptr
= XFASTINT (end
);
6363 base_face
= FACE_FROM_ID (f
, base_face_id
);
6364 xassert (base_face
);
6366 /* Optimize the default case that there is no face property and we
6367 are not in the region. */
6369 && (base_face_id
!= DEFAULT_FACE_ID
6370 /* BUFPOS <= 0 means STRING is not an overlay string, so
6371 that the region doesn't have to be taken into account. */
6373 || bufpos
< region_beg
6374 || bufpos
>= region_end
)
6376 /* We can't realize faces for different charsets differently
6377 if we don't have fonts, so we can stop here if not working
6378 on a window-system frame. */
6379 || !FRAME_WINDOW_P (f
)
6380 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6381 return base_face
->id
;
6383 /* Begin with attributes from the base face. */
6384 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6386 /* Merge in attributes specified via text properties. */
6388 merge_face_ref (f
, prop
, attrs
, 1, 0);
6390 /* If in the region, merge in the region face. */
6392 && bufpos
>= region_beg
6393 && bufpos
< region_end
)
6394 merge_named_face (f
, Qregion
, attrs
, 0);
6396 /* Look up a realized face with the given face attributes,
6397 or realize a new one for ASCII characters. */
6398 return lookup_face (f
, attrs
);
6402 /* Merge a face into a realized face.
6404 F is frame where faces are (to be) realized.
6406 FACE_NAME is named face to merge.
6408 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
6410 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
6412 BASE_FACE_ID is realized face to merge into.
6418 merge_faces (f
, face_name
, face_id
, base_face_id
)
6420 Lisp_Object face_name
;
6421 int face_id
, base_face_id
;
6423 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6424 struct face
*base_face
;
6426 base_face
= FACE_FROM_ID (f
, base_face_id
);
6428 return base_face_id
;
6430 if (EQ (face_name
, Qt
))
6432 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
6433 return base_face_id
;
6434 face_name
= lface_id_to_name
[face_id
];
6435 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 1);
6438 return base_face_id
;
6441 /* Begin with attributes from the base face. */
6442 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6444 if (!NILP (face_name
))
6446 if (!merge_named_face (f
, face_name
, attrs
, 0))
6447 return base_face_id
;
6453 return base_face_id
;
6454 face
= FACE_FROM_ID (f
, face_id
);
6456 return base_face_id
;
6457 merge_face_vectors (f
, face
->lface
, attrs
, 0);
6460 /* Look up a realized face with the given face attributes,
6461 or realize a new one for ASCII characters. */
6462 return lookup_face (f
, attrs
);
6466 /***********************************************************************
6468 ***********************************************************************/
6472 /* Print the contents of the realized face FACE to stderr. */
6475 dump_realized_face (face
)
6478 fprintf (stderr
, "ID: %d\n", face
->id
);
6479 #ifdef HAVE_X_WINDOWS
6480 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
6482 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6484 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
6485 fprintf (stderr
, "background: 0x%lx (%s)\n",
6487 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
6489 fprintf (stderr
, "font_name: %s (%s)\n",
6490 SDATA (face
->font
->props
[FONT_NAME_INDEX
]),
6491 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
6492 #ifdef HAVE_X_WINDOWS
6493 fprintf (stderr
, "font = %p\n", face
->font
);
6495 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6496 fprintf (stderr
, "underline: %d (%s)\n",
6498 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
6499 fprintf (stderr
, "hash: %d\n", face
->hash
);
6503 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6511 fprintf (stderr
, "font selection order: ");
6512 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6513 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6514 fprintf (stderr
, "\n");
6516 fprintf (stderr
, "alternative fonts: ");
6517 debug_print (Vface_alternative_font_family_alist
);
6518 fprintf (stderr
, "\n");
6520 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6521 Fdump_face (make_number (i
));
6527 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6529 error ("Not a valid face");
6530 dump_realized_face (face
);
6537 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6538 0, 0, 0, doc
: /* */)
6541 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6542 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6543 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6547 #endif /* GLYPH_DEBUG != 0 */
6551 /***********************************************************************
6553 ***********************************************************************/
6558 Qface
= intern ("face");
6560 Qface_no_inherit
= intern ("face-no-inherit");
6561 staticpro (&Qface_no_inherit
);
6562 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6563 staticpro (&Qbitmap_spec_p
);
6564 Qframe_set_background_mode
= intern ("frame-set-background-mode");
6565 staticpro (&Qframe_set_background_mode
);
6567 /* Lisp face attribute keywords. */
6568 QCfamily
= intern (":family");
6569 staticpro (&QCfamily
);
6570 QCheight
= intern (":height");
6571 staticpro (&QCheight
);
6572 QCweight
= intern (":weight");
6573 staticpro (&QCweight
);
6574 QCslant
= intern (":slant");
6575 staticpro (&QCslant
);
6576 QCunderline
= intern (":underline");
6577 staticpro (&QCunderline
);
6578 QCinverse_video
= intern (":inverse-video");
6579 staticpro (&QCinverse_video
);
6580 QCreverse_video
= intern (":reverse-video");
6581 staticpro (&QCreverse_video
);
6582 QCforeground
= intern (":foreground");
6583 staticpro (&QCforeground
);
6584 QCbackground
= intern (":background");
6585 staticpro (&QCbackground
);
6586 QCstipple
= intern (":stipple");
6587 staticpro (&QCstipple
);
6588 QCwidth
= intern (":width");
6589 staticpro (&QCwidth
);
6590 QCfont
= intern (":font");
6591 staticpro (&QCfont
);
6592 QCfontset
= intern (":fontset");
6593 staticpro (&QCfontset
);
6594 QCbold
= intern (":bold");
6595 staticpro (&QCbold
);
6596 QCitalic
= intern (":italic");
6597 staticpro (&QCitalic
);
6598 QCoverline
= intern (":overline");
6599 staticpro (&QCoverline
);
6600 QCstrike_through
= intern (":strike-through");
6601 staticpro (&QCstrike_through
);
6602 QCbox
= intern (":box");
6604 QCinherit
= intern (":inherit");
6605 staticpro (&QCinherit
);
6607 /* Symbols used for Lisp face attribute values. */
6608 QCcolor
= intern (":color");
6609 staticpro (&QCcolor
);
6610 QCline_width
= intern (":line-width");
6611 staticpro (&QCline_width
);
6612 QCstyle
= intern (":style");
6613 staticpro (&QCstyle
);
6614 Qreleased_button
= intern ("released-button");
6615 staticpro (&Qreleased_button
);
6616 Qpressed_button
= intern ("pressed-button");
6617 staticpro (&Qpressed_button
);
6618 Qnormal
= intern ("normal");
6619 staticpro (&Qnormal
);
6620 Qultra_light
= intern ("ultra-light");
6621 staticpro (&Qultra_light
);
6622 Qextra_light
= intern ("extra-light");
6623 staticpro (&Qextra_light
);
6624 Qlight
= intern ("light");
6625 staticpro (&Qlight
);
6626 Qsemi_light
= intern ("semi-light");
6627 staticpro (&Qsemi_light
);
6628 Qsemi_bold
= intern ("semi-bold");
6629 staticpro (&Qsemi_bold
);
6630 Qbold
= intern ("bold");
6632 Qextra_bold
= intern ("extra-bold");
6633 staticpro (&Qextra_bold
);
6634 Qultra_bold
= intern ("ultra-bold");
6635 staticpro (&Qultra_bold
);
6636 Qoblique
= intern ("oblique");
6637 staticpro (&Qoblique
);
6638 Qitalic
= intern ("italic");
6639 staticpro (&Qitalic
);
6640 Qreverse_oblique
= intern ("reverse-oblique");
6641 staticpro (&Qreverse_oblique
);
6642 Qreverse_italic
= intern ("reverse-italic");
6643 staticpro (&Qreverse_italic
);
6644 Qultra_condensed
= intern ("ultra-condensed");
6645 staticpro (&Qultra_condensed
);
6646 Qextra_condensed
= intern ("extra-condensed");
6647 staticpro (&Qextra_condensed
);
6648 Qcondensed
= intern ("condensed");
6649 staticpro (&Qcondensed
);
6650 Qsemi_condensed
= intern ("semi-condensed");
6651 staticpro (&Qsemi_condensed
);
6652 Qsemi_expanded
= intern ("semi-expanded");
6653 staticpro (&Qsemi_expanded
);
6654 Qexpanded
= intern ("expanded");
6655 staticpro (&Qexpanded
);
6656 Qextra_expanded
= intern ("extra-expanded");
6657 staticpro (&Qextra_expanded
);
6658 Qultra_expanded
= intern ("ultra-expanded");
6659 staticpro (&Qultra_expanded
);
6660 Qbackground_color
= intern ("background-color");
6661 staticpro (&Qbackground_color
);
6662 Qforeground_color
= intern ("foreground-color");
6663 staticpro (&Qforeground_color
);
6664 Qunspecified
= intern ("unspecified");
6665 staticpro (&Qunspecified
);
6666 Qignore_defface
= intern (":ignore-defface");
6667 staticpro (&Qignore_defface
);
6669 Qface_alias
= intern ("face-alias");
6670 staticpro (&Qface_alias
);
6671 Qdefault
= intern ("default");
6672 staticpro (&Qdefault
);
6673 Qtool_bar
= intern ("tool-bar");
6674 staticpro (&Qtool_bar
);
6675 Qregion
= intern ("region");
6676 staticpro (&Qregion
);
6677 Qfringe
= intern ("fringe");
6678 staticpro (&Qfringe
);
6679 Qheader_line
= intern ("header-line");
6680 staticpro (&Qheader_line
);
6681 Qscroll_bar
= intern ("scroll-bar");
6682 staticpro (&Qscroll_bar
);
6683 Qmenu
= intern ("menu");
6685 Qcursor
= intern ("cursor");
6686 staticpro (&Qcursor
);
6687 Qborder
= intern ("border");
6688 staticpro (&Qborder
);
6689 Qmouse
= intern ("mouse");
6690 staticpro (&Qmouse
);
6691 Qmode_line_inactive
= intern ("mode-line-inactive");
6692 staticpro (&Qmode_line_inactive
);
6693 Qvertical_border
= intern ("vertical-border");
6694 staticpro (&Qvertical_border
);
6695 Qtty_color_desc
= intern ("tty-color-desc");
6696 staticpro (&Qtty_color_desc
);
6697 Qtty_color_standard_values
= intern ("tty-color-standard-values");
6698 staticpro (&Qtty_color_standard_values
);
6699 Qtty_color_by_index
= intern ("tty-color-by-index");
6700 staticpro (&Qtty_color_by_index
);
6701 Qtty_color_alist
= intern ("tty-color-alist");
6702 staticpro (&Qtty_color_alist
);
6703 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
6704 staticpro (&Qscalable_fonts_allowed
);
6706 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
6707 staticpro (&Vparam_value_alist
);
6708 Vface_alternative_font_family_alist
= Qnil
;
6709 staticpro (&Vface_alternative_font_family_alist
);
6710 Vface_alternative_font_registry_alist
= Qnil
;
6711 staticpro (&Vface_alternative_font_registry_alist
);
6713 defsubr (&Sinternal_make_lisp_face
);
6714 defsubr (&Sinternal_lisp_face_p
);
6715 defsubr (&Sinternal_set_lisp_face_attribute
);
6716 #ifdef HAVE_WINDOW_SYSTEM
6717 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
6719 defsubr (&Scolor_gray_p
);
6720 defsubr (&Scolor_supported_p
);
6721 defsubr (&Sface_attribute_relative_p
);
6722 defsubr (&Smerge_face_attribute
);
6723 defsubr (&Sinternal_get_lisp_face_attribute
);
6724 defsubr (&Sinternal_lisp_face_attribute_values
);
6725 defsubr (&Sinternal_lisp_face_equal_p
);
6726 defsubr (&Sinternal_lisp_face_empty_p
);
6727 defsubr (&Sinternal_copy_lisp_face
);
6728 defsubr (&Sinternal_merge_in_global_face
);
6729 defsubr (&Sface_font
);
6730 defsubr (&Sframe_face_alist
);
6731 defsubr (&Sdisplay_supports_face_attributes_p
);
6732 defsubr (&Scolor_distance
);
6733 defsubr (&Sinternal_set_font_selection_order
);
6734 defsubr (&Sinternal_set_alternative_font_family_alist
);
6735 defsubr (&Sinternal_set_alternative_font_registry_alist
);
6736 defsubr (&Sface_attributes_as_vector
);
6738 defsubr (&Sdump_face
);
6739 defsubr (&Sshow_face_resources
);
6740 #endif /* GLYPH_DEBUG */
6741 defsubr (&Sclear_face_cache
);
6742 defsubr (&Stty_suppress_bold_inverse_default_colors
);
6744 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
6745 defsubr (&Sdump_colors
);
6748 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
6749 doc
: /* *Limit for font matching.
6750 If an integer > 0, font matching functions won't load more than
6751 that number of fonts when searching for a matching font. */);
6752 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
6754 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
6755 doc
: /* List of global face definitions (for internal use only.) */);
6756 Vface_new_frame_defaults
= Qnil
;
6758 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
6759 doc
: /* *Default stipple pattern used on monochrome displays.
6760 This stipple pattern is used on monochrome displays
6761 instead of shades of gray for a face background color.
6762 See `set-face-stipple' for possible values for this variable. */);
6763 Vface_default_stipple
= build_string ("gray3");
6765 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
6766 doc
: /* An alist of defined terminal colors and their RGB values. */);
6767 Vtty_defined_color_alist
= Qnil
;
6769 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
6770 doc
: /* Allowed scalable fonts.
6771 A value of nil means don't allow any scalable fonts.
6772 A value of t means allow any scalable font.
6773 Otherwise, value must be a list of regular expressions. A font may be
6774 scaled if its name matches a regular expression in the list.
6775 Note that if value is nil, a scalable font might still be used, if no
6776 other font of the appropriate family and registry is available. */);
6777 Vscalable_fonts_allowed
= Qnil
;
6779 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
6780 doc
: /* List of ignored fonts.
6781 Each element is a regular expression that matches names of fonts to
6783 Vface_ignored_fonts
= Qnil
;
6785 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
6786 doc
: /* Alist of fonts vs the rescaling factors.
6787 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
6788 FONT-NAME-PATTERN is a regular expression matching a font name, and
6789 RESCALE-RATIO is a floating point number to specify how much larger
6790 \(or smaller) font we should use. For instance, if a face requests
6791 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
6792 Vface_font_rescale_alist
= Qnil
;
6794 #ifdef HAVE_WINDOW_SYSTEM
6795 defsubr (&Sbitmap_spec_p
);
6796 defsubr (&Sx_list_fonts
);
6797 defsubr (&Sinternal_face_x_get_resource
);
6798 defsubr (&Sx_family_fonts
);
6799 defsubr (&Sx_font_family_list
);
6800 #endif /* HAVE_WINDOW_SYSTEM */
6803 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
6804 (do not change this comment) */