1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
3 Free Software Foundation.
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 2, 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 pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
77 Faces are frame-local by nature because Emacs allows to define the
78 same named face (face names are symbols) differently for different
79 frames. Each frame has an alist of face definitions for all named
80 faces. The value of a named face in such an alist is a Lisp vector
81 with the symbol `face' in slot 0, and a slot for each of the face
82 attributes mentioned above.
84 There is also a global face alist `Vface_new_frame_defaults'. Face
85 definitions from this list are used to initialize faces of newly
88 A face doesn't have to specify all attributes. Those not specified
89 have a value of `unspecified'. Faces specifying all attributes but
90 the 14th are called `fully-specified'.
95 The display style of a given character in the text is determined by
96 combining several faces. This process is called `face merging'.
97 Any aspect of the display style that isn't specified by overlays or
98 text properties is taken from the `default' face. Since it is made
99 sure that the default face is always fully-specified, face merging
100 always results in a fully-specified face.
105 After all face attributes for a character have been determined by
106 merging faces of that character, that face is `realized'. The
107 realization process maps face attributes to what is physically
108 available on the system where Emacs runs. The result is a
109 `realized face' in form of a struct face which is stored in the
110 face cache of the frame on which it was realized.
112 Face realization is done in the context of the character to display
113 because different fonts may be used for different characters. In
114 other words, for characters that have different font
115 specifications, different realized faces are needed to display
118 Font specification is done by fontsets. See the comment in
119 fontset.c for the details. In the current implementation, all ASCII
120 characters share the same font in a fontset.
122 Faces are at first realized for ASCII characters, and, at that
123 time, assigned a specific realized fontset. Hereafter, we call
124 such a face as `ASCII face'. When a face for a multibyte character
125 is realized, it inherits (thus shares) a fontset of an ASCII face
126 that has the same attributes other than font-related ones.
128 Thus, all realized faces have a realized fontset.
133 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
134 font as ASCII characters. That is because it is expected that
135 unibyte text users specify a font that is suitable both for ASCII
136 and raw 8-bit characters.
141 Font selection tries to find the best available matching font for a
142 given (character, face) combination.
144 If the face specifies a fontset name, that fontset determines a
145 pattern for fonts of the given character. If the face specifies a
146 font name or the other font-related attributes, a fontset is
147 realized from the default fontset. In that case, that
148 specification determines a pattern for ASCII characters and the
149 default fontset determines a pattern for multibyte characters.
151 Available fonts on the system on which Emacs runs are then matched
152 against the font pattern. The result of font selection is the best
153 match for the given face attributes in this font list.
155 Font selection can be influenced by the user.
157 1. The user can specify the relative importance he gives the face
158 attributes width, height, weight, and slant by setting
159 face-font-selection-order (faces.el) to a list of face attribute
160 names. The default is '(:width :height :weight :slant), and means
161 that font selection first tries to find a good match for the font
162 width specified by a face, then---within fonts with that
163 width---tries to find a best match for the specified font height,
166 2. Setting face-font-family-alternatives allows the user to
167 specify alternative font families to try if a family specified by a
170 3. Setting face-font-registry-alternatives allows the user to
171 specify all alternative font registries to try for a face
172 specifying a registry.
174 4. Setting face-ignored-fonts allows the user to ignore specific
178 Character composition.
180 Usually, the realization process is already finished when Emacs
181 actually reflects the desired glyph matrix on the screen. However,
182 on displaying a composition (sequence of characters to be composed
183 on the screen), a suitable font for the components of the
184 composition is selected and realized while drawing them on the
185 screen, i.e. the realization process is delayed but in principle
189 Initialization of basic faces.
191 The faces `default', `modeline' are considered `basic faces'.
192 When redisplay happens the first time for a newly created frame,
193 basic faces are realized for CHARSET_ASCII. Frame parameters are
194 used to fill in unspecified attributes of the default face. */
198 #include <sys/types.h>
199 #include <sys/stat.h>
202 #include "character.h"
204 #include "keyboard.h"
207 #ifdef HAVE_WINDOW_SYSTEM
209 #endif /* HAVE_WINDOW_SYSTEM */
211 #ifdef HAVE_X_WINDOWS
215 #include <Xm/XmStrDefs.h>
216 #endif /* USE_MOTIF */
217 #endif /* HAVE_X_WINDOWS */
226 /* Redefine X specifics to W32 equivalents to avoid cluttering the
227 code with #ifdef blocks. */
228 #undef FRAME_X_DISPLAY_INFO
229 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
230 #define x_display_info w32_display_info
231 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
232 #define check_x check_w32
233 #define x_list_fonts w32_list_fonts
234 #define GCGraphicsExposures 0
235 #endif /* WINDOWSNT */
239 #define x_display_info mac_display_info
240 #define check_x check_mac
244 #include "dispextern.h"
245 #include "blockinput.h"
247 #include "intervals.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
256 #ifdef XOS_NEEDS_TIME_H
262 #else /* not XOS_NEEDS_TIME_H */
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
270 #define abs(X) ((X) < 0 ? -(X) : (X))
272 /* Number of pt per inch (from the TeXbook). */
274 #define PT_PER_INCH 72.27
276 /* Non-zero if face attribute ATTR is unspecified. */
278 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
280 /* Value is the number of elements of VECTOR. */
282 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
284 /* Make a copy of string S on the stack using alloca. Value is a pointer
287 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
289 /* Make a copy of the contents of Lisp string S on the stack using
290 alloca. Value is a pointer to the copy. */
292 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
294 /* Size of hash table of realized faces in face caches (should be a
297 #define FACE_CACHE_BUCKETS_SIZE 1001
299 /* Keyword symbols used for face attribute names. */
301 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
302 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
303 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
304 Lisp_Object QCreverse_video
;
305 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
306 Lisp_Object QCfontset
;
308 /* Symbols used for attribute values. */
310 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
311 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
312 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
313 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
314 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
315 Lisp_Object Qultra_expanded
;
316 Lisp_Object Qreleased_button
, Qpressed_button
;
317 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
318 Lisp_Object Qunspecified
;
320 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
322 /* The name of the function to call when the background of the frame
323 has changed, frame_set_background_mode. */
325 Lisp_Object Qframe_set_background_mode
;
327 /* Names of basic faces. */
329 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
330 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
331 Lisp_Object Qmode_line_inactive
, Qvertical_border
;
332 extern Lisp_Object Qmode_line
;
334 /* The symbol `face-alias'. A symbols having that property is an
335 alias for another face. Value of the property is the name of
338 Lisp_Object Qface_alias
;
340 extern Lisp_Object Qcircular_list
;
342 /* Default stipple pattern used on monochrome displays. This stipple
343 pattern is used on monochrome displays instead of shades of gray
344 for a face background color. See `set-face-stipple' for possible
345 values for this variable. */
347 Lisp_Object Vface_default_stipple
;
349 /* Alist of alternative font families. Each element is of the form
350 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
351 try FAMILY1, then FAMILY2, ... */
353 Lisp_Object Vface_alternative_font_family_alist
;
355 /* Alist of alternative font registries. Each element is of the form
356 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
357 loaded, try REGISTRY1, then REGISTRY2, ... */
359 Lisp_Object Vface_alternative_font_registry_alist
;
361 /* Allowed scalable fonts. A value of nil means don't allow any
362 scalable fonts. A value of t means allow the use of any scalable
363 font. Otherwise, value must be a list of regular expressions. A
364 font may be scaled if its name matches a regular expression in the
367 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
369 /* List of regular expressions that matches names of fonts to ignore. */
371 Lisp_Object Vface_ignored_fonts
;
373 /* Alist of font name patterns vs the rescaling factor. */
375 Lisp_Object Vface_font_rescale_alist
;
377 /* Maximum number of fonts to consider in font_list. If not an
378 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
380 Lisp_Object Vfont_list_limit
;
381 #define DEFAULT_FONT_LIST_LIMIT 100
383 /* The symbols `foreground-color' and `background-color' which can be
384 used as part of a `face' property. This is for compatibility with
387 Lisp_Object Qforeground_color
, Qbackground_color
;
389 /* The symbols `face' and `mouse-face' used as text properties. */
392 extern Lisp_Object Qmouse_face
;
394 /* Property for basic faces which other faces cannot inherit. */
396 Lisp_Object Qface_no_inherit
;
398 /* Error symbol for wrong_type_argument in load_pixmap. */
400 Lisp_Object Qbitmap_spec_p
;
402 /* Alist of global face definitions. Each element is of the form
403 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
404 is a Lisp vector of face attributes. These faces are used
405 to initialize faces for new frames. */
407 Lisp_Object Vface_new_frame_defaults
;
409 /* The next ID to assign to Lisp faces. */
411 static int next_lface_id
;
413 /* A vector mapping Lisp face Id's to face names. */
415 static Lisp_Object
*lface_id_to_name
;
416 static int lface_id_to_name_size
;
418 /* TTY color-related functions (defined in tty-colors.el). */
420 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
422 /* The name of the function used to compute colors on TTYs. */
424 Lisp_Object Qtty_color_alist
;
426 /* An alist of defined terminal colors and their RGB values. */
428 Lisp_Object Vtty_defined_color_alist
;
430 /* Counter for calls to clear_face_cache. If this counter reaches
431 CLEAR_FONT_TABLE_COUNT, and a frame has more than
432 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
434 static int clear_font_table_count
;
435 #define CLEAR_FONT_TABLE_COUNT 100
436 #define CLEAR_FONT_TABLE_NFONTS 10
438 /* Non-zero means face attributes have been changed since the last
439 redisplay. Used in redisplay_internal. */
441 int face_change_count
;
443 /* Non-zero means don't display bold text if a face's foreground
444 and background colors are the inverse of the default colors of the
445 display. This is a kluge to suppress `bold black' foreground text
446 which is hard to read on an LCD monitor. */
448 int tty_suppress_bold_inverse_default_colors_p
;
450 /* A list of the form `((x . y))' used to avoid consing in
451 Finternal_set_lisp_face_attribute. */
453 static Lisp_Object Vparam_value_alist
;
455 /* The total number of colors currently allocated. */
458 static int ncolors_allocated
;
459 static int npixmaps_allocated
;
463 /* Non-zero means the definition of the `menu' face for new frames has
466 int menu_face_changed_default
;
469 /* Function prototypes. */
473 struct named_merge_point
;
475 static void map_tty_color
P_ ((struct frame
*, struct face
*,
476 enum lface_attribute_index
, int *));
477 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
, int));
478 static int may_use_scalable_font_p
P_ ((const char *));
479 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
480 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
482 static int x_face_list_fonts
P_ ((struct frame
*, char *,
483 struct font_name
**, int, int));
484 static int font_scalable_p
P_ ((struct font_name
*));
485 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
486 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
487 static unsigned char *xstrlwr
P_ ((unsigned char *));
488 static void signal_error
P_ ((char *, Lisp_Object
));
489 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
490 static void load_face_font
P_ ((struct frame
*, struct face
*));
491 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
492 static void free_face_colors
P_ ((struct frame
*, struct face
*));
493 static int face_color_gray_p
P_ ((struct frame
*, char *));
494 static char *build_font_name
P_ ((struct font_name
*));
495 static void free_font_names
P_ ((struct font_name
*, int));
496 static int sorted_font_list
P_ ((struct frame
*, char *,
497 int (*cmpfn
) P_ ((const void *, const void *)),
498 struct font_name
**));
499 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
500 Lisp_Object
, struct font_name
**));
501 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
502 Lisp_Object
, struct font_name
**));
503 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
504 Lisp_Object
, Lisp_Object
, struct font_name
**));
505 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
506 Lisp_Object
, struct font_name
**));
507 static int cmp_font_names
P_ ((const void *, const void *));
508 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
510 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
512 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
513 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
514 static int realize_basic_faces
P_ ((struct frame
*));
515 static int realize_default_face
P_ ((struct frame
*));
516 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
517 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
518 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
519 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
520 static unsigned lface_hash
P_ ((Lisp_Object
*));
521 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
522 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
523 static void clear_face_gcs
P_ ((struct face_cache
*));
524 static void free_face_cache
P_ ((struct face_cache
*));
525 static int face_numeric_weight
P_ ((Lisp_Object
));
526 static int face_numeric_slant
P_ ((Lisp_Object
));
527 static int face_numeric_swidth
P_ ((Lisp_Object
));
528 static int face_fontset
P_ ((Lisp_Object
*));
529 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
530 struct named_merge_point
*));
531 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
532 int, struct named_merge_point
*));
533 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
534 Lisp_Object
, int, int));
535 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
536 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
537 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
538 struct font_name
*, int, int, int *));
539 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
540 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
541 static int xlfd_numeric_slant
P_ ((struct font_name
*));
542 static int xlfd_numeric_weight
P_ ((struct font_name
*));
543 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
544 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
545 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
546 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
547 static int xlfd_fixed_p
P_ ((struct font_name
*));
548 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
550 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
551 struct font_name
*, int,
553 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
554 struct font_name
*, int));
556 #ifdef HAVE_WINDOW_SYSTEM
558 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
559 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
560 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
561 int (*cmpfn
) P_ ((const void *, const void *))));
562 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
563 static void x_free_gc
P_ ((struct frame
*, GC
));
564 static void clear_font_table
P_ ((struct x_display_info
*));
567 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
568 #endif /* WINDOWSNT */
571 static void x_update_menu_appearance
P_ ((struct frame
*));
573 extern void free_frame_menubar
P_ ((struct frame
*));
574 #endif /* USE_X_TOOLKIT */
576 #endif /* HAVE_WINDOW_SYSTEM */
579 /***********************************************************************
581 ***********************************************************************/
583 #ifdef HAVE_X_WINDOWS
585 #ifdef DEBUG_X_COLORS
587 /* The following is a poor mans infrastructure for debugging X color
588 allocation problems on displays with PseudoColor-8. Some X servers
589 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
590 color reference counts completely so that they don't signal an
591 error when a color is freed whose reference count is already 0.
592 Other X servers do. To help me debug this, the following code
593 implements a simple reference counting schema of its own, for a
594 single display/screen. --gerd. */
596 /* Reference counts for pixel colors. */
598 int color_count
[256];
600 /* Register color PIXEL as allocated. */
603 register_color (pixel
)
606 xassert (pixel
< 256);
607 ++color_count
[pixel
];
611 /* Register color PIXEL as deallocated. */
614 unregister_color (pixel
)
617 xassert (pixel
< 256);
618 if (color_count
[pixel
] > 0)
619 --color_count
[pixel
];
625 /* Register N colors from PIXELS as deallocated. */
628 unregister_colors (pixels
, n
)
629 unsigned long *pixels
;
633 for (i
= 0; i
< n
; ++i
)
634 unregister_color (pixels
[i
]);
638 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
639 doc
: /* Dump currently allocated colors to stderr. */)
644 fputc ('\n', stderr
);
646 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
649 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
652 fputc ('\n', stderr
);
654 fputc ('\t', stderr
);
658 fputc ('\n', stderr
);
662 #endif /* DEBUG_X_COLORS */
665 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
666 color values. Interrupt input must be blocked when this function
670 x_free_colors (f
, pixels
, npixels
)
672 unsigned long *pixels
;
675 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
677 /* If display has an immutable color map, freeing colors is not
678 necessary and some servers don't allow it. So don't do it. */
679 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
681 #ifdef DEBUG_X_COLORS
682 unregister_colors (pixels
, npixels
);
684 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
690 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
691 color values. Interrupt input must be blocked when this function
695 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
699 unsigned long *pixels
;
702 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
703 int class = dpyinfo
->visual
->class;
705 /* If display has an immutable color map, freeing colors is not
706 necessary and some servers don't allow it. So don't do it. */
707 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
709 #ifdef DEBUG_X_COLORS
710 unregister_colors (pixels
, npixels
);
712 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
717 /* Create and return a GC for use on frame F. GC values and mask
718 are given by XGCV and MASK. */
721 x_create_gc (f
, mask
, xgcv
)
728 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
735 /* Free GC which was used on frame F. */
743 IF_DEBUG (xassert (--ngcs
>= 0));
744 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
748 #endif /* HAVE_X_WINDOWS */
751 /* W32 emulation of GCs */
754 x_create_gc (f
, mask
, xgcv
)
761 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
768 /* Free GC which was used on frame F. */
776 IF_DEBUG (xassert (--ngcs
>= 0));
781 #endif /* WINDOWSNT */
784 /* Mac OS emulation of GCs */
787 x_create_gc (f
, mask
, xgcv
)
793 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
802 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
807 /* Like stricmp. Used to compare parts of font names which are in
812 const unsigned char *s1
, *s2
;
816 unsigned char c1
= tolower (*s1
);
817 unsigned char c2
= tolower (*s2
);
819 return c1
< c2
? -1 : 1;
824 return *s2
== 0 ? 0 : -1;
829 /* Like strlwr, which might not always be available. */
831 static unsigned char *
835 unsigned char *p
= s
;
844 /* Signal `error' with message S, and additional argument ARG. */
847 signal_error (s
, arg
)
851 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
855 /* If FRAME is nil, return a pointer to the selected frame.
856 Otherwise, check that FRAME is a live frame, and return a pointer
857 to it. NPARAM is the parameter number of FRAME, for
858 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
859 Lisp function definitions. */
861 static INLINE
struct frame
*
862 frame_or_selected_frame (frame
, nparam
)
867 frame
= selected_frame
;
869 CHECK_LIVE_FRAME (frame
);
870 return XFRAME (frame
);
874 /***********************************************************************
876 ***********************************************************************/
878 /* Initialize face cache and basic faces for frame F. */
884 /* Make a face cache, if F doesn't have one. */
885 if (FRAME_FACE_CACHE (f
) == NULL
)
886 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
888 #ifdef HAVE_WINDOW_SYSTEM
889 /* Make the image cache. */
890 if (FRAME_WINDOW_P (f
))
892 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
893 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
894 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
896 #endif /* HAVE_WINDOW_SYSTEM */
898 /* Realize basic faces. Must have enough information in frame
899 parameters to realize basic faces at this point. */
900 #ifdef HAVE_X_WINDOWS
901 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
904 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
907 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
909 if (!realize_basic_faces (f
))
914 /* Free face cache of frame F. Called from Fdelete_frame. */
920 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
924 free_face_cache (face_cache
);
925 FRAME_FACE_CACHE (f
) = NULL
;
928 #ifdef HAVE_WINDOW_SYSTEM
929 if (FRAME_WINDOW_P (f
))
931 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
934 --image_cache
->refcount
;
935 if (image_cache
->refcount
== 0)
936 free_image_cache (f
);
939 #endif /* HAVE_WINDOW_SYSTEM */
943 /* Clear face caches, and recompute basic faces for frame F. Call
944 this after changing frame parameters on which those faces depend,
945 or when realized faces have been freed due to changing attributes
949 recompute_basic_faces (f
)
952 if (FRAME_FACE_CACHE (f
))
954 clear_face_cache (0);
955 if (!realize_basic_faces (f
))
961 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
962 try to free unused fonts, too. */
965 clear_face_cache (clear_fonts_p
)
968 #ifdef HAVE_WINDOW_SYSTEM
969 Lisp_Object tail
, frame
;
973 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
975 struct x_display_info
*dpyinfo
;
977 /* Fonts are common for frames on one display, i.e. on
979 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
980 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
981 clear_font_table (dpyinfo
);
983 /* From time to time see if we can unload some fonts. This also
984 frees all realized faces on all frames. Fonts needed by
985 faces will be loaded again when faces are realized again. */
986 clear_font_table_count
= 0;
988 FOR_EACH_FRAME (tail
, frame
)
990 struct frame
*f
= XFRAME (frame
);
991 if (FRAME_WINDOW_P (f
)
992 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
993 free_all_realized_faces (frame
);
998 /* Clear GCs of realized faces. */
999 FOR_EACH_FRAME (tail
, frame
)
1002 if (FRAME_WINDOW_P (f
))
1004 clear_face_gcs (FRAME_FACE_CACHE (f
));
1005 clear_image_cache (f
, 0);
1009 #endif /* HAVE_WINDOW_SYSTEM */
1013 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1014 doc
: /* Clear face caches on all frames.
1015 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1017 Lisp_Object thoroughly
;
1019 clear_face_cache (!NILP (thoroughly
));
1020 ++face_change_count
;
1021 ++windows_or_buffers_changed
;
1027 #ifdef HAVE_WINDOW_SYSTEM
1030 /* Remove fonts from the font table of DPYINFO except for the default
1031 ASCII fonts of frames on that display. Called from clear_face_cache
1032 from time to time. */
1035 clear_font_table (dpyinfo
)
1036 struct x_display_info
*dpyinfo
;
1040 /* Free those fonts that are not used by frames on DPYINFO. */
1041 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1043 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1044 Lisp_Object tail
, frame
;
1046 /* Check if slot is already free. */
1047 if (font_info
->name
== NULL
)
1050 /* Don't free a default font of some frame. */
1051 FOR_EACH_FRAME (tail
, frame
)
1053 struct frame
*f
= XFRAME (frame
);
1054 if (FRAME_WINDOW_P (f
)
1055 && font_info
->font
== FRAME_FONT (f
))
1063 if (font_info
->full_name
!= font_info
->name
)
1064 xfree (font_info
->full_name
);
1065 xfree (font_info
->name
);
1067 /* Free the font. */
1069 #ifdef HAVE_X_WINDOWS
1070 XFreeFont (dpyinfo
->display
, font_info
->font
);
1073 w32_unload_font (dpyinfo
, font_info
->font
);
1076 mac_unload_font (dpyinfo
, font_info
->font
);
1080 /* Mark font table slot free. */
1081 font_info
->font
= NULL
;
1082 font_info
->name
= font_info
->full_name
= NULL
;
1086 #endif /* HAVE_WINDOW_SYSTEM */
1090 /***********************************************************************
1092 ***********************************************************************/
1094 #ifdef HAVE_WINDOW_SYSTEM
1096 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1097 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1098 A bitmap specification is either a string, a file name, or a list
1099 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1100 HEIGHT is its height, and DATA is a string containing the bits of
1101 the pixmap. Bits are stored row by row, each row occupies
1102 \(WIDTH + 7)/8 bytes. */)
1108 if (STRINGP (object
))
1109 /* If OBJECT is a string, it's a file name. */
1111 else if (CONSP (object
))
1113 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1114 HEIGHT must be integers > 0, and DATA must be string large
1115 enough to hold a bitmap of the specified size. */
1116 Lisp_Object width
, height
, data
;
1118 height
= width
= data
= Qnil
;
1122 width
= XCAR (object
);
1123 object
= XCDR (object
);
1126 height
= XCAR (object
);
1127 object
= XCDR (object
);
1129 data
= XCAR (object
);
1133 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1135 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1137 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1142 return pixmap_p
? Qt
: Qnil
;
1146 /* Load a bitmap according to NAME (which is either a file name or a
1147 pixmap spec) for use on frame F. Value is the bitmap_id (see
1148 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1149 bitmap cannot be loaded, display a message saying so, and return
1150 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1151 if these pointers are not null. */
1154 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1157 unsigned int *w_ptr
, *h_ptr
;
1165 tem
= Fbitmap_spec_p (name
);
1167 wrong_type_argument (Qbitmap_spec_p
, name
);
1172 /* Decode a bitmap spec into a bitmap. */
1177 w
= XINT (Fcar (name
));
1178 h
= XINT (Fcar (Fcdr (name
)));
1179 bits
= Fcar (Fcdr (Fcdr (name
)));
1181 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1186 /* It must be a string -- a file name. */
1187 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1193 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1204 ++npixmaps_allocated
;
1207 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1210 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1216 #endif /* HAVE_WINDOW_SYSTEM */
1220 /***********************************************************************
1222 ***********************************************************************/
1224 #ifdef HAVE_WINDOW_SYSTEM
1226 /* Load font of face FACE which is used on frame F to display ASCII
1227 characters. The name of the font to load is determined by lface. */
1230 load_face_font (f
, face
)
1234 struct font_info
*font_info
= NULL
;
1236 int needs_overstrike
;
1238 face
->font_info_id
= -1;
1240 face
->font_name
= NULL
;
1242 font_name
= choose_face_font (f
, face
->lface
, Qnil
, &needs_overstrike
);
1247 font_info
= FS_LOAD_FONT (f
, font_name
);
1252 face
->font_info_id
= font_info
->font_idx
;
1253 face
->font
= font_info
->font
;
1254 face
->font_name
= font_info
->full_name
;
1255 face
->overstrike
= needs_overstrike
;
1258 x_free_gc (f
, face
->gc
);
1263 add_to_log ("Unable to load font %s",
1264 build_string (font_name
), Qnil
);
1268 #endif /* HAVE_WINDOW_SYSTEM */
1272 /***********************************************************************
1274 ***********************************************************************/
1276 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1277 RGB_LIST should contain (at least) 3 lisp integers.
1278 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1281 parse_rgb_list (rgb_list
, color
)
1282 Lisp_Object rgb_list
;
1285 #define PARSE_RGB_LIST_FIELD(field) \
1286 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1288 color->field = XINT (XCAR (rgb_list)); \
1289 rgb_list = XCDR (rgb_list); \
1294 PARSE_RGB_LIST_FIELD (red
);
1295 PARSE_RGB_LIST_FIELD (green
);
1296 PARSE_RGB_LIST_FIELD (blue
);
1302 /* Lookup on frame F the color described by the lisp string COLOR.
1303 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1304 non-zero, then the `standard' definition of the same color is
1308 tty_lookup_color (f
, color
, tty_color
, std_color
)
1311 XColor
*tty_color
, *std_color
;
1313 Lisp_Object frame
, color_desc
;
1315 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1318 XSETFRAME (frame
, f
);
1320 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1321 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1325 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1328 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1330 rgb
= XCDR (XCDR (color_desc
));
1331 if (! parse_rgb_list (rgb
, tty_color
))
1334 /* Should we fill in STD_COLOR too? */
1337 /* Default STD_COLOR to the same as TTY_COLOR. */
1338 *std_color
= *tty_color
;
1340 /* Do a quick check to see if the returned descriptor is
1341 actually _exactly_ equal to COLOR, otherwise we have to
1342 lookup STD_COLOR separately. If it's impossible to lookup
1343 a standard color, we just give up and use TTY_COLOR. */
1344 if ((!STRINGP (XCAR (color_desc
))
1345 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1346 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1348 /* Look up STD_COLOR separately. */
1349 rgb
= call1 (Qtty_color_standard_values
, color
);
1350 if (! parse_rgb_list (rgb
, std_color
))
1357 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1358 /* We were called early during startup, and the colors are not
1359 yet set up in tty-defined-color-alist. Don't return a failure
1360 indication, since this produces the annoying "Unable to
1361 load color" messages in the *Messages* buffer. */
1364 /* tty-color-desc seems to have returned a bad value. */
1368 /* A version of defined_color for non-X frames. */
1371 tty_defined_color (f
, color_name
, color_def
, alloc
)
1380 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1382 color_def
->blue
= 0;
1383 color_def
->green
= 0;
1386 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1388 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1390 if (strcmp (color_name
, "unspecified-fg") == 0)
1391 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1392 else if (strcmp (color_name
, "unspecified-bg") == 0)
1393 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1396 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1403 /* Decide if color named COLOR_NAME is valid for the display
1404 associated with the frame F; if so, return the rgb values in
1405 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1407 This does the right thing for any type of frame. */
1410 defined_color (f
, color_name
, color_def
, alloc
)
1416 if (!FRAME_WINDOW_P (f
))
1417 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1418 #ifdef HAVE_X_WINDOWS
1419 else if (FRAME_X_P (f
))
1420 return x_defined_color (f
, color_name
, color_def
, alloc
);
1423 else if (FRAME_W32_P (f
))
1424 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1427 else if (FRAME_MAC_P (f
))
1428 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1435 /* Given the index IDX of a tty color on frame F, return its name, a
1439 tty_color_name (f
, idx
)
1443 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1446 Lisp_Object coldesc
;
1448 XSETFRAME (frame
, f
);
1449 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1451 if (!NILP (coldesc
))
1452 return XCAR (coldesc
);
1455 /* We can have an MSDOG frame under -nw for a short window of
1456 opportunity before internal_terminal_init is called. DTRT. */
1457 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1458 return msdos_stdcolor_name (idx
);
1461 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1462 return build_string (unspecified_fg
);
1463 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1464 return build_string (unspecified_bg
);
1467 return vga_stdcolor_name (idx
);
1470 return Qunspecified
;
1474 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1475 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1478 face_color_gray_p (f
, color_name
)
1485 if (defined_color (f
, color_name
, &color
, 0))
1486 gray_p
= ((abs (color
.red
- color
.green
)
1487 < max (color
.red
, color
.green
) / 20)
1488 && (abs (color
.green
- color
.blue
)
1489 < max (color
.green
, color
.blue
) / 20)
1490 && (abs (color
.blue
- color
.red
)
1491 < max (color
.blue
, color
.red
) / 20));
1499 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1500 BACKGROUND_P non-zero means the color will be used as background
1504 face_color_supported_p (f
, color_name
, background_p
)
1512 XSETFRAME (frame
, f
);
1514 #ifdef HAVE_WINDOW_SYSTEM
1516 ? (!NILP (Fxw_display_color_p (frame
))
1517 || xstricmp (color_name
, "black") == 0
1518 || xstricmp (color_name
, "white") == 0
1520 && face_color_gray_p (f
, color_name
))
1521 || (!NILP (Fx_display_grayscale_p (frame
))
1522 && face_color_gray_p (f
, color_name
)))
1525 tty_defined_color (f
, color_name
, ¬_used
, 0);
1529 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1530 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1531 FRAME specifies the frame and thus the display for interpreting COLOR.
1532 If FRAME is nil or omitted, use the selected frame. */)
1534 Lisp_Object color
, frame
;
1538 CHECK_STRING (color
);
1540 frame
= selected_frame
;
1542 CHECK_FRAME (frame
);
1544 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1548 DEFUN ("color-supported-p", Fcolor_supported_p
,
1549 Scolor_supported_p
, 1, 3, 0,
1550 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1551 BACKGROUND-P non-nil means COLOR is used as a background.
1552 Otherwise, this function tells whether it can be used as a foreground.
1553 If FRAME is nil or omitted, use the selected frame.
1554 COLOR must be a valid color name. */)
1555 (color
, frame
, background_p
)
1556 Lisp_Object frame
, color
, background_p
;
1560 CHECK_STRING (color
);
1562 frame
= selected_frame
;
1564 CHECK_FRAME (frame
);
1566 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1572 /* Load color with name NAME for use by face FACE on frame F.
1573 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1574 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1575 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1576 pixel color. If color cannot be loaded, display a message, and
1577 return the foreground, background or underline color of F, but
1578 record that fact in flags of the face so that we don't try to free
1582 load_color (f
, face
, name
, target_index
)
1586 enum lface_attribute_index target_index
;
1590 xassert (STRINGP (name
));
1591 xassert (target_index
== LFACE_FOREGROUND_INDEX
1592 || target_index
== LFACE_BACKGROUND_INDEX
1593 || target_index
== LFACE_UNDERLINE_INDEX
1594 || target_index
== LFACE_OVERLINE_INDEX
1595 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1596 || target_index
== LFACE_BOX_INDEX
);
1598 /* if the color map is full, defined_color will return a best match
1599 to the values in an existing cell. */
1600 if (!defined_color (f
, SDATA (name
), &color
, 1))
1602 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1604 switch (target_index
)
1606 case LFACE_FOREGROUND_INDEX
:
1607 face
->foreground_defaulted_p
= 1;
1608 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1611 case LFACE_BACKGROUND_INDEX
:
1612 face
->background_defaulted_p
= 1;
1613 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1616 case LFACE_UNDERLINE_INDEX
:
1617 face
->underline_defaulted_p
= 1;
1618 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1621 case LFACE_OVERLINE_INDEX
:
1622 face
->overline_color_defaulted_p
= 1;
1623 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1626 case LFACE_STRIKE_THROUGH_INDEX
:
1627 face
->strike_through_color_defaulted_p
= 1;
1628 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1631 case LFACE_BOX_INDEX
:
1632 face
->box_color_defaulted_p
= 1;
1633 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1642 ++ncolors_allocated
;
1649 #ifdef HAVE_WINDOW_SYSTEM
1651 /* Load colors for face FACE which is used on frame F. Colors are
1652 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1653 of ATTRS. If the background color specified is not supported on F,
1654 try to emulate gray colors with a stipple from Vface_default_stipple. */
1657 load_face_colors (f
, face
, attrs
)
1664 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1665 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1667 /* Swap colors if face is inverse-video. */
1668 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1676 /* Check for support for foreground, not for background because
1677 face_color_supported_p is smart enough to know that grays are
1678 "supported" as background because we are supposed to use stipple
1680 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1681 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1683 x_destroy_bitmap (f
, face
->stipple
);
1684 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1685 &face
->pixmap_w
, &face
->pixmap_h
);
1688 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1689 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1693 /* Free color PIXEL on frame F. */
1696 unload_color (f
, pixel
)
1698 unsigned long pixel
;
1700 #ifdef HAVE_X_WINDOWS
1704 x_free_colors (f
, &pixel
, 1);
1711 /* Free colors allocated for FACE. */
1714 free_face_colors (f
, face
)
1718 #ifdef HAVE_X_WINDOWS
1719 if (face
->colors_copied_bitwise_p
)
1724 if (!face
->foreground_defaulted_p
)
1726 x_free_colors (f
, &face
->foreground
, 1);
1727 IF_DEBUG (--ncolors_allocated
);
1730 if (!face
->background_defaulted_p
)
1732 x_free_colors (f
, &face
->background
, 1);
1733 IF_DEBUG (--ncolors_allocated
);
1736 if (face
->underline_p
1737 && !face
->underline_defaulted_p
)
1739 x_free_colors (f
, &face
->underline_color
, 1);
1740 IF_DEBUG (--ncolors_allocated
);
1743 if (face
->overline_p
1744 && !face
->overline_color_defaulted_p
)
1746 x_free_colors (f
, &face
->overline_color
, 1);
1747 IF_DEBUG (--ncolors_allocated
);
1750 if (face
->strike_through_p
1751 && !face
->strike_through_color_defaulted_p
)
1753 x_free_colors (f
, &face
->strike_through_color
, 1);
1754 IF_DEBUG (--ncolors_allocated
);
1757 if (face
->box
!= FACE_NO_BOX
1758 && !face
->box_color_defaulted_p
)
1760 x_free_colors (f
, &face
->box_color
, 1);
1761 IF_DEBUG (--ncolors_allocated
);
1765 #endif /* HAVE_X_WINDOWS */
1768 #endif /* HAVE_WINDOW_SYSTEM */
1772 /***********************************************************************
1774 ***********************************************************************/
1776 /* An enumerator for each field of an XLFD font name. */
1797 /* An enumerator for each possible slant value of a font. Taken from
1798 the XLFD specification. */
1806 XLFD_SLANT_REVERSE_ITALIC
,
1807 XLFD_SLANT_REVERSE_OBLIQUE
,
1811 /* Relative font weight according to XLFD documentation. */
1815 XLFD_WEIGHT_UNKNOWN
,
1816 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1817 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1818 XLFD_WEIGHT_LIGHT
, /* 30 */
1819 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1820 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1821 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1822 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1823 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1824 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1827 /* Relative proportionate width. */
1831 XLFD_SWIDTH_UNKNOWN
,
1832 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1833 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1834 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1835 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1836 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1837 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1838 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1839 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1840 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1843 /* Structure used for tables mapping XLFD weight, slant, and width
1844 names to numeric and symbolic values. */
1850 Lisp_Object
*symbol
;
1853 /* Table of XLFD slant names and their numeric and symbolic
1854 representations. This table must be sorted by slant names in
1857 static struct table_entry slant_table
[] =
1859 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1860 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1861 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1862 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1863 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1864 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1867 /* Table of XLFD weight names. This table must be sorted by weight
1868 names in ascending order. */
1870 static struct table_entry weight_table
[] =
1872 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1873 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1874 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1875 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1876 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1877 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1878 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1879 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1880 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1881 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1882 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1883 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1884 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1885 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1886 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1887 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1890 /* Table of XLFD width names. This table must be sorted by width
1891 names in ascending order. */
1893 static struct table_entry swidth_table
[] =
1895 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1896 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1897 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1898 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1899 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1900 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1901 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1902 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1903 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1904 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1905 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1906 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1907 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1908 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1909 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1912 /* Structure used to hold the result of splitting font names in XLFD
1913 format into their fields. */
1917 /* The original name which is modified destructively by
1918 split_font_name. The pointer is kept here to be able to free it
1919 if it was allocated from the heap. */
1922 /* Font name fields. Each vector element points into `name' above.
1923 Fields are NUL-terminated. */
1924 char *fields
[XLFD_LAST
];
1926 /* Numeric values for those fields that interest us. See
1927 split_font_name for which these are. */
1928 int numeric
[XLFD_LAST
];
1930 /* If the original name matches one of Vface_font_rescale_alist,
1931 the value is the corresponding rescale ratio. Otherwise, the
1933 double rescale_ratio
;
1935 /* Lower value mean higher priority. */
1936 int registry_priority
;
1939 /* The frame in effect when sorting font names. Set temporarily in
1940 sort_fonts so that it is available in font comparison functions. */
1942 static struct frame
*font_frame
;
1944 /* Order by which font selection chooses fonts. The default values
1945 mean `first, find a best match for the font width, then for the
1946 font height, then for weight, then for slant.' This variable can be
1947 set via set-face-font-sort-order. */
1950 static int font_sort_order
[4] = {
1951 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1954 static int font_sort_order
[4];
1957 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1958 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1959 is a pointer to the matching table entry or null if no table entry
1962 static struct table_entry
*
1963 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1964 struct table_entry
*table
;
1966 struct font_name
*font
;
1969 /* Function split_font_name converts fields to lower-case, so there
1970 is no need to use xstrlwr or xstricmp here. */
1971 char *s
= font
->fields
[field_index
];
1972 int low
, mid
, high
, cmp
;
1979 mid
= (low
+ high
) / 2;
1980 cmp
= strcmp (table
[mid
].name
, s
);
1994 /* Return a numeric representation for font name field
1995 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1996 has DIM entries. Value is the numeric value found or DFLT if no
1997 table entry matches. This function is used to translate weight,
1998 slant, and swidth names of XLFD font names to numeric values. */
2001 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
2002 struct table_entry
*table
;
2004 struct font_name
*font
;
2008 struct table_entry
*p
;
2009 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2010 return p
? p
->numeric
: dflt
;
2014 /* Return a symbolic representation for font name field
2015 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2016 has DIM entries. Value is the symbolic value found or DFLT if no
2017 table entry matches. This function is used to translate weight,
2018 slant, and swidth names of XLFD font names to symbols. */
2020 static INLINE Lisp_Object
2021 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2022 struct table_entry
*table
;
2024 struct font_name
*font
;
2028 struct table_entry
*p
;
2029 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2030 return p
? *p
->symbol
: dflt
;
2034 /* Return a numeric value for the slant of the font given by FONT. */
2037 xlfd_numeric_slant (font
)
2038 struct font_name
*font
;
2040 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2041 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2045 /* Return a symbol representing the weight of the font given by FONT. */
2047 static INLINE Lisp_Object
2048 xlfd_symbolic_slant (font
)
2049 struct font_name
*font
;
2051 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2052 font
, XLFD_SLANT
, Qnormal
);
2056 /* Return a numeric value for the weight of the font given by FONT. */
2059 xlfd_numeric_weight (font
)
2060 struct font_name
*font
;
2062 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2063 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2067 /* Return a symbol representing the slant of the font given by FONT. */
2069 static INLINE Lisp_Object
2070 xlfd_symbolic_weight (font
)
2071 struct font_name
*font
;
2073 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2074 font
, XLFD_WEIGHT
, Qnormal
);
2078 /* Return a numeric value for the swidth of the font whose XLFD font
2079 name fields are found in FONT. */
2082 xlfd_numeric_swidth (font
)
2083 struct font_name
*font
;
2085 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2086 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2090 /* Return a symbolic value for the swidth of FONT. */
2092 static INLINE Lisp_Object
2093 xlfd_symbolic_swidth (font
)
2094 struct font_name
*font
;
2096 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2097 font
, XLFD_SWIDTH
, Qnormal
);
2101 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2102 entries. Value is a pointer to the matching table entry or null if
2103 no element of TABLE contains SYMBOL. */
2105 static struct table_entry
*
2106 face_value (table
, dim
, symbol
)
2107 struct table_entry
*table
;
2113 xassert (SYMBOLP (symbol
));
2115 for (i
= 0; i
< dim
; ++i
)
2116 if (EQ (*table
[i
].symbol
, symbol
))
2119 return i
< dim
? table
+ i
: NULL
;
2123 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2124 entries. Value is -1 if SYMBOL is not found in TABLE. */
2127 face_numeric_value (table
, dim
, symbol
)
2128 struct table_entry
*table
;
2132 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2133 return p
? p
->numeric
: -1;
2137 /* Return a numeric value representing the weight specified by Lisp
2138 symbol WEIGHT. Value is one of the enumerators of enum
2142 face_numeric_weight (weight
)
2145 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2149 /* Return a numeric value representing the slant specified by Lisp
2150 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2153 face_numeric_slant (slant
)
2156 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2160 /* Return a numeric value representing the swidth specified by Lisp
2161 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2164 face_numeric_swidth (width
)
2167 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2170 #ifdef HAVE_WINDOW_SYSTEM
2173 split_font_name_into_vector (fontname
)
2174 Lisp_Object fontname
;
2176 struct font_name font
;
2180 font
.name
= LSTRDUPA (fontname
);
2181 if (! split_font_name (NULL
, &font
, 0))
2183 vec
= Fmake_vector (make_number (XLFD_LAST
), Qnil
);
2184 for (i
= 0; i
< XLFD_LAST
; i
++)
2185 if (font
.fields
[i
][0] != '*')
2186 ASET (vec
, i
, build_string (font
.fields
[i
]));
2191 build_font_name_from_vector (vec
)
2194 struct font_name font
;
2195 Lisp_Object fontname
;
2199 for (i
= 0; i
< XLFD_LAST
; i
++)
2201 font
.fields
[i
] = (NILP (AREF (vec
, i
))
2202 ? "*" : (char *) SDATA (AREF (vec
, i
)));
2203 if ((i
== XLFD_FAMILY
|| i
== XLFD_REGISTRY
)
2204 && (p
= strchr (font
.fields
[i
], '-')))
2206 char *p1
= STRDUPA (font
.fields
[i
]);
2208 p1
[p
- font
.fields
[i
]] = '\0';
2209 if (i
== XLFD_FAMILY
)
2211 font
.fields
[XLFD_FOUNDRY
] = p1
;
2212 font
.fields
[XLFD_FAMILY
] = p
+ 1;
2216 font
.fields
[XLFD_REGISTRY
] = p1
;
2217 font
.fields
[XLFD_ENCODING
] = p
+ 1;
2223 p
= build_font_name (&font
);
2224 fontname
= build_string (p
);
2229 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2233 struct font_name
*font
;
2235 /* Function split_font_name converts fields to lower-case, so there
2236 is no need to use tolower here. */
2237 return *font
->fields
[XLFD_SPACING
] != 'p';
2241 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2243 The actual height of the font when displayed on F depends on the
2244 resolution of both the font and frame. For example, a 10pt font
2245 designed for a 100dpi display will display larger than 10pt on a
2246 75dpi display. (It's not unusual to use fonts not designed for the
2247 display one is using. For example, some intlfonts are available in
2248 72dpi versions, only.)
2250 Value is the real point size of FONT on frame F, or 0 if it cannot
2253 By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */
2256 xlfd_point_size (f
, font
)
2258 struct font_name
*font
;
2260 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2261 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2265 if (*pixel_field
== '[')
2267 /* The pixel size field is `[A B C D]' which specifies
2268 a transformation matrix.
2274 by which all glyphs of the font are transformed. The spec
2275 says that s scalar value N for the pixel size is equivalent
2276 to A = N * resx/resy, B = C = 0, D = N. */
2277 char *start
= pixel_field
+ 1, *end
;
2281 for (i
= 0; i
< 4; ++i
)
2283 matrix
[i
] = strtod (start
, &end
);
2290 pixel
= atoi (pixel_field
);
2292 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel
;
2296 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2302 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2303 of frame F. This function is used to guess a point size of font
2304 when only the pixel height of the font is available. */
2307 pixel_point_size (f
, pixel
)
2311 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2315 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2316 point size of one dot. */
2317 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2318 int_pt
= real_pt
+ 0.5;
2324 /* Return a rescaling ratio of a font of NAME. */
2327 font_rescale_ratio (name
)
2330 Lisp_Object tail
, elt
;
2332 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2335 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2336 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2337 return XFLOAT_DATA (XCDR (elt
));
2343 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2344 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2345 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2346 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2347 zero if the font name doesn't have the format we expect. The
2348 expected format is a font name that starts with a `-' and has
2349 XLFD_LAST fields separated by `-'. */
2352 split_font_name (f
, font
, numeric_p
)
2354 struct font_name
*font
;
2359 double rescale_ratio
;
2362 /* This must be done before splitting the font name. */
2363 rescale_ratio
= font_rescale_ratio (font
->name
);
2365 if (*font
->name
== '-')
2367 char *p
= xstrlwr (font
->name
) + 1;
2369 while (i
< XLFD_LAST
)
2371 font
->fields
[i
] = p
;
2374 /* Pixel and point size may be of the form `[....]'. For
2375 BNF, see XLFD spec, chapter 4. Negative values are
2376 indicated by tilde characters which we replace with
2377 `-' characters, here. */
2379 && (i
- 1 == XLFD_PIXEL_SIZE
2380 || i
- 1 == XLFD_POINT_SIZE
))
2385 for (++p
; *p
&& *p
!= ']'; ++p
)
2389 /* Check that the matrix contains 4 floating point
2391 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2394 if (strtod (start
, &end
) == 0 && start
== end
)
2401 while (*p
&& *p
!= '-')
2411 success_p
= i
== XLFD_LAST
;
2413 /* If requested, and font name was in the expected format,
2414 compute numeric values for some fields. */
2415 if (numeric_p
&& success_p
)
2417 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2418 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2419 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2420 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2421 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2422 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2423 font
->rescale_ratio
= rescale_ratio
;
2426 /* Initialize it to zero. It will be overridden by font_list while
2427 trying alternate registries. */
2428 font
->registry_priority
= 0;
2434 /* Build an XLFD font name from font name fields in FONT. Value is a
2435 pointer to the font name, which is allocated via xmalloc. */
2438 build_font_name (font
)
2439 struct font_name
*font
;
2443 char *font_name
= (char *) xmalloc (size
);
2444 int total_length
= 0;
2446 for (i
= 0; i
< XLFD_LAST
; ++i
)
2448 /* Add 1 because of the leading `-'. */
2449 int len
= strlen (font
->fields
[i
]) + 1;
2451 /* Reallocate font_name if necessary. Add 1 for the final
2453 if (total_length
+ len
+ 1 >= size
)
2455 int new_size
= max (2 * size
, size
+ len
+ 1);
2456 int sz
= new_size
* sizeof *font_name
;
2457 font_name
= (char *) xrealloc (font_name
, sz
);
2461 font_name
[total_length
] = '-';
2462 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2463 total_length
+= len
;
2466 font_name
[total_length
] = 0;
2471 /* Free an array FONTS of N font_name structures. This frees FONTS
2472 itself and all `name' fields in its elements. */
2475 free_font_names (fonts
, n
)
2476 struct font_name
*fonts
;
2480 xfree (fonts
[--n
].name
);
2485 /* Sort vector FONTS of font_name structures which contains NFONTS
2486 elements using qsort and comparison function CMPFN. F is the frame
2487 on which the fonts will be used. The global variable font_frame
2488 is temporarily set to F to make it available in CMPFN. */
2491 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2493 struct font_name
*fonts
;
2495 int (*cmpfn
) P_ ((const void *, const void *));
2498 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2503 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2504 display in x_display_list. FONTS is a pointer to a vector of
2505 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2506 alternative patterns from Valternate_fontname_alist if no fonts are
2507 found matching PATTERN.
2509 For all fonts found, set FONTS[i].name to the name of the font,
2510 allocated via xmalloc, and split font names into fields. Ignore
2511 fonts that we can't parse. Value is the number of fonts found. */
2514 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2517 struct font_name
**pfonts
;
2518 int nfonts
, try_alternatives_p
;
2522 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2523 better to do it the other way around. */
2525 Lisp_Object lpattern
, tem
;
2526 struct font_name
*fonts
= 0;
2527 int num_fonts
= nfonts
;
2530 lpattern
= build_string (pattern
);
2532 /* Get the list of fonts matching PATTERN. */
2535 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2538 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2541 if (nfonts
< 0 && CONSP (lfonts
))
2542 num_fonts
= XFASTINT (Flength (lfonts
));
2544 /* Make a copy of the font names we got from X, and
2545 split them into fields. */
2547 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2549 Lisp_Object elt
, tail
;
2550 const char *name
= SDATA (XCAR (tem
));
2552 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2553 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2557 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2568 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2572 /* Make a copy of the font name. */
2573 fonts
[n
].name
= xstrdup (name
);
2575 if (split_font_name (f
, fonts
+ n
, 1))
2577 if (font_scalable_p (fonts
+ n
)
2578 && !may_use_scalable_font_p (name
))
2581 xfree (fonts
[n
].name
);
2587 xfree (fonts
[n
].name
);
2590 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2591 if (n
== 0 && try_alternatives_p
)
2593 Lisp_Object list
= Valternate_fontname_alist
;
2601 while (CONSP (list
))
2603 Lisp_Object entry
= XCAR (list
);
2605 && STRINGP (XCAR (entry
))
2606 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2613 Lisp_Object patterns
= XCAR (list
);
2616 while (CONSP (patterns
)
2617 /* If list is screwed up, give up. */
2618 && (name
= XCAR (patterns
),
2620 /* Ignore patterns equal to PATTERN because we tried that
2621 already with no success. */
2622 && (strcmp (SDATA (name
), pattern
) == 0
2623 || (n
= x_face_list_fonts (f
, SDATA (name
),
2626 patterns
= XCDR (patterns
);
2634 /* Check if a font matching pattern_offset_t on frame F is available
2635 or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
2636 a font name pattern is generated from FAMILY and REGISTRY. */
2639 face_font_available_p (f
, pattern
)
2641 Lisp_Object pattern
;
2645 if (! STRINGP (pattern
))
2647 Lisp_Object family
, registry
;
2648 char *family_str
, *registry_str
, *pattern_str
;
2650 CHECK_CONS (pattern
);
2651 family
= XCAR (pattern
);
2656 CHECK_STRING (family
);
2657 family_str
= (char *) SDATA (family
);
2659 registry
= XCDR (pattern
);
2660 if (NILP (registry
))
2664 CHECK_STRING (registry
);
2665 registry_str
= (char *) SDATA (registry
);
2668 pattern_str
= (char *) alloca (strlen (family_str
)
2669 + strlen (registry_str
)
2671 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2672 strcat (pattern_str
, family_str
);
2673 strcat (pattern_str
, "-*-");
2674 strcat (pattern_str
, registry_str
);
2675 if (!index (registry_str
, '-'))
2677 if (registry_str
[strlen (registry_str
) - 1] == '*')
2678 strcat (pattern_str
, "-*");
2680 strcat (pattern_str
, "*-*");
2682 pattern
= build_string (pattern_str
);
2685 /* Get the list of fonts matching PATTERN. */
2688 fonts
= w32_list_fonts (f
, pattern
, 0, 1);
2691 fonts
= x_list_fonts (f
, pattern
, -1, 1);
2693 return XINT (Flength (fonts
));
2697 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2698 using comparison function CMPFN. Value is the number of fonts
2699 found. If value is non-zero, *FONTS is set to a vector of
2700 font_name structures allocated from the heap containing matching
2701 fonts. Each element of *FONTS contains a name member that is also
2702 allocated from the heap. Font names in these structures are split
2703 into fields. Use free_font_names to free such an array. */
2706 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2709 int (*cmpfn
) P_ ((const void *, const void *));
2710 struct font_name
**fonts
;
2714 /* Get the list of fonts matching pattern. 100 should suffice. */
2715 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2716 if (INTEGERP (Vfont_list_limit
))
2717 nfonts
= XINT (Vfont_list_limit
);
2720 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2722 /* Sort the resulting array and return it in *FONTS. If no
2723 fonts were found, make sure to set *FONTS to null. */
2725 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2736 /* Compare two font_name structures *A and *B. Value is analogous to
2737 strcmp. Sort order is given by the global variable
2738 font_sort_order. Font names are sorted so that, everything else
2739 being equal, fonts with a resolution closer to that of the frame on
2740 which they are used are listed first. The global variable
2741 font_frame is the frame on which we operate. */
2744 cmp_font_names (a
, b
)
2747 struct font_name
*x
= (struct font_name
*) a
;
2748 struct font_name
*y
= (struct font_name
*) b
;
2751 /* All strings have been converted to lower-case by split_font_name,
2752 so we can use strcmp here. */
2753 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2758 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2760 int j
= font_sort_order
[i
];
2761 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2766 /* Everything else being equal, we prefer fonts with an
2767 y-resolution closer to that of the frame. */
2768 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2769 int x_resy
= x
->numeric
[XLFD_RESY
];
2770 int y_resy
= y
->numeric
[XLFD_RESY
];
2771 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2779 /* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
2780 is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
2781 family name string or nil. REGISTRY is a registry name string.
2782 Set *FONTS to a vector of font_name structures allocated from the
2783 heap containing the fonts found. Value is the number of fonts
2787 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2789 Lisp_Object pattern
, family
, registry
;
2790 struct font_name
**fonts
;
2792 char *pattern_str
, *family_str
, *registry_str
;
2796 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2797 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2799 pattern_str
= (char *) alloca (strlen (family_str
)
2800 + strlen (registry_str
)
2802 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2803 strcat (pattern_str
, family_str
);
2804 strcat (pattern_str
, "-*-");
2805 strcat (pattern_str
, registry_str
);
2806 if (!index (registry_str
, '-'))
2808 if (registry_str
[strlen (registry_str
) - 1] == '*')
2809 strcat (pattern_str
, "-*");
2811 strcat (pattern_str
, "*-*");
2815 pattern_str
= (char *) SDATA (pattern
);
2817 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2821 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2822 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2823 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2826 static struct font_name
*
2827 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2828 struct font_name
*fonts1
, *fonts2
;
2829 int nfonts1
, nfonts2
;
2831 int new_nfonts
= nfonts1
+ nfonts2
;
2832 struct font_name
*new_fonts
;
2834 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2835 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2836 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2843 /* Get a sorted list of fonts of family FAMILY on frame F.
2845 If PATTERN is non-nil, list fonts matching that pattern.
2847 If REGISTRY is non-nil, it is a list of registry (and encoding)
2848 names. Return fonts with those registries and the alternative
2849 registries from Vface_alternative_font_registry_alist.
2851 If REGISTRY is nil return fonts of any registry.
2853 Set *FONTS to a vector of font_name structures allocated from the
2854 heap containing the fonts found. Value is the number of fonts
2858 font_list (f
, pattern
, family
, registry
, fonts
)
2860 Lisp_Object pattern
, family
, registry
;
2861 struct font_name
**fonts
;
2867 if (NILP (registry
))
2868 return font_list_1 (f
, pattern
, family
, registry
, fonts
);
2870 for (reg_prio
= 0, nfonts
= 0; CONSP (registry
); registry
= XCDR (registry
))
2872 Lisp_Object elt
, alter
;
2874 struct font_name
*fonts2
;
2876 elt
= XCAR (registry
);
2877 alter
= Fassoc (elt
, Vface_alternative_font_registry_alist
);
2879 alter
= Fcons (elt
, Qnil
);
2880 for (; CONSP (alter
); alter
= XCDR (alter
), reg_prio
++)
2882 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
), &fonts2
);
2886 for (i
= 0; i
< nfonts2
; i
++)
2887 fonts2
[i
].registry_priority
= reg_prio
;
2889 *fonts
= concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
);
2901 /* Remove elements from LIST whose cars are `equal'. Called from
2902 x-family-fonts and x-font-family-list to remove duplicate font
2906 remove_duplicates (list
)
2909 Lisp_Object tail
= list
;
2911 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2913 Lisp_Object next
= XCDR (tail
);
2914 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2915 XSETCDR (tail
, XCDR (next
));
2922 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2923 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2924 If FAMILY is omitted or nil, list all families.
2925 Otherwise, FAMILY must be a string, possibly containing wildcards
2927 If FRAME is omitted or nil, use the selected frame.
2928 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2929 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2930 FAMILY is the font family name. POINT-SIZE is the size of the
2931 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2932 width, weight and slant of the font. These symbols are the same as for
2933 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2934 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2935 giving the registry and encoding of the font.
2936 The result list is sorted according to the current setting of
2937 the face font sort order. */)
2939 Lisp_Object family
, frame
;
2941 struct frame
*f
= check_x_frame (frame
);
2942 struct font_name
*fonts
;
2945 struct gcpro gcpro1
;
2948 CHECK_STRING (family
);
2952 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2953 for (i
= nfonts
- 1; i
>= 0; --i
)
2955 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2958 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2959 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2960 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2961 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2962 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2963 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2964 tem
= build_font_name (fonts
+ i
);
2965 ASET (v
, 6, build_string (tem
));
2966 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2967 fonts
[i
].fields
[XLFD_ENCODING
]);
2968 ASET (v
, 7, build_string (tem
));
2971 result
= Fcons (v
, result
);
2974 remove_duplicates (result
);
2975 free_font_names (fonts
, nfonts
);
2981 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2983 doc
: /* Return a list of available font families on FRAME.
2984 If FRAME is omitted or nil, use the selected frame.
2985 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2986 is a font family, and FIXED-P is non-nil if fonts of that family
2987 are fixed-pitch. */)
2991 struct frame
*f
= check_x_frame (frame
);
2993 struct font_name
*fonts
;
2995 struct gcpro gcpro1
;
2996 int count
= SPECPDL_INDEX ();
2998 /* Let's consider all fonts. */
2999 specbind (intern ("font-list-limit"), make_number (-1));
3000 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
3004 for (i
= nfonts
- 1; i
>= 0; --i
)
3005 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
3006 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
3009 remove_duplicates (result
);
3010 free_font_names (fonts
, nfonts
);
3012 return unbind_to (count
, result
);
3016 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
3017 doc
: /* Return a list of the names of available fonts matching PATTERN.
3018 If optional arguments FACE and FRAME are specified, return only fonts
3019 the same size as FACE on FRAME.
3020 PATTERN is a string, perhaps with wildcard characters;
3021 the * character matches any substring, and
3022 the ? character matches any single character.
3023 PATTERN is case-insensitive.
3024 FACE is a face name--a symbol.
3026 The return value is a list of strings, suitable as arguments to
3029 Fonts Emacs can't use may or may not be excluded
3030 even if they match PATTERN and FACE.
3031 The optional fourth argument MAXIMUM sets a limit on how many
3032 fonts to match. The first MAXIMUM fonts are reported.
3033 The optional fifth argument WIDTH, if specified, is a number of columns
3034 occupied by a character of a font. In that case, return only fonts
3035 the WIDTH times as wide as FACE on FRAME. */)
3036 (pattern
, face
, frame
, maximum
, width
)
3037 Lisp_Object pattern
, face
, frame
, maximum
, width
;
3044 CHECK_STRING (pattern
);
3050 CHECK_NATNUM (maximum
);
3051 maxnames
= XINT (maximum
);
3055 CHECK_NUMBER (width
);
3057 /* We can't simply call check_x_frame because this function may be
3058 called before any frame is created. */
3059 f
= frame_or_selected_frame (frame
, 2);
3060 if (!FRAME_WINDOW_P (f
))
3062 /* Perhaps we have not yet created any frame. */
3067 /* Determine the width standard for comparison with the fonts we find. */
3073 /* This is of limited utility since it works with character
3074 widths. Keep it for compatibility. --gerd. */
3075 int face_id
= lookup_named_face (f
, face
, 0);
3076 struct face
*face
= (face_id
< 0
3078 : FACE_FROM_ID (f
, face_id
));
3081 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3082 not maximum as on X. Redefine here. */
3084 #define FONT_WIDTH FONT_MAX_WIDTH
3087 if (face
&& face
->font
)
3088 size
= FONT_WIDTH (face
->font
);
3090 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3093 size
*= XINT (width
);
3097 Lisp_Object args
[2];
3099 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3101 /* We don't have to check fontsets. */
3103 args
[1] = list_fontsets (f
, pattern
, size
);
3104 return Fnconc (2, args
);
3108 #endif /* HAVE_WINDOW_SYSTEM */
3112 /***********************************************************************
3114 ***********************************************************************/
3116 /* Access face attributes of face LFACE, a Lisp vector. */
3118 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3119 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3120 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3121 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3122 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3123 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3124 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3125 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3126 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3127 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3128 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3129 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3130 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3131 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3132 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3133 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3134 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3136 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3137 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3139 #define LFACEP(LFACE) \
3141 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3142 && EQ (AREF (LFACE, 0), Qface))
3147 /* Check consistency of Lisp face attribute vector ATTRS. */
3150 check_lface_attrs (attrs
)
3153 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3154 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3155 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3156 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3157 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3158 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3159 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3160 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3161 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3162 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3163 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3164 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3165 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3166 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3167 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3168 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3169 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3170 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3171 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3172 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3173 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3174 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3175 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3176 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3177 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3178 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3179 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3180 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3181 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3182 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3183 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3184 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3185 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3186 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3187 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3188 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3189 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3190 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3191 #ifdef HAVE_WINDOW_SYSTEM
3192 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3193 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3194 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3195 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3196 || NILP (attrs
[LFACE_FONT_INDEX
])
3197 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3198 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3199 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3204 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3212 xassert (LFACEP (lface
));
3213 check_lface_attrs (XVECTOR (lface
)->contents
);
3217 #else /* GLYPH_DEBUG == 0 */
3219 #define check_lface_attrs(attrs) (void) 0
3220 #define check_lface(lface) (void) 0
3222 #endif /* GLYPH_DEBUG == 0 */
3226 /* Face-merge cycle checking. */
3228 /* A `named merge point' is simply a point during face-merging where we
3229 look up a face by name. We keep a stack of which named lookups we're
3230 currently processing so that we can easily detect cycles, using a
3231 linked- list of struct named_merge_point structures, typically
3232 allocated on the stack frame of the named lookup functions which are
3233 active (so no consing is required). */
3234 struct named_merge_point
3236 Lisp_Object face_name
;
3237 struct named_merge_point
*prev
;
3241 /* If a face merging cycle is detected for FACE_NAME, return 0,
3242 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
3243 FACE_NAME, as the head of the linked list pointed to by
3244 NAMED_MERGE_POINTS, and return 1. */
3247 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
3248 Lisp_Object face_name
,
3249 struct named_merge_point
**named_merge_points
)
3251 struct named_merge_point
*prev
;
3253 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
3254 if (EQ (face_name
, prev
->face_name
))
3257 new_named_merge_point
->face_name
= face_name
;
3258 new_named_merge_point
->prev
= *named_merge_points
;
3260 *named_merge_points
= new_named_merge_point
;
3268 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3269 to make it a symbol. If FACE_NAME is an alias for another face,
3270 return that face's name.
3272 Return default face in case of errors. */
3275 resolve_face_name (face_name
, signal_p
)
3276 Lisp_Object face_name
;
3279 Lisp_Object orig_face
;
3280 Lisp_Object tortoise
, hare
;
3282 if (STRINGP (face_name
))
3283 face_name
= intern (SDATA (face_name
));
3285 if (NILP (face_name
) || !SYMBOLP (face_name
))
3288 orig_face
= face_name
;
3289 tortoise
= hare
= face_name
;
3294 hare
= Fget (hare
, Qface_alias
);
3295 if (NILP (hare
) || !SYMBOLP (hare
))
3299 hare
= Fget (hare
, Qface_alias
);
3300 if (NILP (hare
) || !SYMBOLP (hare
))
3303 tortoise
= Fget (tortoise
, Qface_alias
);
3304 if (EQ (hare
, tortoise
))
3307 Fsignal (Qcircular_list
, Fcons (orig_face
, Qnil
));
3316 /* Return the face definition of FACE_NAME on frame F. F null means
3317 return the definition for new frames. FACE_NAME may be a string or
3318 a symbol (apparently Emacs 20.2 allowed strings as face names in
3319 face text properties; Ediff uses that). If FACE_NAME is an alias
3320 for another face, return that face's definition. If SIGNAL_P is
3321 non-zero, signal an error if FACE_NAME is not a valid face name.
3322 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3325 static INLINE Lisp_Object
3326 lface_from_face_name (f
, face_name
, signal_p
)
3328 Lisp_Object face_name
;
3333 face_name
= resolve_face_name (face_name
, signal_p
);
3336 lface
= assq_no_quit (face_name
, f
->face_alist
);
3338 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3341 lface
= XCDR (lface
);
3343 signal_error ("Invalid face", face_name
);
3345 check_lface (lface
);
3350 /* Get face attributes of face FACE_NAME from frame-local faces on
3351 frame F. Store the resulting attributes in ATTRS which must point
3352 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3353 is non-zero, signal an error if FACE_NAME does not name a face.
3354 Otherwise, value is zero if FACE_NAME is not a face. */
3357 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3359 Lisp_Object face_name
;
3366 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3369 bcopy (XVECTOR (lface
)->contents
, attrs
,
3370 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3380 /* Non-zero if all attributes in face attribute vector ATTRS are
3381 specified, i.e. are non-nil. */
3384 lface_fully_specified_p (attrs
)
3389 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3390 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3391 && i
!= LFACE_AVGWIDTH_INDEX
&& i
!= LFACE_FONTSET_INDEX
)
3392 if (UNSPECIFIEDP (attrs
[i
])
3394 /* MAC_TODO: No stipple support on Mac OS yet, this index is
3395 always unspecified. */
3396 && i
!= LFACE_STIPPLE_INDEX
3401 return i
== LFACE_VECTOR_SIZE
;
3404 #ifdef HAVE_WINDOW_SYSTEM
3406 /* Set font-related attributes of Lisp face LFACE from the fullname of
3407 the font opened by FONTNAME. If FORCE_P is zero, set only
3408 unspecified attributes of LFACE. The exception is `font'
3409 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3411 If FONTNAME is not available on frame F,
3412 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3413 If the fullname is not in a valid XLFD format,
3414 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3415 in LFACE and return 1.
3416 Otherwise, return 1. */
3419 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3422 Lisp_Object fontname
;
3423 int force_p
, may_fail_p
;
3425 struct font_name font
;
3430 char *font_name
= SDATA (fontname
);
3431 struct font_info
*font_info
;
3433 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3434 fontset
= fs_query_fontset (fontname
, 0);
3436 font_name
= SDATA (fontset_ascii (fontset
));
3437 else if (fontset
== 0)
3444 /* Check if FONT_NAME is surely available on the system. Usually
3445 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3446 returns quickly. But, even if FONT_NAME is not yet cached,
3447 caching it now is not futail because we anyway load the font
3450 font_info
= FS_LOAD_FONT (f
, font_name
);
3460 font
.name
= STRDUPA (font_info
->full_name
);
3461 have_xlfd_p
= split_font_name (f
, &font
, 1);
3463 /* Set attributes only if unspecified, otherwise face defaults for
3464 new frames would never take effect. If we couldn't get a font
3465 name conforming to XLFD, set normal values. */
3467 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3472 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3473 + strlen (font
.fields
[XLFD_FOUNDRY
])
3475 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3476 font
.fields
[XLFD_FAMILY
]);
3477 val
= build_string (buffer
);
3480 val
= build_string ("*");
3481 LFACE_FAMILY (lface
) = val
;
3484 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3487 pt
= xlfd_point_size (f
, &font
);
3489 pt
= pixel_point_size (f
, font_info
->height
* 10);
3491 LFACE_HEIGHT (lface
) = make_number (pt
);
3494 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3495 LFACE_SWIDTH (lface
)
3496 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3498 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3499 LFACE_AVGWIDTH (lface
)
3501 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3504 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3505 LFACE_WEIGHT (lface
)
3506 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3508 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3510 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3514 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3515 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3519 LFACE_FONT (lface
) = fontname
;
3521 = new_fontset_from_font_name (build_string (font_info
->full_name
));
3522 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3527 #endif /* HAVE_WINDOW_SYSTEM */
3530 /* Merges the face height FROM with the face height TO, and returns the
3531 merged height. If FROM is an invalid height, then INVALID is
3532 returned instead. FROM and TO may be either absolute face heights or
3533 `relative' heights; the returned value is always an absolute height
3534 unless both FROM and TO are relative. GCPRO is a lisp value that
3535 will be protected from garbage-collection if this function makes a
3539 merge_face_heights (from
, to
, invalid
)
3540 Lisp_Object from
, to
, invalid
;
3542 Lisp_Object result
= invalid
;
3544 if (INTEGERP (from
))
3545 /* FROM is absolute, just use it as is. */
3547 else if (FLOATP (from
))
3548 /* FROM is a scale, use it to adjust TO. */
3551 /* relative X absolute => absolute */
3552 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3553 else if (FLOATP (to
))
3554 /* relative X relative => relative */
3555 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3556 else if (UNSPECIFIEDP (to
))
3559 else if (FUNCTIONP (from
))
3560 /* FROM is a function, which use to adjust TO. */
3562 /* Call function with current height as argument.
3563 From is the new height. */
3564 Lisp_Object args
[2];
3568 result
= safe_call (2, args
);
3570 /* Ensure that if TO was absolute, so is the result. */
3571 if (INTEGERP (to
) && !INTEGERP (result
))
3579 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3580 store the resulting attributes in TO, which must be already be
3581 completely specified and contain only absolute attributes. Every
3582 specified attribute of FROM overrides the corresponding attribute of
3583 TO; relative attributes in FROM are merged with the absolute value in
3584 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
3585 loops in face inheritance; it should be 0 when called from other
3589 merge_face_vectors (f
, from
, to
, named_merge_points
)
3591 Lisp_Object
*from
, *to
;
3592 struct named_merge_point
*named_merge_points
;
3596 /* If FROM inherits from some other faces, merge their attributes into
3597 TO before merging FROM's direct attributes. Note that an :inherit
3598 attribute of `unspecified' is the same as one of nil; we never
3599 merge :inherit attributes, so nil is more correct, but lots of
3600 other code uses `unspecified' as a generic value for face attributes. */
3601 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3602 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3603 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
3605 /* If TO specifies a :font attribute, and FROM specifies some
3606 font-related attribute, we need to clear TO's :font attribute
3607 (because it will be inconsistent with whatever FROM specifies, and
3608 FROM takes precedence). */
3609 if (!NILP (to
[LFACE_FONT_INDEX
])
3610 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3611 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3612 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3613 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3614 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3615 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3616 to
[LFACE_FONT_INDEX
] = Qnil
;
3618 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3619 if (!UNSPECIFIEDP (from
[i
]))
3621 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3622 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
3627 /* TO is always an absolute face, which should inherit from nothing.
3628 We blindly copy the :inherit attribute above and fix it up here. */
3629 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3632 /* Merge the named face FACE_NAME on frame F, into the vector of face
3633 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
3634 inheritance. Returns true if FACE_NAME is a valid face name and
3635 merging succeeded. */
3638 merge_named_face (f
, face_name
, to
, named_merge_points
)
3640 Lisp_Object face_name
;
3642 struct named_merge_point
*named_merge_points
;
3644 struct named_merge_point named_merge_point
;
3646 if (push_named_merge_point (&named_merge_point
,
3647 face_name
, &named_merge_points
))
3649 struct gcpro gcpro1
;
3650 Lisp_Object from
[LFACE_VECTOR_SIZE
];
3651 int ok
= get_lface_attributes (f
, face_name
, from
, 0);
3655 GCPRO1 (named_merge_point
.face_name
);
3656 merge_face_vectors (f
, from
, to
, named_merge_points
);
3667 /* Merge face attributes from the lisp `face reference' FACE_REF on
3668 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
3669 problems with FACE_REF cause an error message to be shown. Return
3670 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
3671 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
3672 list structure; it may be 0 for most callers.
3674 FACE_REF may be a single face specification or a list of such
3675 specifications. Each face specification can be:
3677 1. A symbol or string naming a Lisp face.
3679 2. A property list of the form (KEYWORD VALUE ...) where each
3680 KEYWORD is a face attribute name, and value is an appropriate value
3683 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3684 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3685 for compatibility with 20.2.
3687 Face specifications earlier in lists take precedence over later
3691 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
3693 Lisp_Object face_ref
;
3696 struct named_merge_point
*named_merge_points
;
3698 int ok
= 1; /* Succeed without an error? */
3700 if (CONSP (face_ref
))
3702 Lisp_Object first
= XCAR (face_ref
);
3704 if (EQ (first
, Qforeground_color
)
3705 || EQ (first
, Qbackground_color
))
3707 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3708 . COLOR). COLOR must be a string. */
3709 Lisp_Object color_name
= XCDR (face_ref
);
3710 Lisp_Object color
= first
;
3712 if (STRINGP (color_name
))
3714 if (EQ (color
, Qforeground_color
))
3715 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3717 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3722 add_to_log ("Invalid face color", color_name
, Qnil
);
3726 else if (SYMBOLP (first
)
3727 && *SDATA (SYMBOL_NAME (first
)) == ':')
3729 /* Assume this is the property list form. */
3730 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
3732 Lisp_Object keyword
= XCAR (face_ref
);
3733 Lisp_Object value
= XCAR (XCDR (face_ref
));
3736 /* Specifying `unspecified' is a no-op. */
3737 if (EQ (value
, Qunspecified
))
3739 else if (EQ (keyword
, QCfamily
))
3741 if (STRINGP (value
))
3742 to
[LFACE_FAMILY_INDEX
] = value
;
3746 else if (EQ (keyword
, QCheight
))
3748 Lisp_Object new_height
=
3749 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
3751 if (! NILP (new_height
))
3752 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3756 else if (EQ (keyword
, QCweight
))
3759 && face_numeric_weight (value
) >= 0)
3760 to
[LFACE_WEIGHT_INDEX
] = value
;
3764 else if (EQ (keyword
, QCslant
))
3767 && face_numeric_slant (value
) >= 0)
3768 to
[LFACE_SLANT_INDEX
] = value
;
3772 else if (EQ (keyword
, QCunderline
))
3777 to
[LFACE_UNDERLINE_INDEX
] = value
;
3781 else if (EQ (keyword
, QCoverline
))
3786 to
[LFACE_OVERLINE_INDEX
] = value
;
3790 else if (EQ (keyword
, QCstrike_through
))
3795 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3799 else if (EQ (keyword
, QCbox
))
3802 value
= make_number (1);
3803 if (INTEGERP (value
)
3807 to
[LFACE_BOX_INDEX
] = value
;
3811 else if (EQ (keyword
, QCinverse_video
)
3812 || EQ (keyword
, QCreverse_video
))
3814 if (EQ (value
, Qt
) || NILP (value
))
3815 to
[LFACE_INVERSE_INDEX
] = value
;
3819 else if (EQ (keyword
, QCforeground
))
3821 if (STRINGP (value
))
3822 to
[LFACE_FOREGROUND_INDEX
] = value
;
3826 else if (EQ (keyword
, QCbackground
))
3828 if (STRINGP (value
))
3829 to
[LFACE_BACKGROUND_INDEX
] = value
;
3833 else if (EQ (keyword
, QCstipple
))
3835 #ifdef HAVE_X_WINDOWS
3836 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3837 if (!NILP (pixmap_p
))
3838 to
[LFACE_STIPPLE_INDEX
] = value
;
3843 else if (EQ (keyword
, QCwidth
))
3846 && face_numeric_swidth (value
) >= 0)
3847 to
[LFACE_SWIDTH_INDEX
] = value
;
3851 else if (EQ (keyword
, QCinherit
))
3853 /* This is not really very useful; it's just like a
3854 normal face reference. */
3855 if (! merge_face_ref (f
, value
, to
,
3856 err_msgs
, named_merge_points
))
3864 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
3868 face_ref
= XCDR (XCDR (face_ref
));
3873 /* This is a list of face refs. Those at the beginning of the
3874 list take precedence over what follows, so we have to merge
3875 from the end backwards. */
3876 Lisp_Object next
= XCDR (face_ref
);
3879 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
3881 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
3887 /* FACE_REF ought to be a face name. */
3888 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
3889 if (!ok
&& err_msgs
)
3890 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
3897 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3898 Sinternal_make_lisp_face
, 1, 2, 0,
3899 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3900 If FACE was not known as a face before, create a new one.
3901 If optional argument FRAME is specified, make a frame-local face
3902 for that frame. Otherwise operate on the global face definition.
3903 Value is a vector of face attributes. */)
3905 Lisp_Object face
, frame
;
3907 Lisp_Object global_lface
, lface
;
3911 CHECK_SYMBOL (face
);
3912 global_lface
= lface_from_face_name (NULL
, face
, 0);
3916 CHECK_LIVE_FRAME (frame
);
3918 lface
= lface_from_face_name (f
, face
, 0);
3921 f
= NULL
, lface
= Qnil
;
3923 /* Add a global definition if there is none. */
3924 if (NILP (global_lface
))
3926 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3928 AREF (global_lface
, 0) = Qface
;
3929 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3930 Vface_new_frame_defaults
);
3932 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3933 face id to Lisp face is given by the vector lface_id_to_name.
3934 The mapping from Lisp face to Lisp face id is given by the
3935 property `face' of the Lisp face name. */
3936 if (next_lface_id
== lface_id_to_name_size
)
3938 int new_size
= max (50, 2 * lface_id_to_name_size
);
3939 int sz
= new_size
* sizeof *lface_id_to_name
;
3940 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3941 lface_id_to_name_size
= new_size
;
3944 lface_id_to_name
[next_lface_id
] = face
;
3945 Fput (face
, Qface
, make_number (next_lface_id
));
3949 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3950 AREF (global_lface
, i
) = Qunspecified
;
3952 /* Add a frame-local definition. */
3957 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3959 AREF (lface
, 0) = Qface
;
3960 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3963 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3964 AREF (lface
, i
) = Qunspecified
;
3967 lface
= global_lface
;
3969 /* Changing a named face means that all realized faces depending on
3970 that face are invalid. Since we cannot tell which realized faces
3971 depend on the face, make sure they are all removed. This is done
3972 by incrementing face_change_count. The next call to
3973 init_iterator will then free realized faces. */
3974 if (NILP (Fget (face
, Qface_no_inherit
)))
3976 ++face_change_count
;
3977 ++windows_or_buffers_changed
;
3980 xassert (LFACEP (lface
));
3981 check_lface (lface
);
3986 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3987 Sinternal_lisp_face_p
, 1, 2, 0,
3988 doc
: /* Return non-nil if FACE names a face.
3989 If optional second argument FRAME is non-nil, check for the
3990 existence of a frame-local face with name FACE on that frame.
3991 Otherwise check for the existence of a global face. */)
3993 Lisp_Object face
, frame
;
3999 CHECK_LIVE_FRAME (frame
);
4000 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4003 lface
= lface_from_face_name (NULL
, face
, 0);
4009 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
4010 Sinternal_copy_lisp_face
, 4, 4, 0,
4011 doc
: /* Copy face FROM to TO.
4012 If FRAME is t, copy the global face definition of FROM.
4013 Otherwise, copy the frame-local definition of FROM on FRAME.
4014 If NEW-FRAME is a frame, copy that data into the frame-local
4015 definition of TO on NEW-FRAME. If NEW-FRAME is nil.
4016 FRAME controls where the data is copied to.
4018 The value is TO. */)
4019 (from
, to
, frame
, new_frame
)
4020 Lisp_Object from
, to
, frame
, new_frame
;
4022 Lisp_Object lface
, copy
;
4024 CHECK_SYMBOL (from
);
4029 /* Copy global definition of FROM. We don't make copies of
4030 strings etc. because 20.2 didn't do it either. */
4031 lface
= lface_from_face_name (NULL
, from
, 1);
4032 copy
= Finternal_make_lisp_face (to
, Qnil
);
4036 /* Copy frame-local definition of FROM. */
4037 if (NILP (new_frame
))
4039 CHECK_LIVE_FRAME (frame
);
4040 CHECK_LIVE_FRAME (new_frame
);
4041 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
4042 copy
= Finternal_make_lisp_face (to
, new_frame
);
4045 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
4046 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
4048 /* Changing a named face means that all realized faces depending on
4049 that face are invalid. Since we cannot tell which realized faces
4050 depend on the face, make sure they are all removed. This is done
4051 by incrementing face_change_count. The next call to
4052 init_iterator will then free realized faces. */
4053 if (NILP (Fget (to
, Qface_no_inherit
)))
4055 ++face_change_count
;
4056 ++windows_or_buffers_changed
;
4063 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
4064 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
4065 doc
: /* Set attribute ATTR of FACE to VALUE.
4066 FRAME being a frame means change the face on that frame.
4067 FRAME nil means change the face of the selected frame.
4068 FRAME t means change the default for new frames.
4069 FRAME 0 means change the face on all frames, and change the default
4071 (face
, attr
, value
, frame
)
4072 Lisp_Object face
, attr
, value
, frame
;
4075 Lisp_Object old_value
= Qnil
;
4076 /* Set 1 if ATTR is QCfont. */
4077 int font_attr_p
= 0;
4078 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
4079 int font_related_attr_p
= 0;
4081 CHECK_SYMBOL (face
);
4082 CHECK_SYMBOL (attr
);
4084 face
= resolve_face_name (face
, 1);
4086 /* If FRAME is 0, change face on all frames, and change the
4087 default for new frames. */
4088 if (INTEGERP (frame
) && XINT (frame
) == 0)
4091 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
4092 FOR_EACH_FRAME (tail
, frame
)
4093 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4097 /* Set lface to the Lisp attribute vector of FACE. */
4099 lface
= lface_from_face_name (NULL
, face
, 1);
4103 frame
= selected_frame
;
4105 CHECK_LIVE_FRAME (frame
);
4106 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4108 /* If a frame-local face doesn't exist yet, create one. */
4110 lface
= Finternal_make_lisp_face (face
, frame
);
4113 if (EQ (attr
, QCfamily
))
4115 if (!UNSPECIFIEDP (value
))
4117 CHECK_STRING (value
);
4118 if (SCHARS (value
) == 0)
4119 signal_error ("Invalid face family", value
);
4121 old_value
= LFACE_FAMILY (lface
);
4122 LFACE_FAMILY (lface
) = value
;
4123 font_related_attr_p
= 1;
4125 else if (EQ (attr
, QCheight
))
4127 if (!UNSPECIFIEDP (value
))
4131 test
= (EQ (face
, Qdefault
)
4133 /* The default face must have an absolute size,
4134 otherwise, we do a test merge with a random
4135 height to see if VALUE's ok. */
4136 : merge_face_heights (value
, make_number (10), Qnil
));
4138 if (!INTEGERP (test
) || XINT (test
) <= 0)
4139 signal_error ("Invalid face height", value
);
4142 old_value
= LFACE_HEIGHT (lface
);
4143 LFACE_HEIGHT (lface
) = value
;
4144 font_related_attr_p
= 1;
4146 else if (EQ (attr
, QCweight
))
4148 if (!UNSPECIFIEDP (value
))
4150 CHECK_SYMBOL (value
);
4151 if (face_numeric_weight (value
) < 0)
4152 signal_error ("Invalid face weight", value
);
4154 old_value
= LFACE_WEIGHT (lface
);
4155 LFACE_WEIGHT (lface
) = value
;
4156 font_related_attr_p
= 1;
4158 else if (EQ (attr
, QCslant
))
4160 if (!UNSPECIFIEDP (value
))
4162 CHECK_SYMBOL (value
);
4163 if (face_numeric_slant (value
) < 0)
4164 signal_error ("Invalid face slant", value
);
4166 old_value
= LFACE_SLANT (lface
);
4167 LFACE_SLANT (lface
) = value
;
4168 font_related_attr_p
= 1;
4170 else if (EQ (attr
, QCunderline
))
4172 if (!UNSPECIFIEDP (value
))
4173 if ((SYMBOLP (value
)
4175 && !EQ (value
, Qnil
))
4176 /* Underline color. */
4178 && SCHARS (value
) == 0))
4179 signal_error ("Invalid face underline", value
);
4181 old_value
= LFACE_UNDERLINE (lface
);
4182 LFACE_UNDERLINE (lface
) = value
;
4184 else if (EQ (attr
, QCoverline
))
4186 if (!UNSPECIFIEDP (value
))
4187 if ((SYMBOLP (value
)
4189 && !EQ (value
, Qnil
))
4190 /* Overline color. */
4192 && SCHARS (value
) == 0))
4193 signal_error ("Invalid face overline", value
);
4195 old_value
= LFACE_OVERLINE (lface
);
4196 LFACE_OVERLINE (lface
) = value
;
4198 else if (EQ (attr
, QCstrike_through
))
4200 if (!UNSPECIFIEDP (value
))
4201 if ((SYMBOLP (value
)
4203 && !EQ (value
, Qnil
))
4204 /* Strike-through color. */
4206 && SCHARS (value
) == 0))
4207 signal_error ("Invalid face strike-through", value
);
4209 old_value
= LFACE_STRIKE_THROUGH (lface
);
4210 LFACE_STRIKE_THROUGH (lface
) = value
;
4212 else if (EQ (attr
, QCbox
))
4216 /* Allow t meaning a simple box of width 1 in foreground color
4219 value
= make_number (1);
4221 if (UNSPECIFIEDP (value
))
4223 else if (NILP (value
))
4225 else if (INTEGERP (value
))
4226 valid_p
= XINT (value
) != 0;
4227 else if (STRINGP (value
))
4228 valid_p
= SCHARS (value
) > 0;
4229 else if (CONSP (value
))
4245 if (EQ (k
, QCline_width
))
4247 if (!INTEGERP (v
) || XINT (v
) == 0)
4250 else if (EQ (k
, QCcolor
))
4252 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
4255 else if (EQ (k
, QCstyle
))
4257 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4264 valid_p
= NILP (tem
);
4270 signal_error ("Invalid face box", value
);
4272 old_value
= LFACE_BOX (lface
);
4273 LFACE_BOX (lface
) = value
;
4275 else if (EQ (attr
, QCinverse_video
)
4276 || EQ (attr
, QCreverse_video
))
4278 if (!UNSPECIFIEDP (value
))
4280 CHECK_SYMBOL (value
);
4281 if (!EQ (value
, Qt
) && !NILP (value
))
4282 signal_error ("Invalid inverse-video face attribute value", value
);
4284 old_value
= LFACE_INVERSE (lface
);
4285 LFACE_INVERSE (lface
) = value
;
4287 else if (EQ (attr
, QCforeground
))
4289 if (!UNSPECIFIEDP (value
))
4291 /* Don't check for valid color names here because it depends
4292 on the frame (display) whether the color will be valid
4293 when the face is realized. */
4294 CHECK_STRING (value
);
4295 if (SCHARS (value
) == 0)
4296 signal_error ("Empty foreground color value", value
);
4298 old_value
= LFACE_FOREGROUND (lface
);
4299 LFACE_FOREGROUND (lface
) = value
;
4301 else if (EQ (attr
, QCbackground
))
4303 if (!UNSPECIFIEDP (value
))
4305 /* Don't check for valid color names here because it depends
4306 on the frame (display) whether the color will be valid
4307 when the face is realized. */
4308 CHECK_STRING (value
);
4309 if (SCHARS (value
) == 0)
4310 signal_error ("Empty background color value", value
);
4312 old_value
= LFACE_BACKGROUND (lface
);
4313 LFACE_BACKGROUND (lface
) = value
;
4315 else if (EQ (attr
, QCstipple
))
4317 #ifdef HAVE_X_WINDOWS
4318 if (!UNSPECIFIEDP (value
)
4320 && NILP (Fbitmap_spec_p (value
)))
4321 signal_error ("Invalid stipple attribute", value
);
4322 old_value
= LFACE_STIPPLE (lface
);
4323 LFACE_STIPPLE (lface
) = value
;
4324 #endif /* HAVE_X_WINDOWS */
4326 else if (EQ (attr
, QCwidth
))
4328 if (!UNSPECIFIEDP (value
))
4330 CHECK_SYMBOL (value
);
4331 if (face_numeric_swidth (value
) < 0)
4332 signal_error ("Invalid face width", value
);
4334 old_value
= LFACE_SWIDTH (lface
);
4335 LFACE_SWIDTH (lface
) = value
;
4336 font_related_attr_p
= 1;
4338 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4340 #ifdef HAVE_WINDOW_SYSTEM
4341 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4343 /* Set font-related attributes of the Lisp face from an XLFD
4349 f
= SELECTED_FRAME ();
4351 f
= check_x_frame (frame
);
4353 if (!UNSPECIFIEDP (value
))
4355 CHECK_STRING (value
);
4357 /* VALUE may be a fontset name or an alias of fontset. In
4358 such a case, use the base fontset name. */
4359 tmp
= Fquery_fontset (value
, Qnil
);
4362 else if (EQ (attr
, QCfontset
))
4363 signal_error ("Invalid fontset name", value
);
4365 if (EQ (attr
, QCfont
))
4367 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4368 signal_error ("Invalid font or fontset name", value
);
4371 LFACE_FONTSET (lface
) = value
;
4376 #endif /* HAVE_WINDOW_SYSTEM */
4378 else if (EQ (attr
, QCinherit
))
4381 if (SYMBOLP (value
))
4384 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4385 if (!SYMBOLP (XCAR (tail
)))
4388 LFACE_INHERIT (lface
) = value
;
4390 signal_error ("Invalid face inheritance", value
);
4392 else if (EQ (attr
, QCbold
))
4394 old_value
= LFACE_WEIGHT (lface
);
4395 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4396 font_related_attr_p
= 1;
4398 else if (EQ (attr
, QCitalic
))
4400 old_value
= LFACE_SLANT (lface
);
4401 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4402 font_related_attr_p
= 1;
4405 signal_error ("Invalid face attribute name", attr
);
4407 if (font_related_attr_p
4408 && !UNSPECIFIEDP (value
))
4409 /* If a font-related attribute other than QCfont is specified, the
4410 original `font' attribute nor that of default face is useless
4411 to determine a new font. Thus, we set it to nil so that font
4412 selection mechanism doesn't use it. */
4413 LFACE_FONT (lface
) = Qnil
;
4415 /* Changing a named face means that all realized faces depending on
4416 that face are invalid. Since we cannot tell which realized faces
4417 depend on the face, make sure they are all removed. This is done
4418 by incrementing face_change_count. The next call to
4419 init_iterator will then free realized faces. */
4421 && NILP (Fget (face
, Qface_no_inherit
))
4422 && (EQ (attr
, QCfont
)
4423 || EQ (attr
, QCfontset
)
4424 || NILP (Fequal (old_value
, value
))))
4426 ++face_change_count
;
4427 ++windows_or_buffers_changed
;
4430 if (!UNSPECIFIEDP (value
)
4431 && NILP (Fequal (old_value
, value
)))
4437 if (EQ (face
, Qdefault
))
4439 #ifdef HAVE_WINDOW_SYSTEM
4440 /* Changed font-related attributes of the `default' face are
4441 reflected in changed `font' frame parameters. */
4443 && (font_related_attr_p
|| font_attr_p
)
4444 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4445 set_font_frame_param (frame
, lface
);
4447 #endif /* HAVE_WINDOW_SYSTEM */
4449 if (EQ (attr
, QCforeground
))
4450 param
= Qforeground_color
;
4451 else if (EQ (attr
, QCbackground
))
4452 param
= Qbackground_color
;
4454 #ifdef HAVE_WINDOW_SYSTEM
4456 else if (EQ (face
, Qscroll_bar
))
4458 /* Changing the colors of `scroll-bar' sets frame parameters
4459 `scroll-bar-foreground' and `scroll-bar-background'. */
4460 if (EQ (attr
, QCforeground
))
4461 param
= Qscroll_bar_foreground
;
4462 else if (EQ (attr
, QCbackground
))
4463 param
= Qscroll_bar_background
;
4465 #endif /* not WINDOWSNT */
4466 else if (EQ (face
, Qborder
))
4468 /* Changing background color of `border' sets frame parameter
4470 if (EQ (attr
, QCbackground
))
4471 param
= Qborder_color
;
4473 else if (EQ (face
, Qcursor
))
4475 /* Changing background color of `cursor' sets frame parameter
4477 if (EQ (attr
, QCbackground
))
4478 param
= Qcursor_color
;
4480 else if (EQ (face
, Qmouse
))
4482 /* Changing background color of `mouse' sets frame parameter
4484 if (EQ (attr
, QCbackground
))
4485 param
= Qmouse_color
;
4487 #endif /* HAVE_WINDOW_SYSTEM */
4488 else if (EQ (face
, Qmenu
))
4490 /* Indicate that we have to update the menu bar when
4491 realizing faces on FRAME. FRAME t change the
4492 default for new frames. We do this by setting
4493 setting the flag in new face caches */
4496 struct frame
*f
= XFRAME (frame
);
4497 if (FRAME_FACE_CACHE (f
) == NULL
)
4498 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4499 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4502 menu_face_changed_default
= 1;
4508 /* Update `default-frame-alist', which is used for new frames. */
4510 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4513 /* Update the current frame's parameters. */
4516 cons
= XCAR (Vparam_value_alist
);
4517 XSETCAR (cons
, param
);
4518 XSETCDR (cons
, value
);
4519 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4528 #ifdef HAVE_WINDOW_SYSTEM
4530 /* Set the `font' frame parameter of FRAME determined from `default'
4531 face attributes LFACE. If a font name is explicitely
4532 specfied in LFACE, use it as is. Otherwise, determine a font name
4533 from the other font-related atrributes of LFACE. In that case, if
4534 there's no matching font, signals an error. */
4537 set_font_frame_param (frame
, lface
)
4538 Lisp_Object frame
, lface
;
4540 struct frame
*f
= XFRAME (frame
);
4542 if (FRAME_WINDOW_P (f
))
4544 Lisp_Object font_name
;
4547 if (STRINGP (LFACE_FONT (lface
)))
4548 font_name
= LFACE_FONT (lface
);
4551 /* Choose a font name that reflects LFACE's attributes and has
4552 the registry and encoding pattern specified in the default
4553 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4554 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
, NULL
);
4556 error ("No font matches the specified attribute");
4557 font_name
= build_string (font
);
4561 f
->default_face_done_p
= 0;
4562 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4567 /* Update the corresponding face when frame parameter PARAM on frame F
4568 has been assigned the value NEW_VALUE. */
4571 update_face_from_frame_parameter (f
, param
, new_value
)
4573 Lisp_Object param
, new_value
;
4575 Lisp_Object face
= Qnil
;
4578 /* If there are no faces yet, give up. This is the case when called
4579 from Fx_create_frame, and we do the necessary things later in
4580 face-set-after-frame-defaults. */
4581 if (NILP (f
->face_alist
))
4584 if (EQ (param
, Qforeground_color
))
4587 lface
= lface_from_face_name (f
, face
, 1);
4588 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4589 ? new_value
: Qunspecified
);
4590 realize_basic_faces (f
);
4592 else if (EQ (param
, Qbackground_color
))
4596 /* Changing the background color might change the background
4597 mode, so that we have to load new defface specs.
4598 Call frame-set-background-mode to do that. */
4599 XSETFRAME (frame
, f
);
4600 call1 (Qframe_set_background_mode
, frame
);
4603 lface
= lface_from_face_name (f
, face
, 1);
4604 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4605 ? new_value
: Qunspecified
);
4606 realize_basic_faces (f
);
4608 else if (EQ (param
, Qborder_color
))
4611 lface
= lface_from_face_name (f
, face
, 1);
4612 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4613 ? new_value
: Qunspecified
);
4615 else if (EQ (param
, Qcursor_color
))
4618 lface
= lface_from_face_name (f
, face
, 1);
4619 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4620 ? new_value
: Qunspecified
);
4622 else if (EQ (param
, Qmouse_color
))
4625 lface
= lface_from_face_name (f
, face
, 1);
4626 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4627 ? new_value
: Qunspecified
);
4630 /* Changing a named face means that all realized faces depending on
4631 that face are invalid. Since we cannot tell which realized faces
4632 depend on the face, make sure they are all removed. This is done
4633 by incrementing face_change_count. The next call to
4634 init_iterator will then free realized faces. */
4636 && NILP (Fget (face
, Qface_no_inherit
)))
4638 ++face_change_count
;
4639 ++windows_or_buffers_changed
;
4644 /* Get the value of X resource RESOURCE, class CLASS for the display
4645 of frame FRAME. This is here because ordinary `x-get-resource'
4646 doesn't take a frame argument. */
4648 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4649 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4650 (resource
, class, frame
)
4651 Lisp_Object resource
, class, frame
;
4653 Lisp_Object value
= Qnil
;
4654 CHECK_STRING (resource
);
4655 CHECK_STRING (class);
4656 CHECK_LIVE_FRAME (frame
);
4658 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4659 resource
, class, Qnil
, Qnil
);
4665 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4666 If VALUE is "on" or "true", return t. If VALUE is "off" or
4667 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4668 error; if SIGNAL_P is zero, return 0. */
4671 face_boolean_x_resource_value (value
, signal_p
)
4675 Lisp_Object result
= make_number (0);
4677 xassert (STRINGP (value
));
4679 if (xstricmp (SDATA (value
), "on") == 0
4680 || xstricmp (SDATA (value
), "true") == 0)
4682 else if (xstricmp (SDATA (value
), "off") == 0
4683 || xstricmp (SDATA (value
), "false") == 0)
4685 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4686 result
= Qunspecified
;
4688 signal_error ("Invalid face attribute value from X resource", value
);
4694 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4695 Finternal_set_lisp_face_attribute_from_resource
,
4696 Sinternal_set_lisp_face_attribute_from_resource
,
4697 3, 4, 0, doc
: /* */)
4698 (face
, attr
, value
, frame
)
4699 Lisp_Object face
, attr
, value
, frame
;
4701 CHECK_SYMBOL (face
);
4702 CHECK_SYMBOL (attr
);
4703 CHECK_STRING (value
);
4705 if (xstricmp (SDATA (value
), "unspecified") == 0)
4706 value
= Qunspecified
;
4707 else if (EQ (attr
, QCheight
))
4709 value
= Fstring_to_number (value
, make_number (10));
4710 if (XINT (value
) <= 0)
4711 signal_error ("Invalid face height from X resource", value
);
4713 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4714 value
= face_boolean_x_resource_value (value
, 1);
4715 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4716 value
= intern (SDATA (value
));
4717 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4718 value
= face_boolean_x_resource_value (value
, 1);
4719 else if (EQ (attr
, QCunderline
)
4720 || EQ (attr
, QCoverline
)
4721 || EQ (attr
, QCstrike_through
))
4723 Lisp_Object boolean_value
;
4725 /* If the result of face_boolean_x_resource_value is t or nil,
4726 VALUE does NOT specify a color. */
4727 boolean_value
= face_boolean_x_resource_value (value
, 0);
4728 if (SYMBOLP (boolean_value
))
4729 value
= boolean_value
;
4731 else if (EQ (attr
, QCbox
))
4732 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4734 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4737 #endif /* HAVE_WINDOW_SYSTEM */
4740 /***********************************************************************
4742 ***********************************************************************/
4744 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4746 /* Make menus on frame F appear as specified by the `menu' face. */
4749 x_update_menu_appearance (f
)
4752 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4756 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4760 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4761 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4762 const char *myname
= SDATA (Vx_resource_name
);
4765 const char *popup_path
= "popup_menu";
4767 const char *popup_path
= "menu.popup";
4770 if (STRINGP (LFACE_FOREGROUND (lface
)))
4772 sprintf (line
, "%s.%s*foreground: %s",
4774 SDATA (LFACE_FOREGROUND (lface
)));
4775 XrmPutLineResource (&rdb
, line
);
4776 sprintf (line
, "%s.pane.menubar*foreground: %s",
4777 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4778 XrmPutLineResource (&rdb
, line
);
4782 if (STRINGP (LFACE_BACKGROUND (lface
)))
4784 sprintf (line
, "%s.%s*background: %s",
4786 SDATA (LFACE_BACKGROUND (lface
)));
4787 XrmPutLineResource (&rdb
, line
);
4788 sprintf (line
, "%s.pane.menubar*background: %s",
4789 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4790 XrmPutLineResource (&rdb
, line
);
4795 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4796 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4797 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4798 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4799 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4800 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4803 const char *suffix
= "List";
4806 #if defined HAVE_X_I18N
4808 const char *suffix
= "Set";
4810 const char *suffix
= "";
4814 #if defined HAVE_X_I18N
4815 extern char *xic_create_fontsetname
4816 P_ ((char *base_fontname
, Bool motif
));
4817 char *fontsetname
= xic_create_fontsetname (face
->font_name
, motif
);
4819 char *fontsetname
= face
->font_name
;
4821 sprintf (line
, "%s.pane.menubar*font%s: %s",
4822 myname
, suffix
, fontsetname
);
4823 XrmPutLineResource (&rdb
, line
);
4824 sprintf (line
, "%s.%s*font%s: %s",
4825 myname
, popup_path
, suffix
, fontsetname
);
4826 XrmPutLineResource (&rdb
, line
);
4828 if (fontsetname
!= face
->font_name
)
4829 xfree (fontsetname
);
4832 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4833 free_frame_menubar (f
);
4837 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4840 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4841 Sface_attribute_relative_p
,
4843 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4845 Lisp_Object attribute
, value
;
4847 if (EQ (value
, Qunspecified
))
4849 else if (EQ (attribute
, QCheight
))
4850 return INTEGERP (value
) ? Qnil
: Qt
;
4855 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4857 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4858 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4859 the result will be absolute, otherwise it will be relative. */)
4860 (attribute
, value1
, value2
)
4861 Lisp_Object attribute
, value1
, value2
;
4863 if (EQ (value1
, Qunspecified
))
4865 else if (EQ (attribute
, QCheight
))
4866 return merge_face_heights (value1
, value2
, value1
);
4872 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4873 Sinternal_get_lisp_face_attribute
,
4875 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4876 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4877 face attribute name, signal an error.
4878 If the optional argument FRAME is given, report on face SYMBOL in that
4879 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
4880 frames). If FRAME is omitted or nil, use the selected frame. */)
4881 (symbol
, keyword
, frame
)
4882 Lisp_Object symbol
, keyword
, frame
;
4884 Lisp_Object lface
, value
= Qnil
;
4886 CHECK_SYMBOL (symbol
);
4887 CHECK_SYMBOL (keyword
);
4890 lface
= lface_from_face_name (NULL
, symbol
, 1);
4894 frame
= selected_frame
;
4895 CHECK_LIVE_FRAME (frame
);
4896 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4899 if (EQ (keyword
, QCfamily
))
4900 value
= LFACE_FAMILY (lface
);
4901 else if (EQ (keyword
, QCheight
))
4902 value
= LFACE_HEIGHT (lface
);
4903 else if (EQ (keyword
, QCweight
))
4904 value
= LFACE_WEIGHT (lface
);
4905 else if (EQ (keyword
, QCslant
))
4906 value
= LFACE_SLANT (lface
);
4907 else if (EQ (keyword
, QCunderline
))
4908 value
= LFACE_UNDERLINE (lface
);
4909 else if (EQ (keyword
, QCoverline
))
4910 value
= LFACE_OVERLINE (lface
);
4911 else if (EQ (keyword
, QCstrike_through
))
4912 value
= LFACE_STRIKE_THROUGH (lface
);
4913 else if (EQ (keyword
, QCbox
))
4914 value
= LFACE_BOX (lface
);
4915 else if (EQ (keyword
, QCinverse_video
)
4916 || EQ (keyword
, QCreverse_video
))
4917 value
= LFACE_INVERSE (lface
);
4918 else if (EQ (keyword
, QCforeground
))
4919 value
= LFACE_FOREGROUND (lface
);
4920 else if (EQ (keyword
, QCbackground
))
4921 value
= LFACE_BACKGROUND (lface
);
4922 else if (EQ (keyword
, QCstipple
))
4923 value
= LFACE_STIPPLE (lface
);
4924 else if (EQ (keyword
, QCwidth
))
4925 value
= LFACE_SWIDTH (lface
);
4926 else if (EQ (keyword
, QCinherit
))
4927 value
= LFACE_INHERIT (lface
);
4928 else if (EQ (keyword
, QCfont
))
4929 value
= LFACE_FONT (lface
);
4930 else if (EQ (keyword
, QCfontset
))
4931 value
= LFACE_FONTSET (lface
);
4933 signal_error ("Invalid face attribute name", keyword
);
4939 DEFUN ("internal-lisp-face-attribute-values",
4940 Finternal_lisp_face_attribute_values
,
4941 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4942 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4943 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4947 Lisp_Object result
= Qnil
;
4949 CHECK_SYMBOL (attr
);
4951 if (EQ (attr
, QCweight
)
4952 || EQ (attr
, QCslant
)
4953 || EQ (attr
, QCwidth
))
4955 /* Extract permissible symbols from tables. */
4956 struct table_entry
*table
;
4959 if (EQ (attr
, QCweight
))
4960 table
= weight_table
, dim
= DIM (weight_table
);
4961 else if (EQ (attr
, QCslant
))
4962 table
= slant_table
, dim
= DIM (slant_table
);
4964 table
= swidth_table
, dim
= DIM (swidth_table
);
4966 for (i
= 0; i
< dim
; ++i
)
4968 Lisp_Object symbol
= *table
[i
].symbol
;
4969 Lisp_Object tail
= result
;
4972 && !EQ (XCAR (tail
), symbol
))
4976 result
= Fcons (symbol
, result
);
4979 else if (EQ (attr
, QCunderline
))
4980 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4981 else if (EQ (attr
, QCoverline
))
4982 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4983 else if (EQ (attr
, QCstrike_through
))
4984 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4985 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4986 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4992 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4993 Sinternal_merge_in_global_face
, 2, 2, 0,
4994 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4995 Default face attributes override any local face attributes. */)
4997 Lisp_Object face
, frame
;
5000 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
5002 CHECK_LIVE_FRAME (frame
);
5003 global_lface
= lface_from_face_name (NULL
, face
, 1);
5004 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
5005 if (NILP (local_lface
))
5006 local_lface
= Finternal_make_lisp_face (face
, frame
);
5008 /* Make every specified global attribute override the local one.
5009 BEWARE!! This is only used from `face-set-after-frame-default' where
5010 the local frame is defined from default specs in `face-defface-spec'
5011 and those should be overridden by global settings. Hence the strange
5012 "global before local" priority. */
5013 lvec
= XVECTOR (local_lface
)->contents
;
5014 gvec
= XVECTOR (global_lface
)->contents
;
5015 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5016 if (! UNSPECIFIEDP (gvec
[i
]))
5023 /* The following function is implemented for compatibility with 20.2.
5024 The function is used in x-resolve-fonts when it is asked to
5025 return fonts with the same size as the font of a face. This is
5026 done in fontset.el. */
5028 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
5029 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
5030 The font name is, by default, for ASCII characters.
5031 If the optional argument FRAME is given, report on face FACE in that frame.
5032 If FRAME is t, report on the defaults for face FACE (for new frames).
5033 The font default for a face is either nil, or a list
5034 of the form (bold), (italic) or (bold italic).
5035 If FRAME is omitted or nil, use the selected frame. And, in this case,
5036 if the optional third argument CHARACTER is given,
5037 return the font name used for CHARACTER. */)
5038 (face
, frame
, character
)
5039 Lisp_Object face
, frame
, character
;
5043 Lisp_Object result
= Qnil
;
5044 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
5046 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
5047 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
5048 result
= Fcons (Qbold
, result
);
5050 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
5051 && !EQ (LFACE_SLANT (lface
), Qnormal
))
5052 result
= Fcons (Qitalic
, result
);
5058 struct frame
*f
= frame_or_selected_frame (frame
, 1);
5059 int face_id
= lookup_named_face (f
, face
, 1);
5060 struct face
*face
= FACE_FROM_ID (f
, face_id
);
5064 #ifdef HAVE_WINDOW_SYSTEM
5065 if (FRAME_WINDOW_P (f
) && !NILP (character
))
5067 CHECK_CHARACTER (character
);
5068 face_id
= FACE_FOR_CHAR (f
, face
, XINT (character
), -1, Qnil
);
5069 face
= FACE_FROM_ID (f
, face_id
);
5070 return (face
->font
&& face
->font_name
5071 ? build_string (face
->font_name
)
5075 return build_string (face
->font_name
);
5080 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
5081 all attributes are `equal'. Tries to be fast because this function
5082 is called quite often. */
5085 face_attr_equal_p (v1
, v2
)
5088 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
5089 and the other is specified. */
5090 if (XTYPE (v1
) != XTYPE (v2
))
5099 if (SBYTES (v1
) != SBYTES (v2
))
5102 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
5109 return !NILP (Fequal (v1
, v2
));
5114 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
5115 all attributes are `equal'. Tries to be fast because this function
5116 is called quite often. */
5119 lface_equal_p (v1
, v2
)
5120 Lisp_Object
*v1
, *v2
;
5124 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
5125 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
5131 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
5132 Sinternal_lisp_face_equal_p
, 2, 3, 0,
5133 doc
: /* True if FACE1 and FACE2 are equal.
5134 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
5135 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
5136 If FRAME is omitted or nil, use the selected frame. */)
5137 (face1
, face2
, frame
)
5138 Lisp_Object face1
, face2
, frame
;
5142 Lisp_Object lface1
, lface2
;
5147 /* Don't use check_x_frame here because this function is called
5148 before X frames exist. At that time, if FRAME is nil,
5149 selected_frame will be used which is the frame dumped with
5150 Emacs. That frame is not an X frame. */
5151 f
= frame_or_selected_frame (frame
, 2);
5153 lface1
= lface_from_face_name (f
, face1
, 1);
5154 lface2
= lface_from_face_name (f
, face2
, 1);
5155 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
5156 XVECTOR (lface2
)->contents
);
5157 return equal_p
? Qt
: Qnil
;
5161 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
5162 Sinternal_lisp_face_empty_p
, 1, 2, 0,
5163 doc
: /* True if FACE has no attribute specified.
5164 If the optional argument FRAME is given, report on face FACE in that frame.
5165 If FRAME is t, report on the defaults for face FACE (for new frames).
5166 If FRAME is omitted or nil, use the selected frame. */)
5168 Lisp_Object face
, frame
;
5175 frame
= selected_frame
;
5176 CHECK_LIVE_FRAME (frame
);
5180 lface
= lface_from_face_name (NULL
, face
, 1);
5182 lface
= lface_from_face_name (f
, face
, 1);
5184 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5185 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5188 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5192 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5194 doc
: /* Return an alist of frame-local faces defined on FRAME.
5195 For internal use only. */)
5199 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5200 return f
->face_alist
;
5204 /* Return a hash code for Lisp string STRING with case ignored. Used
5205 below in computing a hash value for a Lisp face. */
5207 static INLINE
unsigned
5208 hash_string_case_insensitive (string
)
5211 const unsigned char *s
;
5213 xassert (STRINGP (string
));
5214 for (s
= SDATA (string
); *s
; ++s
)
5215 hash
= (hash
<< 1) ^ tolower (*s
);
5220 /* Return a hash code for face attribute vector V. */
5222 static INLINE
unsigned
5226 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5227 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5228 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5229 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5230 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5231 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5232 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5236 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5237 considering charsets/registries). They do if they specify the same
5238 family, point size, weight, width, slant, font, and fontset. Both
5239 LFACE1 and LFACE2 must be fully-specified. */
5242 lface_same_font_attributes_p (lface1
, lface2
)
5243 Lisp_Object
*lface1
, *lface2
;
5245 xassert (lface_fully_specified_p (lface1
)
5246 && lface_fully_specified_p (lface2
));
5247 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5248 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5249 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5250 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5251 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5252 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5253 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5254 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5255 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5256 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5257 && ! xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5258 SDATA (lface2
[LFACE_FONT_INDEX
]))))
5259 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5260 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5261 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5262 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
5263 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
5269 /***********************************************************************
5271 ***********************************************************************/
5273 /* Allocate and return a new realized face for Lisp face attribute
5276 static struct face
*
5277 make_realized_face (attr
)
5280 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5281 bzero (face
, sizeof *face
);
5282 face
->ascii_face
= face
;
5283 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5288 /* Free realized face FACE, including its X resources. FACE may
5292 free_realized_face (f
, face
)
5298 #ifdef HAVE_WINDOW_SYSTEM
5299 if (FRAME_WINDOW_P (f
))
5301 /* Free fontset of FACE if it is ASCII face. */
5302 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5303 free_face_fontset (f
, face
);
5306 x_free_gc (f
, face
->gc
);
5310 free_face_colors (f
, face
);
5311 x_destroy_bitmap (f
, face
->stipple
);
5313 #endif /* HAVE_WINDOW_SYSTEM */
5320 /* Prepare face FACE for subsequent display on frame F. This
5321 allocated GCs if they haven't been allocated yet or have been freed
5322 by clearing the face cache. */
5325 prepare_face_for_display (f
, face
)
5329 #ifdef HAVE_WINDOW_SYSTEM
5330 xassert (FRAME_WINDOW_P (f
));
5335 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5337 xgcv
.foreground
= face
->foreground
;
5338 xgcv
.background
= face
->background
;
5339 #ifdef HAVE_X_WINDOWS
5340 xgcv
.graphics_exposures
= False
;
5342 /* The font of FACE may be null if we couldn't load it. */
5345 #ifdef HAVE_X_WINDOWS
5346 xgcv
.font
= face
->font
->fid
;
5349 xgcv
.font
= face
->font
;
5352 xgcv
.font
= face
->font
;
5358 #ifdef HAVE_X_WINDOWS
5361 xgcv
.fill_style
= FillOpaqueStippled
;
5362 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5363 mask
|= GCFillStyle
| GCStipple
;
5366 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5369 #endif /* HAVE_WINDOW_SYSTEM */
5373 /* Returns the `distance' between the colors X and Y. */
5376 color_distance (x
, y
)
5379 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5380 Quoting from that paper:
5382 This formula has results that are very close to L*u*v* (with the
5383 modified lightness curve) and, more importantly, it is a more even
5384 algorithm: it does not have a range of colours where it suddenly
5385 gives far from optimal results.
5387 See <http://www.compuphase.com/cmetric.htm> for more info. */
5389 long r
= (x
->red
- y
->red
) >> 8;
5390 long g
= (x
->green
- y
->green
) >> 8;
5391 long b
= (x
->blue
- y
->blue
) >> 8;
5392 long r_mean
= (x
->red
+ y
->red
) >> 9;
5395 (((512 + r_mean
) * r
* r
) >> 8)
5397 + (((767 - r_mean
) * b
* b
) >> 8);
5401 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5402 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5403 COLOR1 and COLOR2 may be either strings containing the color name,
5404 or lists of the form (RED GREEN BLUE).
5405 If FRAME is unspecified or nil, the current frame is used. */)
5406 (color1
, color2
, frame
)
5407 Lisp_Object color1
, color2
, frame
;
5410 XColor cdef1
, cdef2
;
5413 frame
= selected_frame
;
5414 CHECK_LIVE_FRAME (frame
);
5417 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5418 || !STRINGP (color1
)
5419 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5420 signal_error ("Invalid color", color1
);
5421 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5422 || !STRINGP (color2
)
5423 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5424 signal_error ("Invalid color", color2
);
5426 return make_number (color_distance (&cdef1
, &cdef2
));
5430 /***********************************************************************
5432 ***********************************************************************/
5434 /* Return a new face cache for frame F. */
5436 static struct face_cache
*
5440 struct face_cache
*c
;
5443 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5444 bzero (c
, sizeof *c
);
5445 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5446 c
->buckets
= (struct face
**) xmalloc (size
);
5447 bzero (c
->buckets
, size
);
5449 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5451 c
->menu_face_changed_p
= menu_face_changed_default
;
5456 /* Clear out all graphics contexts for all realized faces, except for
5457 the basic faces. This should be done from time to time just to avoid
5458 keeping too many graphics contexts that are no longer needed. */
5462 struct face_cache
*c
;
5464 if (c
&& FRAME_WINDOW_P (c
->f
))
5466 #ifdef HAVE_WINDOW_SYSTEM
5468 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5470 struct face
*face
= c
->faces_by_id
[i
];
5471 if (face
&& face
->gc
)
5473 x_free_gc (c
->f
, face
->gc
);
5477 #endif /* HAVE_WINDOW_SYSTEM */
5482 /* Free all realized faces in face cache C, including basic faces.
5483 C may be null. If faces are freed, make sure the frame's current
5484 matrix is marked invalid, so that a display caused by an expose
5485 event doesn't try to use faces we destroyed. */
5488 free_realized_faces (c
)
5489 struct face_cache
*c
;
5494 struct frame
*f
= c
->f
;
5496 /* We must block input here because we can't process X events
5497 safely while only some faces are freed, or when the frame's
5498 current matrix still references freed faces. */
5501 for (i
= 0; i
< c
->used
; ++i
)
5503 free_realized_face (f
, c
->faces_by_id
[i
]);
5504 c
->faces_by_id
[i
] = NULL
;
5508 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5509 bzero (c
->buckets
, size
);
5511 /* Must do a thorough redisplay the next time. Mark current
5512 matrices as invalid because they will reference faces freed
5513 above. This function is also called when a frame is
5514 destroyed. In this case, the root window of F is nil. */
5515 if (WINDOWP (f
->root_window
))
5517 clear_current_matrices (f
);
5518 ++windows_or_buffers_changed
;
5526 /* Free all realized faces that are using FONTSET on frame F. */
5529 free_realized_faces_for_fontset (f
, fontset
)
5533 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5537 /* We must block input here because we can't process X events safely
5538 while only some faces are freed, or when the frame's current
5539 matrix still references freed faces. */
5542 for (i
= 0; i
< cache
->used
; i
++)
5544 face
= cache
->faces_by_id
[i
];
5546 && face
->fontset
== fontset
)
5548 uncache_face (cache
, face
);
5549 free_realized_face (f
, face
);
5553 /* Must do a thorough redisplay the next time. Mark current
5554 matrices as invalid because they will reference faces freed
5555 above. This function is also called when a frame is destroyed.
5556 In this case, the root window of F is nil. */
5557 if (WINDOWP (f
->root_window
))
5559 clear_current_matrices (f
);
5560 ++windows_or_buffers_changed
;
5567 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5568 This is done after attributes of a named face have been changed,
5569 because we can't tell which realized faces depend on that face. */
5572 free_all_realized_faces (frame
)
5578 FOR_EACH_FRAME (rest
, frame
)
5579 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5582 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5586 /* Free face cache C and faces in it, including their X resources. */
5590 struct face_cache
*c
;
5594 free_realized_faces (c
);
5596 xfree (c
->faces_by_id
);
5602 /* Cache realized face FACE in face cache C. HASH is the hash value
5603 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5604 FACE), insert the new face to the beginning of the collision list
5605 of the face hash table of C. Otherwise, add the new face to the
5606 end of the collision list. This way, lookup_face can quickly find
5607 that a requested face is not cached. */
5610 cache_face (c
, face
, hash
)
5611 struct face_cache
*c
;
5615 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5619 if (face
->ascii_face
!= face
)
5621 struct face
*last
= c
->buckets
[i
];
5632 c
->buckets
[i
] = face
;
5633 face
->prev
= face
->next
= NULL
;
5639 face
->next
= c
->buckets
[i
];
5641 face
->next
->prev
= face
;
5642 c
->buckets
[i
] = face
;
5645 /* Find a free slot in C->faces_by_id and use the index of the free
5646 slot as FACE->id. */
5647 for (i
= 0; i
< c
->used
; ++i
)
5648 if (c
->faces_by_id
[i
] == NULL
)
5652 /* Maybe enlarge C->faces_by_id. */
5655 if (c
->used
== c
->size
)
5658 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
5659 if (new_size
== c
->size
)
5660 abort (); /* Alternatives? ++kfs */
5661 sz
= new_size
* sizeof *c
->faces_by_id
;
5662 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5669 /* Check that FACE got a unique id. */
5674 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5675 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5681 #endif /* GLYPH_DEBUG */
5683 c
->faces_by_id
[i
] = face
;
5687 /* Remove face FACE from cache C. */
5690 uncache_face (c
, face
)
5691 struct face_cache
*c
;
5694 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5697 face
->prev
->next
= face
->next
;
5699 c
->buckets
[i
] = face
->next
;
5702 face
->next
->prev
= face
->prev
;
5704 c
->faces_by_id
[face
->id
] = NULL
;
5705 if (face
->id
== c
->used
)
5710 /* Look up a realized face with face attributes ATTR in the face cache
5711 of frame F. The face will be used to display ASCII characters.
5712 Value is the ID of the face found. If no suitable face is found,
5713 realize a new one. */
5716 lookup_face (f
, attr
)
5720 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5725 xassert (cache
!= NULL
);
5726 check_lface_attrs (attr
);
5728 /* Look up ATTR in the face cache. */
5729 hash
= lface_hash (attr
);
5730 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5732 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5734 if (face
->ascii_face
!= face
)
5736 /* There's no more ASCII face. */
5740 if (face
->hash
== hash
5741 && lface_equal_p (face
->lface
, attr
))
5745 /* If not found, realize a new face. */
5747 face
= realize_face (cache
, attr
, -1);
5750 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5751 #endif /* GLYPH_DEBUG */
5756 #ifdef HAVE_WINDOW_SYSTEM
5757 /* Look up a realized face that has the same attributes as BASE_FACE
5758 except for the font in the face cache of frame F. If FONT_ID is
5759 not negative, it is an ID number of an already opened font that is
5760 used by the face. If FONT_ID is negative, the face has no font.
5761 Value is the ID of the face found. If no suitable face is found,
5762 realize a new one. */
5765 lookup_non_ascii_face (f
, font_id
, base_face
)
5768 struct face
*base_face
;
5770 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5775 xassert (cache
!= NULL
);
5776 base_face
= base_face
->ascii_face
;
5777 hash
= lface_hash (base_face
->lface
);
5778 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5780 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5782 if (face
->ascii_face
== face
)
5784 if (face
->ascii_face
== base_face
5785 && face
->font_info_id
== font_id
)
5789 /* If not found, realize a new face. */
5791 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5794 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5795 #endif /* GLYPH_DEBUG */
5799 #endif /* HAVE_WINDOW_SYSTEM */
5801 /* Return the face id of the realized face for named face SYMBOL on
5802 frame F suitable for displaying ASCII characters. Value is -1 if
5803 the face couldn't be determined, which might happen if the default
5804 face isn't realized and cannot be realized. */
5807 lookup_named_face (f
, symbol
, signal_p
)
5812 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5813 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5814 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5816 if (default_face
== NULL
)
5818 if (!realize_basic_faces (f
))
5820 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5823 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
))
5826 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5827 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5829 return lookup_face (f
, attrs
);
5833 /* Return the ID of the realized ASCII face of Lisp face with ID
5834 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5837 ascii_face_of_lisp_face (f
, lface_id
)
5843 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5845 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5846 face_id
= lookup_named_face (f
, face_name
, 1);
5855 /* Return a face for charset ASCII that is like the face with id
5856 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5857 STEPS < 0 means larger. Value is the id of the face. */
5860 smaller_face (f
, face_id
, steps
)
5864 #ifdef HAVE_WINDOW_SYSTEM
5866 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5867 int pt
, last_pt
, last_height
;
5870 struct face
*new_face
;
5872 /* If not called for an X frame, just return the original face. */
5873 if (FRAME_TERMCAP_P (f
))
5876 /* Try in increments of 1/2 pt. */
5877 delta
= steps
< 0 ? 5 : -5;
5878 steps
= abs (steps
);
5880 face
= FACE_FROM_ID (f
, face_id
);
5881 bcopy (face
->lface
, attrs
, sizeof attrs
);
5882 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5883 new_face_id
= face_id
;
5884 last_height
= FONT_HEIGHT (face
->font
);
5888 /* Give up if we cannot find a font within 10pt. */
5889 && abs (last_pt
- pt
) < 100)
5891 /* Look up a face for a slightly smaller/larger font. */
5893 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5894 new_face_id
= lookup_face (f
, attrs
);
5895 new_face
= FACE_FROM_ID (f
, new_face_id
);
5897 /* If height changes, count that as one step. */
5898 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5899 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5902 last_height
= FONT_HEIGHT (new_face
->font
);
5909 #else /* not HAVE_WINDOW_SYSTEM */
5913 #endif /* not HAVE_WINDOW_SYSTEM */
5917 /* Return a face for charset ASCII that is like the face with id
5918 FACE_ID on frame F, but has height HEIGHT. */
5921 face_with_height (f
, face_id
, height
)
5926 #ifdef HAVE_WINDOW_SYSTEM
5928 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5930 if (FRAME_TERMCAP_P (f
)
5934 face
= FACE_FROM_ID (f
, face_id
);
5935 bcopy (face
->lface
, attrs
, sizeof attrs
);
5936 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5937 face_id
= lookup_face (f
, attrs
);
5938 #endif /* HAVE_WINDOW_SYSTEM */
5944 /* Return the face id of the realized face for named face SYMBOL on
5945 frame F suitable for displaying ASCII characters, and use
5946 attributes of the face FACE_ID for attributes that aren't
5947 completely specified by SYMBOL. This is like lookup_named_face,
5948 except that the default attributes come from FACE_ID, not from the
5949 default face. FACE_ID is assumed to be already realized. */
5952 lookup_derived_face (f
, symbol
, face_id
, signal_p
)
5958 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5959 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5960 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5965 get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
);
5966 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5967 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5968 return lookup_face (f
, attrs
);
5971 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5972 Sface_attributes_as_vector
, 1, 1, 0,
5973 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5978 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5980 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
5987 /***********************************************************************
5988 Face capability testing
5989 ***********************************************************************/
5992 /* If the distance (as returned by color_distance) between two colors is
5993 less than this, then they are considered the same, for determining
5994 whether a color is supported or not. The range of values is 0-65535. */
5996 #define TTY_SAME_COLOR_THRESHOLD 10000
5998 #ifdef HAVE_WINDOW_SYSTEM
6000 /* Return non-zero if all the face attributes in ATTRS are supported
6001 on the window-system frame F.
6003 The definition of `supported' is somewhat heuristic, but basically means
6004 that a face containing all the attributes in ATTRS, when merged with the
6005 default face for display, can be represented in a way that's
6007 \(1) different in appearance than the default face, and
6008 \(2) `close in spirit' to what the attributes specify, if not exact. */
6011 x_supports_face_attributes_p (f
, attrs
, def_face
)
6014 struct face
*def_face
;
6016 Lisp_Object
*def_attrs
= def_face
->lface
;
6018 /* Check that other specified attributes are different that the default
6020 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
6021 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
6022 def_attrs
[LFACE_UNDERLINE_INDEX
]))
6023 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
6024 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
6025 def_attrs
[LFACE_INVERSE_INDEX
]))
6026 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
6027 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
6028 def_attrs
[LFACE_FOREGROUND_INDEX
]))
6029 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
6030 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
6031 def_attrs
[LFACE_BACKGROUND_INDEX
]))
6032 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
6033 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
6034 def_attrs
[LFACE_STIPPLE_INDEX
]))
6035 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
6036 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
6037 def_attrs
[LFACE_OVERLINE_INDEX
]))
6038 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
6039 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6040 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
6041 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
6042 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
6043 def_attrs
[LFACE_BOX_INDEX
])))
6046 /* Check font-related attributes, as those are the most commonly
6047 "unsupported" on a window-system (because of missing fonts). */
6048 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
6049 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
6050 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
6051 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
6052 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
6053 || !UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
]))
6057 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
6059 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
6061 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
6063 face_id
= lookup_face (f
, merged_attrs
);
6064 face
= FACE_FROM_ID (f
, face_id
);
6067 error ("Cannot make face");
6069 /* If the font is the same, then not supported. */
6070 if (face
->font
== def_face
->font
)
6074 /* Everything checks out, this face is supported. */
6078 #endif /* HAVE_WINDOW_SYSTEM */
6080 /* Return non-zero if all the face attributes in ATTRS are supported
6083 The definition of `supported' is somewhat heuristic, but basically means
6084 that a face containing all the attributes in ATTRS, when merged
6085 with the default face for display, can be represented in a way that's
6087 \(1) different in appearance than the default face, and
6088 \(2) `close in spirit' to what the attributes specify, if not exact.
6090 Point (2) implies that a `:weight black' attribute will be satisfied
6091 by any terminal that can display bold, and a `:foreground "yellow"' as
6092 long as the terminal can display a yellowish color, but `:slant italic'
6093 will _not_ be satisfied by the tty display code's automatic
6094 substitution of a `dim' face for italic. */
6097 tty_supports_face_attributes_p (f
, attrs
, def_face
)
6100 struct face
*def_face
;
6103 Lisp_Object val
, fg
, bg
;
6104 XColor fg_tty_color
, fg_std_color
;
6105 XColor bg_tty_color
, bg_std_color
;
6106 unsigned test_caps
= 0;
6107 Lisp_Object
*def_attrs
= def_face
->lface
;
6110 /* First check some easy-to-check stuff; ttys support none of the
6111 following attributes, so we can just return false if any are requested
6112 (even if `nominal' values are specified, we should still return false,
6113 as that will be the same value that the default face uses). We
6114 consider :slant unsupportable on ttys, even though the face code
6115 actually `fakes' them using a dim attribute if possible. This is
6116 because the faked result is too different from what the face
6118 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
6119 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
6120 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
6121 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
6122 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
6123 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
6124 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
6125 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
6129 /* Test for terminal `capabilities' (non-color character attributes). */
6131 /* font weight (bold/dim) */
6132 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6135 int def_weight
= face_numeric_weight (def_attrs
[LFACE_WEIGHT_INDEX
]);
6137 if (weight
> XLFD_WEIGHT_MEDIUM
)
6139 if (def_weight
> XLFD_WEIGHT_MEDIUM
)
6140 return 0; /* same as default */
6141 test_caps
= TTY_CAP_BOLD
;
6143 else if (weight
< XLFD_WEIGHT_MEDIUM
)
6145 if (def_weight
< XLFD_WEIGHT_MEDIUM
)
6146 return 0; /* same as default */
6147 test_caps
= TTY_CAP_DIM
;
6149 else if (def_weight
== XLFD_WEIGHT_MEDIUM
)
6150 return 0; /* same as default */
6154 val
= attrs
[LFACE_UNDERLINE_INDEX
];
6155 if (!UNSPECIFIEDP (val
))
6158 return 0; /* ttys can't use colored underlines */
6159 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6160 return 0; /* same as default */
6162 test_caps
|= TTY_CAP_UNDERLINE
;
6166 val
= attrs
[LFACE_INVERSE_INDEX
];
6167 if (!UNSPECIFIEDP (val
))
6169 if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6170 return 0; /* same as default */
6172 test_caps
|= TTY_CAP_INVERSE
;
6176 /* Color testing. */
6178 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
6179 we use them when calling `tty_capable_p' below, even if the face
6180 specifies no colors. */
6181 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6182 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6184 /* Check if foreground color is close enough. */
6185 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
6188 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6190 if (face_attr_equal_p (fg
, def_fg
))
6191 return 0; /* same as default */
6192 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
6193 return 0; /* not a valid color */
6194 else if (color_distance (&fg_tty_color
, &fg_std_color
)
6195 > TTY_SAME_COLOR_THRESHOLD
)
6196 return 0; /* displayed color is too different */
6198 /* Make sure the color is really different than the default. */
6200 XColor def_fg_color
;
6201 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
6202 && (color_distance (&fg_tty_color
, &def_fg_color
)
6203 <= TTY_SAME_COLOR_THRESHOLD
))
6208 /* Check if background color is close enough. */
6209 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
6212 Lisp_Object def_bg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6214 if (face_attr_equal_p (bg
, def_bg
))
6215 return 0; /* same as default */
6216 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
6217 return 0; /* not a valid color */
6218 else if (color_distance (&bg_tty_color
, &bg_std_color
)
6219 > TTY_SAME_COLOR_THRESHOLD
)
6220 return 0; /* displayed color is too different */
6222 /* Make sure the color is really different than the default. */
6224 XColor def_bg_color
;
6225 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
6226 && (color_distance (&bg_tty_color
, &def_bg_color
)
6227 <= TTY_SAME_COLOR_THRESHOLD
))
6232 /* If both foreground and background are requested, see if the
6233 distance between them is OK. We just check to see if the distance
6234 between the tty's foreground and background is close enough to the
6235 distance between the standard foreground and background. */
6236 if (STRINGP (fg
) && STRINGP (bg
))
6239 = (color_distance (&fg_std_color
, &bg_std_color
)
6240 - color_distance (&fg_tty_color
, &bg_tty_color
));
6241 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
6242 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
6247 /* See if the capabilities we selected above are supported, with the
6249 if (test_caps
!= 0 &&
6250 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
6254 /* Hmmm, everything checks out, this terminal must support this face. */
6259 DEFUN ("display-supports-face-attributes-p",
6260 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
6262 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6263 The optional argument DISPLAY can be a display name, a frame, or
6264 nil (meaning the selected frame's display).
6266 The definition of `supported' is somewhat heuristic, but basically means
6267 that a face containing all the attributes in ATTRIBUTES, when merged
6268 with the default face for display, can be represented in a way that's
6270 \(1) different in appearance than the default face, and
6271 \(2) `close in spirit' to what the attributes specify, if not exact.
6273 Point (2) implies that a `:weight black' attribute will be satisfied by
6274 any display that can display bold, and a `:foreground \"yellow\"' as long
6275 as it can display a yellowish color, but `:slant italic' will _not_ be
6276 satisfied by the tty display code's automatic substitution of a `dim'
6277 face for italic. */)
6278 (attributes
, display
)
6279 Lisp_Object attributes
, display
;
6284 struct face
*def_face
;
6285 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6287 if (noninteractive
|| !initialized
)
6288 /* We may not be able to access low-level face information in batch
6289 mode, or before being dumped, and this function is not going to
6290 be very useful in those cases anyway, so just give up. */
6294 frame
= selected_frame
;
6295 else if (FRAMEP (display
))
6299 /* Find any frame on DISPLAY. */
6300 Lisp_Object fl_tail
;
6303 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
6305 frame
= XCAR (fl_tail
);
6306 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
6307 XFRAME (frame
)->param_alist
)),
6313 CHECK_LIVE_FRAME (frame
);
6316 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
6317 attrs
[i
] = Qunspecified
;
6318 merge_face_ref (f
, attributes
, attrs
, 1, 0);
6320 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6321 if (def_face
== NULL
)
6323 if (! realize_basic_faces (f
))
6324 error ("Cannot realize default face");
6325 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6328 /* Dispatch to the appropriate handler. */
6329 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6330 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
6331 #ifdef HAVE_WINDOW_SYSTEM
6333 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
6336 return supports
? Qt
: Qnil
;
6340 /***********************************************************************
6342 ***********************************************************************/
6344 DEFUN ("internal-set-font-selection-order",
6345 Finternal_set_font_selection_order
,
6346 Sinternal_set_font_selection_order
, 1, 1, 0,
6347 doc
: /* Set font selection order for face font selection to ORDER.
6348 ORDER must be a list of length 4 containing the symbols `:width',
6349 `:height', `:weight', and `:slant'. Face attributes appearing
6350 first in ORDER are matched first, e.g. if `:height' appears before
6351 `:weight' in ORDER, font selection first tries to find a font with
6352 a suitable height, and then tries to match the font weight.
6359 int indices
[DIM (font_sort_order
)];
6362 bzero (indices
, sizeof indices
);
6366 CONSP (list
) && i
< DIM (indices
);
6367 list
= XCDR (list
), ++i
)
6369 Lisp_Object attr
= XCAR (list
);
6372 if (EQ (attr
, QCwidth
))
6374 else if (EQ (attr
, QCheight
))
6375 xlfd
= XLFD_POINT_SIZE
;
6376 else if (EQ (attr
, QCweight
))
6378 else if (EQ (attr
, QCslant
))
6383 if (indices
[i
] != 0)
6388 if (!NILP (list
) || i
!= DIM (indices
))
6389 signal_error ("Invalid font sort order", order
);
6390 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6391 if (indices
[i
] == 0)
6392 signal_error ("Invalid font sort order", order
);
6394 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6396 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6397 free_all_realized_faces (Qnil
);
6404 DEFUN ("internal-set-alternative-font-family-alist",
6405 Finternal_set_alternative_font_family_alist
,
6406 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6407 doc
: /* Define alternative font families to try in face font selection.
6408 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6409 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6410 be found. Value is ALIST. */)
6415 Vface_alternative_font_family_alist
= alist
;
6416 free_all_realized_faces (Qnil
);
6421 DEFUN ("internal-set-alternative-font-registry-alist",
6422 Finternal_set_alternative_font_registry_alist
,
6423 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6424 doc
: /* Define alternative font registries to try in face font selection.
6425 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6426 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6427 be found. Value is ALIST. */)
6432 Vface_alternative_font_registry_alist
= alist
;
6433 free_all_realized_faces (Qnil
);
6438 #ifdef HAVE_WINDOW_SYSTEM
6440 /* Value is non-zero if FONT is the name of a scalable font. The
6441 X11R6 XLFD spec says that point size, pixel size, and average width
6442 are zero for scalable fonts. Intlfonts contain at least one
6443 scalable font ("*-muleindian-1") for which this isn't true, so we
6444 just test average width. */
6447 font_scalable_p (font
)
6448 struct font_name
*font
;
6450 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6451 return (*s
== '0' && *(s
+ 1) == '\0')
6453 /* Windows implementation of XLFD is slightly broken for backward
6454 compatibility with previous broken versions, so test for
6455 wildcards as well as 0. */
6462 /* Ignore the difference of font point size less than this value. */
6464 #define FONT_POINT_SIZE_QUANTUM 5
6466 /* Value is non-zero if FONT1 is a better match for font attributes
6467 VALUES than FONT2. VALUES is an array of face attribute values in
6468 font sort order. COMPARE_PT_P zero means don't compare point
6469 sizes. AVGWIDTH, if not zero, is a specified font average width
6473 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6475 struct font_name
*font1
, *font2
;
6476 int compare_pt_p
, avgwidth
;
6480 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6482 int xlfd_idx
= font_sort_order
[i
];
6484 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6488 if (xlfd_idx
== XLFD_POINT_SIZE
)
6490 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6491 / font1
->rescale_ratio
));
6492 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6493 / font2
->rescale_ratio
));
6494 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6499 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6500 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6503 if (delta1
> delta2
)
6505 else if (delta1
< delta2
)
6509 /* The difference may be equal because, e.g., the face
6510 specifies `italic' but we have only `regular' and
6511 `oblique'. Prefer `oblique' in this case. */
6512 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6513 && font1
->numeric
[xlfd_idx
] > values
[i
]
6514 && font2
->numeric
[xlfd_idx
] < values
[i
])
6522 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6523 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6524 if (delta1
> delta2
)
6526 else if (delta1
< delta2
)
6532 /* We prefer a real scalable font; i.e. not what autoscaled. */
6533 int auto_scaled_1
= (font1
->numeric
[XLFD_POINT_SIZE
] == 0
6534 && font1
->numeric
[XLFD_RESY
] > 0);
6535 int auto_scaled_2
= (font2
->numeric
[XLFD_POINT_SIZE
] == 0
6536 && font2
->numeric
[XLFD_RESY
] > 0);
6538 if (auto_scaled_1
!= auto_scaled_2
)
6539 return auto_scaled_2
;
6542 return font1
->registry_priority
< font2
->registry_priority
;
6546 /* Value is non-zero if FONT is an exact match for face attributes in
6547 SPECIFIED. SPECIFIED is an array of face attribute values in font
6548 sort order. AVGWIDTH, if non-zero, is an average width to compare
6552 exact_face_match_p (specified
, font
, avgwidth
)
6554 struct font_name
*font
;
6559 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6560 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6563 return (i
== DIM (font_sort_order
)
6565 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6569 /* Value is the name of a scaled font, generated from scalable font
6570 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6571 Value is allocated from heap. */
6574 build_scalable_font_name (f
, font
, specified_pt
)
6576 struct font_name
*font
;
6579 char pixel_size
[20];
6581 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6584 if (font
->numeric
[XLFD_PIXEL_SIZE
] != 0
6585 || font
->numeric
[XLFD_POINT_SIZE
] != 0)
6586 /* This is a scalable font but is requested for a specific size.
6587 We should not change that size. */
6588 return build_font_name (font
);
6590 /* If scalable font is for a specific resolution, compute
6591 the point size we must specify from the resolution of
6592 the display and the specified resolution of the font. */
6593 if (font
->numeric
[XLFD_RESY
] != 0)
6595 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6596 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6601 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6603 /* We may need a font of the different size. */
6604 pixel_value
*= font
->rescale_ratio
;
6606 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6607 font of the specified PIXEL_SIZE. */
6609 { /* Set point size of the font. */
6610 char point_size
[20];
6611 sprintf (point_size
, "%d", (int) pt
);
6612 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6613 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6617 /* Set pixel size. */
6618 sprintf (pixel_size
, "%d", pixel_value
);
6619 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6620 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6622 /* If font doesn't specify its resolution, use the
6623 resolution of the display. */
6624 if (font
->numeric
[XLFD_RESY
] == 0)
6627 sprintf (buffer
, "%d", (int) resy
);
6628 font
->fields
[XLFD_RESY
] = buffer
;
6629 font
->numeric
[XLFD_RESY
] = resy
;
6632 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6635 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6636 sprintf (buffer
, "%d", resx
);
6637 font
->fields
[XLFD_RESX
] = buffer
;
6638 font
->numeric
[XLFD_RESX
] = resx
;
6641 return build_font_name (font
);
6645 /* Value is non-zero if we are allowed to use scalable font FONT. We
6646 can't run a Lisp function here since this function may be called
6647 with input blocked. */
6650 may_use_scalable_font_p (font
)
6653 if (EQ (Vscalable_fonts_allowed
, Qt
))
6655 else if (CONSP (Vscalable_fonts_allowed
))
6657 Lisp_Object tail
, regexp
;
6659 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6661 regexp
= XCAR (tail
);
6662 if (STRINGP (regexp
)
6663 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6673 /* Return the name of the best matching font for face attributes ATTRS
6674 in the array of font_name structures FONTS which contains NFONTS
6675 elements. WIDTH_RATIO is a factor with which to multiply average
6676 widths if ATTRS specifies such a width.
6678 Value is a font name which is allocated from the heap. FONTS is
6679 freed by this function.
6681 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6682 indicate whether the resulting font should be drawn using overstrike
6683 to simulate bold-face. */
6686 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6689 struct font_name
*fonts
;
6692 int *needs_overstrike
;
6695 struct font_name
*best
;
6698 int exact_p
, avgwidth
;
6703 /* Make specified font attributes available in `specified',
6704 indexed by sort order. */
6705 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6707 int xlfd_idx
= font_sort_order
[i
];
6709 if (xlfd_idx
== XLFD_SWIDTH
)
6710 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6711 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6712 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6713 else if (xlfd_idx
== XLFD_WEIGHT
)
6714 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6715 else if (xlfd_idx
== XLFD_SLANT
)
6716 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6721 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6723 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6727 if (needs_overstrike
)
6728 *needs_overstrike
= 0;
6730 /* Start with the first non-scalable font in the list. */
6731 for (i
= 0; i
< nfonts
; ++i
)
6732 if (!font_scalable_p (fonts
+ i
))
6735 /* Find the best match among the non-scalable fonts. */
6740 for (i
= 1; i
< nfonts
; ++i
)
6741 if (!font_scalable_p (fonts
+ i
)
6742 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6746 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6754 /* Unless we found an exact match among non-scalable fonts, see if
6755 we can find a better match among scalable fonts. */
6758 /* A scalable font is better if
6760 1. its weight, slant, swidth attributes are better, or.
6762 2. the best non-scalable font doesn't have the required
6763 point size, and the scalable fonts weight, slant, swidth
6766 int non_scalable_has_exact_height_p
;
6768 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6769 non_scalable_has_exact_height_p
= 1;
6771 non_scalable_has_exact_height_p
= 0;
6773 for (i
= 0; i
< nfonts
; ++i
)
6774 if (font_scalable_p (fonts
+ i
))
6777 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6778 || (!non_scalable_has_exact_height_p
6779 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6781 non_scalable_has_exact_height_p
= 1;
6786 if (needs_overstrike
)
6788 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6789 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6791 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6793 /* We want a bold font, but didn't get one; try to use
6794 overstriking instead to simulate bold-face. However,
6795 don't overstrike an already-bold fontn unless the
6796 desired weight grossly exceeds the available weight. */
6797 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6798 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6800 *needs_overstrike
= 1;
6805 if (font_scalable_p (best
))
6806 font_name
= build_scalable_font_name (f
, best
, pt
);
6808 font_name
= build_font_name (best
);
6810 /* Free font_name structures. */
6811 free_font_names (fonts
, nfonts
);
6817 /* Get a list of matching fonts on frame F, considering FAMILY
6818 and alternative font families from Vface_alternative_font_registry_alist.
6820 FAMILY is the font family whose alternatives are considered.
6822 REGISTRY, if a string, specifies a font registry and encoding to
6823 match. A value of nil means include fonts of any registry and
6826 Return in *FONTS a pointer to a vector of font_name structures for
6827 the fonts matched. Value is the number of fonts found. */
6830 try_alternative_families (f
, family
, registry
, fonts
)
6832 Lisp_Object family
, registry
;
6833 struct font_name
**fonts
;
6838 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6841 /* Try alternative font families. */
6842 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6845 for (alter
= XCDR (alter
);
6846 CONSP (alter
) && nfonts
== 0;
6847 alter
= XCDR (alter
))
6849 if (STRINGP (XCAR (alter
)))
6850 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6854 /* Try all scalable fonts before giving up. */
6855 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6857 int count
= SPECPDL_INDEX ();
6858 specbind (Qscalable_fonts_allowed
, Qt
);
6859 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6860 unbind_to (count
, Qnil
);
6867 /* Get a list of matching fonts on frame F.
6869 PATTERN, if a string, specifies a font name pattern to match while
6870 ignoring FAMILY and REGISTRY.
6872 FAMILY, if a list, specifies a list of font families to try.
6874 REGISTRY, if a list, specifies a list of font registries and
6877 Return in *FONTS a pointer to a vector of font_name structures for
6878 the fonts matched. Value is the number of fonts found. */
6881 try_font_list (f
, pattern
, family
, registry
, fonts
)
6883 Lisp_Object pattern
, family
, registry
;
6884 struct font_name
**fonts
;
6888 if (STRINGP (pattern
))
6890 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6891 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6893 int count
= SPECPDL_INDEX ();
6894 specbind (Qscalable_fonts_allowed
, Qt
);
6895 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6896 unbind_to (count
, Qnil
);
6904 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6906 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6907 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6909 /* Try font family of the default face or "fixed". */
6910 if (nfonts
== 0 && !NILP (family
))
6912 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6914 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6916 family
= build_string ("fixed");
6917 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6920 /* Try any family with the given registry. */
6921 if (nfonts
== 0 && !NILP (family
))
6922 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6929 /* Return the fontset id of the base fontset name or alias name given
6930 by the fontset attribute of ATTRS. Value is -1 if the fontset
6931 attribute of ATTRS doesn't name a fontset. */
6934 face_fontset (attrs
)
6939 name
= attrs
[LFACE_FONTSET_INDEX
];
6940 if (!STRINGP (name
))
6942 return fs_query_fontset (name
, 0);
6946 /* Choose a name of font to use on frame F to display characters with
6947 Lisp face attributes specified by ATTRS. The font name is
6948 determined by the font-related attributes in ATTRS and FONT-SPEC
6951 When we are choosing a font for ASCII characters, FONT-SPEC is
6952 always nil. Otherwise FONT-SPEC is a list
6953 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6954 or a string specifying a font name pattern.
6956 If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
6957 indicate whether the resulting font should be drawn using
6958 overstrike to simulate bold-face.
6960 Value is the font name which is allocated from the heap and must be
6961 freed by the caller. */
6964 choose_face_font (f
, attrs
, font_spec
, needs_overstrike
)
6967 Lisp_Object font_spec
;
6968 int *needs_overstrike
;
6970 Lisp_Object pattern
, family
, adstyle
, registry
;
6971 char *font_name
= NULL
;
6972 struct font_name
*fonts
;
6975 if (needs_overstrike
)
6976 *needs_overstrike
= 0;
6978 /* If we are choosing an ASCII font and a font name is explicitly
6979 specified in ATTRS, return it. */
6980 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6981 return xstrdup (SDATA (attrs
[LFACE_FONT_INDEX
]));
6983 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6986 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6988 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6989 ADSTYLE is not used in the font selector for the moment. */
6990 if (VECTORP (font_spec
))
6993 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6994 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6995 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6996 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6998 else if (STRINGP (font_spec
))
7000 pattern
= font_spec
;
7007 /* We are choosing an ASCII font. By default, use the registry
7008 name "iso8859-1". But, if the registry name of the ASCII
7009 font specified in the fontset of ATTRS is not "iso8859-1"
7010 (e.g "iso10646-1"), use also that name with higher
7012 int fontset
= face_fontset (attrs
);
7015 struct font_name font
;
7019 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
7021 ascii
= fontset_ascii (fontset
);
7022 len
= SBYTES (ascii
);
7024 || strcmp (SDATA (ascii
) + len
- 9, "iso8859-1"))
7026 font
.name
= LSTRDUPA (ascii
);
7027 /* Check if the name is in XLFD. */
7028 if (split_font_name (f
, &font
, 0))
7030 font
.fields
[XLFD_ENCODING
][-1] = '-';
7031 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
7037 /* Get a list of fonts matching that pattern and choose the
7038 best match for the specified face attributes from it. */
7039 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
7040 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
),
7045 #endif /* HAVE_WINDOW_SYSTEM */
7049 /***********************************************************************
7051 ***********************************************************************/
7053 /* Realize basic faces on frame F. Value is zero if frame parameters
7054 of F don't contain enough information needed to realize the default
7058 realize_basic_faces (f
)
7062 int count
= SPECPDL_INDEX ();
7064 /* Block input here so that we won't be surprised by an X expose
7065 event, for instance, without having the faces set up. */
7067 specbind (Qscalable_fonts_allowed
, Qt
);
7069 if (realize_default_face (f
))
7071 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
7072 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
7073 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
7074 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
7075 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
7076 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
7077 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
7078 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
7079 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
7080 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
7081 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
7083 /* Reflect changes in the `menu' face in menu bars. */
7084 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
7086 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
7087 #ifdef USE_X_TOOLKIT
7088 x_update_menu_appearance (f
);
7095 unbind_to (count
, Qnil
);
7101 /* Realize the default face on frame F. If the face is not fully
7102 specified, make it fully-specified. Attributes of the default face
7103 that are not explicitly specified are taken from frame parameters. */
7106 realize_default_face (f
)
7109 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7111 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7112 Lisp_Object frame_font
;
7115 /* If the `default' face is not yet known, create it. */
7116 lface
= lface_from_face_name (f
, Qdefault
, 0);
7120 XSETFRAME (frame
, f
);
7121 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
7125 #ifdef HAVE_WINDOW_SYSTEM
7126 if (FRAME_WINDOW_P (f
))
7128 /* Set frame_font to the value of the `font' frame parameter. */
7129 frame_font
= Fassq (Qfont
, f
->param_alist
);
7130 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
7131 frame_font
= XCDR (frame_font
);
7132 set_lface_from_font_name (f
, lface
, frame_font
,
7133 f
->default_face_done_p
, 1);
7134 f
->default_face_done_p
= 1;
7136 #endif /* HAVE_WINDOW_SYSTEM */
7138 if (!FRAME_WINDOW_P (f
))
7140 LFACE_FAMILY (lface
) = build_string ("default");
7141 LFACE_SWIDTH (lface
) = Qnormal
;
7142 LFACE_HEIGHT (lface
) = make_number (1);
7143 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
7144 LFACE_WEIGHT (lface
) = Qnormal
;
7145 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
7146 LFACE_SLANT (lface
) = Qnormal
;
7147 LFACE_AVGWIDTH (lface
) = Qunspecified
;
7150 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
7151 LFACE_UNDERLINE (lface
) = Qnil
;
7153 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
7154 LFACE_OVERLINE (lface
) = Qnil
;
7156 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
7157 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
7159 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
7160 LFACE_BOX (lface
) = Qnil
;
7162 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
7163 LFACE_INVERSE (lface
) = Qnil
;
7165 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
7167 /* This function is called so early that colors are not yet
7168 set in the frame parameter list. */
7169 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
7171 if (CONSP (color
) && STRINGP (XCDR (color
)))
7172 LFACE_FOREGROUND (lface
) = XCDR (color
);
7173 else if (FRAME_WINDOW_P (f
))
7175 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7176 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
7181 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
7183 /* This function is called so early that colors are not yet
7184 set in the frame parameter list. */
7185 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
7186 if (CONSP (color
) && STRINGP (XCDR (color
)))
7187 LFACE_BACKGROUND (lface
) = XCDR (color
);
7188 else if (FRAME_WINDOW_P (f
))
7190 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7191 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
7196 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
7197 LFACE_STIPPLE (lface
) = Qnil
;
7199 /* Realize the face; it must be fully-specified now. */
7200 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
7201 check_lface (lface
);
7202 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
7203 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
7208 /* Realize basic faces other than the default face in face cache C.
7209 SYMBOL is the face name, ID is the face id the realized face must
7210 have. The default face must have been realized already. */
7213 realize_named_face (f
, symbol
, id
)
7218 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7219 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
7220 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7221 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
7222 struct face
*new_face
;
7224 /* The default face must exist and be fully specified. */
7225 get_lface_attributes (f
, Qdefault
, attrs
, 1);
7226 check_lface_attrs (attrs
);
7227 xassert (lface_fully_specified_p (attrs
));
7229 /* If SYMBOL isn't know as a face, create it. */
7233 XSETFRAME (frame
, f
);
7234 lface
= Finternal_make_lisp_face (symbol
, frame
);
7237 /* Merge SYMBOL's face with the default face. */
7238 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
7239 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
7241 /* Realize the face. */
7242 new_face
= realize_face (c
, attrs
, id
);
7246 /* Realize the fully-specified face with attributes ATTRS in face
7247 cache CACHE for ASCII characters. If FORMER_FACE_ID is
7248 non-negative, it is an ID of face to remove before caching the new
7249 face. Value is a pointer to the newly created realized face. */
7251 static struct face
*
7252 realize_face (cache
, attrs
, former_face_id
)
7253 struct face_cache
*cache
;
7259 /* LFACE must be fully specified. */
7260 xassert (cache
!= NULL
);
7261 check_lface_attrs (attrs
);
7263 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
7265 /* Remove the former face. */
7266 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
7267 uncache_face (cache
, former_face
);
7268 free_realized_face (cache
->f
, former_face
);
7271 if (FRAME_WINDOW_P (cache
->f
))
7272 face
= realize_x_face (cache
, attrs
);
7273 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
7274 face
= realize_tty_face (cache
, attrs
);
7278 /* Insert the new face. */
7279 cache_face (cache
, face
, lface_hash (attrs
));
7284 #ifdef HAVE_WINDOW_SYSTEM
7285 /* Realize the fully-specified face that has the same attributes as
7286 BASE_FACE except for the font on frame F. If FONT_ID is not
7287 negative, it is an ID number of an already opened font that should
7288 be used by the face. If FONT_ID is negative, the face has no font,
7289 i.e., characters are displayed by empty boxes. */
7291 static struct face
*
7292 realize_non_ascii_face (f
, font_id
, base_face
)
7295 struct face
*base_face
;
7297 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
7299 struct font_info
*font_info
;
7301 face
= (struct face
*) xmalloc (sizeof *face
);
7305 /* Don't try to free the colors copied bitwise from BASE_FACE. */
7306 face
->colors_copied_bitwise_p
= 1;
7308 face
->font_info_id
= font_id
;
7311 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
7312 face
->font
= font_info
->font
;
7313 face
->font_name
= font_info
->full_name
;
7318 face
->font_name
= NULL
;
7323 cache_face (cache
, face
, face
->hash
);
7327 #endif /* HAVE_WINDOW_SYSTEM */
7330 /* Realize the fully-specified face with attributes ATTRS in face
7331 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
7332 the new face doesn't share font with the default face, a fontname
7333 is allocated from the heap and set in `font_name' of the new face,
7334 but it is not yet loaded here. Value is a pointer to the newly
7335 created realized face. */
7337 static struct face
*
7338 realize_x_face (cache
, attrs
)
7339 struct face_cache
*cache
;
7342 struct face
*face
= NULL
;
7343 #ifdef HAVE_WINDOW_SYSTEM
7344 struct face
*default_face
;
7346 Lisp_Object stipple
, overline
, strike_through
, box
;
7348 xassert (FRAME_WINDOW_P (cache
->f
));
7350 /* Allocate a new realized face. */
7351 face
= make_realized_face (attrs
);
7352 face
->ascii_face
= face
;
7356 /* Determine the font to use. Most of the time, the font will be
7357 the same as the font of the default face, so try that first. */
7358 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7360 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
7362 face
->font
= default_face
->font
;
7363 face
->font_info_id
= default_face
->font_info_id
;
7364 face
->font_name
= default_face
->font_name
;
7366 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
7370 /* If the face attribute ATTRS specifies a fontset, use it as
7371 the base of a new realized fontset. Otherwise, use the same
7372 base fontset as of the default face. The base determines
7373 registry and encoding of a font. It may also determine
7374 foundry and family. The other fields of font name pattern
7375 are constructed from ATTRS. */
7376 int fontset
= face_fontset (attrs
);
7378 /* If we are realizing the default face, ATTRS should specify a
7379 fontset. In other words, if FONTSET is -1, we are not
7380 realizing the default face, thus the default face should have
7381 already been realized. */
7383 fontset
= default_face
->fontset
;
7386 load_face_font (f
, face
);
7387 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
7390 /* Load colors, and set remaining attributes. */
7392 load_face_colors (f
, face
, attrs
);
7395 box
= attrs
[LFACE_BOX_INDEX
];
7398 /* A simple box of line width 1 drawn in color given by
7400 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7402 face
->box
= FACE_SIMPLE_BOX
;
7403 face
->box_line_width
= 1;
7405 else if (INTEGERP (box
))
7407 /* Simple box of specified line width in foreground color of the
7409 xassert (XINT (box
) != 0);
7410 face
->box
= FACE_SIMPLE_BOX
;
7411 face
->box_line_width
= XINT (box
);
7412 face
->box_color
= face
->foreground
;
7413 face
->box_color_defaulted_p
= 1;
7415 else if (CONSP (box
))
7417 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7418 being one of `raised' or `sunken'. */
7419 face
->box
= FACE_SIMPLE_BOX
;
7420 face
->box_color
= face
->foreground
;
7421 face
->box_color_defaulted_p
= 1;
7422 face
->box_line_width
= 1;
7426 Lisp_Object keyword
, value
;
7428 keyword
= XCAR (box
);
7436 if (EQ (keyword
, QCline_width
))
7438 if (INTEGERP (value
) && XINT (value
) != 0)
7439 face
->box_line_width
= XINT (value
);
7441 else if (EQ (keyword
, QCcolor
))
7443 if (STRINGP (value
))
7445 face
->box_color
= load_color (f
, face
, value
,
7447 face
->use_box_color_for_shadows_p
= 1;
7450 else if (EQ (keyword
, QCstyle
))
7452 if (EQ (value
, Qreleased_button
))
7453 face
->box
= FACE_RAISED_BOX
;
7454 else if (EQ (value
, Qpressed_button
))
7455 face
->box
= FACE_SUNKEN_BOX
;
7460 /* Text underline, overline, strike-through. */
7462 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7464 /* Use default color (same as foreground color). */
7465 face
->underline_p
= 1;
7466 face
->underline_defaulted_p
= 1;
7467 face
->underline_color
= 0;
7469 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7471 /* Use specified color. */
7472 face
->underline_p
= 1;
7473 face
->underline_defaulted_p
= 0;
7474 face
->underline_color
7475 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7476 LFACE_UNDERLINE_INDEX
);
7478 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7480 face
->underline_p
= 0;
7481 face
->underline_defaulted_p
= 0;
7482 face
->underline_color
= 0;
7485 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7486 if (STRINGP (overline
))
7488 face
->overline_color
7489 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7490 LFACE_OVERLINE_INDEX
);
7491 face
->overline_p
= 1;
7493 else if (EQ (overline
, Qt
))
7495 face
->overline_color
= face
->foreground
;
7496 face
->overline_color_defaulted_p
= 1;
7497 face
->overline_p
= 1;
7500 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7501 if (STRINGP (strike_through
))
7503 face
->strike_through_color
7504 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7505 LFACE_STRIKE_THROUGH_INDEX
);
7506 face
->strike_through_p
= 1;
7508 else if (EQ (strike_through
, Qt
))
7510 face
->strike_through_color
= face
->foreground
;
7511 face
->strike_through_color_defaulted_p
= 1;
7512 face
->strike_through_p
= 1;
7515 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7516 if (!NILP (stipple
))
7517 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7518 #endif /* HAVE_WINDOW_SYSTEM */
7524 /* Map a specified color of face FACE on frame F to a tty color index.
7525 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7526 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7527 default foreground/background colors. */
7530 map_tty_color (f
, face
, idx
, defaulted
)
7533 enum lface_attribute_index idx
;
7536 Lisp_Object frame
, color
, def
;
7537 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7538 unsigned long default_pixel
, default_other_pixel
, pixel
;
7540 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7544 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7545 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7549 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7550 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7553 XSETFRAME (frame
, f
);
7554 color
= face
->lface
[idx
];
7558 && CONSP (Vtty_defined_color_alist
)
7559 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7562 /* Associations in tty-defined-color-alist are of the form
7563 (NAME INDEX R G B). We need the INDEX part. */
7564 pixel
= XINT (XCAR (XCDR (def
)));
7567 if (pixel
== default_pixel
&& STRINGP (color
))
7569 pixel
= load_color (f
, face
, color
, idx
);
7571 #if defined (MSDOS) || defined (WINDOWSNT)
7572 /* If the foreground of the default face is the default color,
7573 use the foreground color defined by the frame. */
7575 if (FRAME_MSDOS_P (f
))
7578 if (pixel
== default_pixel
7579 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7582 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7584 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7585 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7588 else if (pixel
== default_other_pixel
)
7591 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7593 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7594 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7600 #endif /* MSDOS or WINDOWSNT */
7604 face
->foreground
= pixel
;
7606 face
->background
= pixel
;
7610 /* Realize the fully-specified face with attributes ATTRS in face
7611 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
7612 Value is a pointer to the newly created realized face. */
7614 static struct face
*
7615 realize_tty_face (cache
, attrs
)
7616 struct face_cache
*cache
;
7621 int face_colors_defaulted
= 0;
7622 struct frame
*f
= cache
->f
;
7624 /* Frame must be a termcap frame. */
7625 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7627 /* Allocate a new realized face. */
7628 face
= make_realized_face (attrs
);
7629 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7631 /* Map face attributes to TTY appearances. We map slant to
7632 dimmed text because we want italic text to appear differently
7633 and because dimmed text is probably used infrequently. */
7634 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7635 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7637 if (weight
> XLFD_WEIGHT_MEDIUM
)
7638 face
->tty_bold_p
= 1;
7639 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7640 face
->tty_dim_p
= 1;
7641 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7642 face
->tty_underline_p
= 1;
7643 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7644 face
->tty_reverse_p
= 1;
7646 /* Map color names to color indices. */
7647 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7648 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7650 /* Swap colors if face is inverse-video. If the colors are taken
7651 from the frame colors, they are already inverted, since the
7652 frame-creation function calls x-handle-reverse-video. */
7653 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7655 unsigned long tem
= face
->foreground
;
7656 face
->foreground
= face
->background
;
7657 face
->background
= tem
;
7660 if (tty_suppress_bold_inverse_default_colors_p
7662 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7663 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7664 face
->tty_bold_p
= 0;
7670 DEFUN ("tty-suppress-bold-inverse-default-colors",
7671 Ftty_suppress_bold_inverse_default_colors
,
7672 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7673 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7674 SUPPRESS non-nil means suppress it.
7675 This affects bold faces on TTYs whose foreground is the default background
7676 color of the display and whose background is the default foreground color.
7677 For such faces, the bold face attribute is ignored if this variable
7680 Lisp_Object suppress
;
7682 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7683 ++face_change_count
;
7689 /***********************************************************************
7691 ***********************************************************************/
7693 /* Return the ID of the face to use to display character CH with face
7694 property PROP on frame F in current_buffer. */
7697 compute_char_face (f
, ch
, prop
)
7704 if (NILP (current_buffer
->enable_multibyte_characters
))
7709 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7710 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7714 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7715 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7716 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7717 merge_face_ref (f
, prop
, attrs
, 1, 0);
7718 face_id
= lookup_face (f
, attrs
);
7724 /* Return the face ID associated with buffer position POS for
7725 displaying ASCII characters. Return in *ENDPTR the position at
7726 which a different face is needed, as far as text properties and
7727 overlays are concerned. W is a window displaying current_buffer.
7729 REGION_BEG, REGION_END delimit the region, so it can be
7732 LIMIT is a position not to scan beyond. That is to limit the time
7733 this function can take.
7735 If MOUSE is non-zero, use the character's mouse-face, not its face.
7737 The face returned is suitable for displaying ASCII characters. */
7740 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7741 endptr
, limit
, mouse
)
7744 int region_beg
, region_end
;
7749 struct frame
*f
= XFRAME (w
->frame
);
7750 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7751 Lisp_Object prop
, position
;
7753 Lisp_Object
*overlay_vec
;
7756 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7757 Lisp_Object limit1
, end
;
7758 struct face
*default_face
;
7760 /* W must display the current buffer. We could write this function
7761 to use the frame and buffer of W, but right now it doesn't. */
7762 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7764 XSETFRAME (frame
, f
);
7765 XSETFASTINT (position
, pos
);
7768 if (pos
< region_beg
&& region_beg
< endpos
)
7769 endpos
= region_beg
;
7771 /* Get the `face' or `mouse_face' text property at POS, and
7772 determine the next position at which the property changes. */
7773 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7774 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7775 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7777 endpos
= XINT (end
);
7779 /* Look at properties from overlays. */
7783 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
7784 if (next_overlay
< endpos
)
7785 endpos
= next_overlay
;
7790 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7792 /* Optimize common cases where we can use the default face. */
7795 && !(pos
>= region_beg
&& pos
< region_end
))
7796 return DEFAULT_FACE_ID
;
7798 /* Begin with attributes from the default face. */
7799 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7801 /* Merge in attributes specified via text properties. */
7803 merge_face_ref (f
, prop
, attrs
, 1, 0);
7805 /* Now merge the overlay data. */
7806 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7807 for (i
= 0; i
< noverlays
; i
++)
7812 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7814 merge_face_ref (f
, prop
, attrs
, 1, 0);
7816 oend
= OVERLAY_END (overlay_vec
[i
]);
7817 oendpos
= OVERLAY_POSITION (oend
);
7818 if (oendpos
< endpos
)
7822 /* If in the region, merge in the region face. */
7823 if (pos
>= region_beg
&& pos
< region_end
)
7825 merge_named_face (f
, Qregion
, attrs
, 0);
7827 if (region_end
< endpos
)
7828 endpos
= region_end
;
7833 /* Look up a realized face with the given face attributes,
7834 or realize a new one for ASCII characters. */
7835 return lookup_face (f
, attrs
);
7839 /* Compute the face at character position POS in Lisp string STRING on
7840 window W, for ASCII characters.
7842 If STRING is an overlay string, it comes from position BUFPOS in
7843 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7844 not an overlay string. W must display the current buffer.
7845 REGION_BEG and REGION_END give the start and end positions of the
7846 region; both are -1 if no region is visible.
7848 BASE_FACE_ID is the id of a face to merge with. For strings coming
7849 from overlays or the `display' property it is the face at BUFPOS.
7851 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7853 Set *ENDPTR to the next position where to check for faces in
7854 STRING; -1 if the face is constant from POS to the end of the
7857 Value is the id of the face to use. The face returned is suitable
7858 for displaying ASCII characters. */
7861 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7862 region_end
, endptr
, base_face_id
, mouse_p
)
7866 int region_beg
, region_end
;
7868 enum face_id base_face_id
;
7871 Lisp_Object prop
, position
, end
, limit
;
7872 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7873 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7874 struct face
*base_face
;
7875 int multibyte_p
= STRING_MULTIBYTE (string
);
7876 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7878 /* Get the value of the face property at the current position within
7879 STRING. Value is nil if there is no face property. */
7880 XSETFASTINT (position
, pos
);
7881 prop
= Fget_text_property (position
, prop_name
, string
);
7883 /* Get the next position at which to check for faces. Value of end
7884 is nil if face is constant all the way to the end of the string.
7885 Otherwise it is a string position where to check faces next.
7886 Limit is the maximum position up to which to check for property
7887 changes in Fnext_single_property_change. Strings are usually
7888 short, so set the limit to the end of the string. */
7889 XSETFASTINT (limit
, SCHARS (string
));
7890 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7892 *endptr
= XFASTINT (end
);
7896 base_face
= FACE_FROM_ID (f
, base_face_id
);
7897 xassert (base_face
);
7899 /* Optimize the default case that there is no face property and we
7900 are not in the region. */
7902 && (base_face_id
!= DEFAULT_FACE_ID
7903 /* BUFPOS <= 0 means STRING is not an overlay string, so
7904 that the region doesn't have to be taken into account. */
7906 || bufpos
< region_beg
7907 || bufpos
>= region_end
)
7909 /* We can't realize faces for different charsets differently
7910 if we don't have fonts, so we can stop here if not working
7911 on a window-system frame. */
7912 || !FRAME_WINDOW_P (f
)
7913 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7914 return base_face
->id
;
7916 /* Begin with attributes from the base face. */
7917 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7919 /* Merge in attributes specified via text properties. */
7921 merge_face_ref (f
, prop
, attrs
, 1, 0);
7923 /* If in the region, merge in the region face. */
7925 && bufpos
>= region_beg
7926 && bufpos
< region_end
)
7927 merge_named_face (f
, Qregion
, attrs
, 0);
7929 /* Look up a realized face with the given face attributes,
7930 or realize a new one for ASCII characters. */
7931 return lookup_face (f
, attrs
);
7935 /* Merge a face into a realized face.
7937 F is frame where faces are (to be) realized.
7939 FACE_NAME is named face to merge.
7941 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
7943 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
7945 BASE_FACE_ID is realized face to merge into.
7951 merge_faces (f
, face_name
, face_id
, base_face_id
)
7953 Lisp_Object face_name
;
7954 int face_id
, base_face_id
;
7956 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7957 struct face
*base_face
;
7959 base_face
= FACE_FROM_ID (f
, base_face_id
);
7961 return base_face_id
;
7963 if (EQ (face_name
, Qt
))
7965 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
7966 return base_face_id
;
7967 face_name
= lface_id_to_name
[face_id
];
7968 face_id
= lookup_derived_face (f
, face_name
, base_face_id
, 1);
7971 return base_face_id
;
7974 /* Begin with attributes from the base face. */
7975 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7977 if (!NILP (face_name
))
7979 if (!merge_named_face (f
, face_name
, attrs
, 0))
7980 return base_face_id
;
7986 return base_face_id
;
7987 face
= FACE_FROM_ID (f
, face_id
);
7989 return base_face_id
;
7990 merge_face_vectors (f
, face
->lface
, attrs
, 0);
7993 /* Look up a realized face with the given face attributes,
7994 or realize a new one for ASCII characters. */
7995 return lookup_face (f
, attrs
);
7999 /***********************************************************************
8001 ***********************************************************************/
8005 /* Print the contents of the realized face FACE to stderr. */
8008 dump_realized_face (face
)
8011 fprintf (stderr
, "ID: %d\n", face
->id
);
8012 #ifdef HAVE_X_WINDOWS
8013 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
8015 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
8017 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
8018 fprintf (stderr
, "background: 0x%lx (%s)\n",
8020 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
8021 fprintf (stderr
, "font_name: %s (%s)\n",
8023 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
8024 #ifdef HAVE_X_WINDOWS
8025 fprintf (stderr
, "font = %p\n", face
->font
);
8027 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
8028 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
8029 fprintf (stderr
, "underline: %d (%s)\n",
8031 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
8032 fprintf (stderr
, "hash: %d\n", face
->hash
);
8036 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
8044 fprintf (stderr
, "font selection order: ");
8045 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
8046 fprintf (stderr
, "%d ", font_sort_order
[i
]);
8047 fprintf (stderr
, "\n");
8049 fprintf (stderr
, "alternative fonts: ");
8050 debug_print (Vface_alternative_font_family_alist
);
8051 fprintf (stderr
, "\n");
8053 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
8054 Fdump_face (make_number (i
));
8060 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
8062 error ("Not a valid face");
8063 dump_realized_face (face
);
8070 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
8071 0, 0, 0, doc
: /* */)
8074 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
8075 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
8076 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
8080 #endif /* GLYPH_DEBUG != 0 */
8084 /***********************************************************************
8086 ***********************************************************************/
8091 Qface
= intern ("face");
8093 Qface_no_inherit
= intern ("face-no-inherit");
8094 staticpro (&Qface_no_inherit
);
8095 Qbitmap_spec_p
= intern ("bitmap-spec-p");
8096 staticpro (&Qbitmap_spec_p
);
8097 Qframe_set_background_mode
= intern ("frame-set-background-mode");
8098 staticpro (&Qframe_set_background_mode
);
8100 /* Lisp face attribute keywords. */
8101 QCfamily
= intern (":family");
8102 staticpro (&QCfamily
);
8103 QCheight
= intern (":height");
8104 staticpro (&QCheight
);
8105 QCweight
= intern (":weight");
8106 staticpro (&QCweight
);
8107 QCslant
= intern (":slant");
8108 staticpro (&QCslant
);
8109 QCunderline
= intern (":underline");
8110 staticpro (&QCunderline
);
8111 QCinverse_video
= intern (":inverse-video");
8112 staticpro (&QCinverse_video
);
8113 QCreverse_video
= intern (":reverse-video");
8114 staticpro (&QCreverse_video
);
8115 QCforeground
= intern (":foreground");
8116 staticpro (&QCforeground
);
8117 QCbackground
= intern (":background");
8118 staticpro (&QCbackground
);
8119 QCstipple
= intern (":stipple");;
8120 staticpro (&QCstipple
);
8121 QCwidth
= intern (":width");
8122 staticpro (&QCwidth
);
8123 QCfont
= intern (":font");
8124 staticpro (&QCfont
);
8125 QCfontset
= intern (":fontset");
8126 staticpro (&QCfontset
);
8127 QCbold
= intern (":bold");
8128 staticpro (&QCbold
);
8129 QCitalic
= intern (":italic");
8130 staticpro (&QCitalic
);
8131 QCoverline
= intern (":overline");
8132 staticpro (&QCoverline
);
8133 QCstrike_through
= intern (":strike-through");
8134 staticpro (&QCstrike_through
);
8135 QCbox
= intern (":box");
8137 QCinherit
= intern (":inherit");
8138 staticpro (&QCinherit
);
8140 /* Symbols used for Lisp face attribute values. */
8141 QCcolor
= intern (":color");
8142 staticpro (&QCcolor
);
8143 QCline_width
= intern (":line-width");
8144 staticpro (&QCline_width
);
8145 QCstyle
= intern (":style");
8146 staticpro (&QCstyle
);
8147 Qreleased_button
= intern ("released-button");
8148 staticpro (&Qreleased_button
);
8149 Qpressed_button
= intern ("pressed-button");
8150 staticpro (&Qpressed_button
);
8151 Qnormal
= intern ("normal");
8152 staticpro (&Qnormal
);
8153 Qultra_light
= intern ("ultra-light");
8154 staticpro (&Qultra_light
);
8155 Qextra_light
= intern ("extra-light");
8156 staticpro (&Qextra_light
);
8157 Qlight
= intern ("light");
8158 staticpro (&Qlight
);
8159 Qsemi_light
= intern ("semi-light");
8160 staticpro (&Qsemi_light
);
8161 Qsemi_bold
= intern ("semi-bold");
8162 staticpro (&Qsemi_bold
);
8163 Qbold
= intern ("bold");
8165 Qextra_bold
= intern ("extra-bold");
8166 staticpro (&Qextra_bold
);
8167 Qultra_bold
= intern ("ultra-bold");
8168 staticpro (&Qultra_bold
);
8169 Qoblique
= intern ("oblique");
8170 staticpro (&Qoblique
);
8171 Qitalic
= intern ("italic");
8172 staticpro (&Qitalic
);
8173 Qreverse_oblique
= intern ("reverse-oblique");
8174 staticpro (&Qreverse_oblique
);
8175 Qreverse_italic
= intern ("reverse-italic");
8176 staticpro (&Qreverse_italic
);
8177 Qultra_condensed
= intern ("ultra-condensed");
8178 staticpro (&Qultra_condensed
);
8179 Qextra_condensed
= intern ("extra-condensed");
8180 staticpro (&Qextra_condensed
);
8181 Qcondensed
= intern ("condensed");
8182 staticpro (&Qcondensed
);
8183 Qsemi_condensed
= intern ("semi-condensed");
8184 staticpro (&Qsemi_condensed
);
8185 Qsemi_expanded
= intern ("semi-expanded");
8186 staticpro (&Qsemi_expanded
);
8187 Qexpanded
= intern ("expanded");
8188 staticpro (&Qexpanded
);
8189 Qextra_expanded
= intern ("extra-expanded");
8190 staticpro (&Qextra_expanded
);
8191 Qultra_expanded
= intern ("ultra-expanded");
8192 staticpro (&Qultra_expanded
);
8193 Qbackground_color
= intern ("background-color");
8194 staticpro (&Qbackground_color
);
8195 Qforeground_color
= intern ("foreground-color");
8196 staticpro (&Qforeground_color
);
8197 Qunspecified
= intern ("unspecified");
8198 staticpro (&Qunspecified
);
8200 Qface_alias
= intern ("face-alias");
8201 staticpro (&Qface_alias
);
8202 Qdefault
= intern ("default");
8203 staticpro (&Qdefault
);
8204 Qtool_bar
= intern ("tool-bar");
8205 staticpro (&Qtool_bar
);
8206 Qregion
= intern ("region");
8207 staticpro (&Qregion
);
8208 Qfringe
= intern ("fringe");
8209 staticpro (&Qfringe
);
8210 Qheader_line
= intern ("header-line");
8211 staticpro (&Qheader_line
);
8212 Qscroll_bar
= intern ("scroll-bar");
8213 staticpro (&Qscroll_bar
);
8214 Qmenu
= intern ("menu");
8216 Qcursor
= intern ("cursor");
8217 staticpro (&Qcursor
);
8218 Qborder
= intern ("border");
8219 staticpro (&Qborder
);
8220 Qmouse
= intern ("mouse");
8221 staticpro (&Qmouse
);
8222 Qmode_line_inactive
= intern ("mode-line-inactive");
8223 staticpro (&Qmode_line_inactive
);
8224 Qvertical_border
= intern ("vertical-border");
8225 staticpro (&Qvertical_border
);
8226 Qtty_color_desc
= intern ("tty-color-desc");
8227 staticpro (&Qtty_color_desc
);
8228 Qtty_color_standard_values
= intern ("tty-color-standard-values");
8229 staticpro (&Qtty_color_standard_values
);
8230 Qtty_color_by_index
= intern ("tty-color-by-index");
8231 staticpro (&Qtty_color_by_index
);
8232 Qtty_color_alist
= intern ("tty-color-alist");
8233 staticpro (&Qtty_color_alist
);
8234 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
8235 staticpro (&Qscalable_fonts_allowed
);
8237 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
8238 staticpro (&Vparam_value_alist
);
8239 Vface_alternative_font_family_alist
= Qnil
;
8240 staticpro (&Vface_alternative_font_family_alist
);
8241 Vface_alternative_font_registry_alist
= Qnil
;
8242 staticpro (&Vface_alternative_font_registry_alist
);
8244 defsubr (&Sinternal_make_lisp_face
);
8245 defsubr (&Sinternal_lisp_face_p
);
8246 defsubr (&Sinternal_set_lisp_face_attribute
);
8247 #ifdef HAVE_WINDOW_SYSTEM
8248 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
8250 defsubr (&Scolor_gray_p
);
8251 defsubr (&Scolor_supported_p
);
8252 defsubr (&Sface_attribute_relative_p
);
8253 defsubr (&Smerge_face_attribute
);
8254 defsubr (&Sinternal_get_lisp_face_attribute
);
8255 defsubr (&Sinternal_lisp_face_attribute_values
);
8256 defsubr (&Sinternal_lisp_face_equal_p
);
8257 defsubr (&Sinternal_lisp_face_empty_p
);
8258 defsubr (&Sinternal_copy_lisp_face
);
8259 defsubr (&Sinternal_merge_in_global_face
);
8260 defsubr (&Sface_font
);
8261 defsubr (&Sframe_face_alist
);
8262 defsubr (&Sdisplay_supports_face_attributes_p
);
8263 defsubr (&Scolor_distance
);
8264 defsubr (&Sinternal_set_font_selection_order
);
8265 defsubr (&Sinternal_set_alternative_font_family_alist
);
8266 defsubr (&Sinternal_set_alternative_font_registry_alist
);
8267 defsubr (&Sface_attributes_as_vector
);
8269 defsubr (&Sdump_face
);
8270 defsubr (&Sshow_face_resources
);
8271 #endif /* GLYPH_DEBUG */
8272 defsubr (&Sclear_face_cache
);
8273 defsubr (&Stty_suppress_bold_inverse_default_colors
);
8275 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
8276 defsubr (&Sdump_colors
);
8279 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
8280 doc
: /* *Limit for font matching.
8281 If an integer > 0, font matching functions won't load more than
8282 that number of fonts when searching for a matching font. */);
8283 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
8285 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
8286 doc
: /* List of global face definitions (for internal use only.) */);
8287 Vface_new_frame_defaults
= Qnil
;
8289 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
8290 doc
: /* *Default stipple pattern used on monochrome displays.
8291 This stipple pattern is used on monochrome displays
8292 instead of shades of gray for a face background color.
8293 See `set-face-stipple' for possible values for this variable. */);
8294 Vface_default_stipple
= build_string ("gray3");
8296 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
8297 doc
: /* An alist of defined terminal colors and their RGB values. */);
8298 Vtty_defined_color_alist
= Qnil
;
8300 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
8301 doc
: /* Allowed scalable fonts.
8302 A value of nil means don't allow any scalable fonts.
8303 A value of t means allow any scalable font.
8304 Otherwise, value must be a list of regular expressions. A font may be
8305 scaled if its name matches a regular expression in the list.
8306 Note that if value is nil, a scalable font might still be used, if no
8307 other font of the appropriate family and registry is available. */);
8308 Vscalable_fonts_allowed
= Qnil
;
8310 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
8311 doc
: /* List of ignored fonts.
8312 Each element is a regular expression that matches names of fonts to
8314 Vface_ignored_fonts
= Qnil
;
8316 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
8317 doc
: /* Alist of fonts vs the rescaling factors.
8318 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
8319 FONT-NAME-PATTERN is a regular expression matching a font name, and
8320 RESCALE-RATIO is a floating point number to specify how much larger
8321 \(or smaller) font we should use. For instance, if a face requests
8322 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
8323 Vface_font_rescale_alist
= Qnil
;
8325 #ifdef HAVE_WINDOW_SYSTEM
8326 defsubr (&Sbitmap_spec_p
);
8327 defsubr (&Sx_list_fonts
);
8328 defsubr (&Sinternal_face_x_get_resource
);
8329 defsubr (&Sx_family_fonts
);
8330 defsubr (&Sx_font_family_list
);
8331 #endif /* HAVE_WINDOW_SYSTEM */
8334 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
8335 (do not change this comment) */