1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
3 2005, 2006 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 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 or fontset 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.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
196 #include <sys/types.h>
197 #include <sys/stat.h>
201 #include "keyboard.h"
204 #ifdef HAVE_WINDOW_SYSTEM
206 #endif /* HAVE_WINDOW_SYSTEM */
208 #ifdef HAVE_X_WINDOWS
212 #include <Xm/XmStrDefs.h>
213 #endif /* USE_MOTIF */
214 #endif /* HAVE_X_WINDOWS */
223 /* Redefine X specifics to W32 equivalents to avoid cluttering the
224 code with #ifdef blocks. */
225 #undef FRAME_X_DISPLAY_INFO
226 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
227 #define x_display_info w32_display_info
228 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
229 #define check_x check_w32
230 #define x_list_fonts w32_list_fonts
231 #define GCGraphicsExposures 0
232 #endif /* WINDOWSNT */
236 #define x_display_info mac_display_info
237 #define check_x check_mac
241 #include "dispextern.h"
242 #include "blockinput.h"
244 #include "intervals.h"
246 #ifdef HAVE_X_WINDOWS
248 /* Compensate for a bug in Xos.h on some systems, on which it requires
249 time.h. On some such systems, Xos.h tries to redefine struct
250 timeval and struct timezone if USG is #defined while it is
253 #ifdef XOS_NEEDS_TIME_H
259 #else /* not XOS_NEEDS_TIME_H */
261 #endif /* not XOS_NEEDS_TIME_H */
263 #endif /* HAVE_X_WINDOWS */
267 #define abs(X) ((X) < 0 ? -(X) : (X))
269 /* Number of pt per inch (from the TeXbook). */
271 #define PT_PER_INCH 72.27
273 /* Non-zero if face attribute ATTR is unspecified. */
275 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
277 /* Non-zero if face attribute ATTR is `ignore-defface'. */
279 #define IGNORE_DEFFACE_P(ATTR) EQ ((ATTR), Qignore_defface)
281 /* Value is the number of elements of VECTOR. */
283 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
285 /* Make a copy of string S on the stack using alloca. Value is a pointer
288 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
290 /* Make a copy of the contents of Lisp string S on the stack using
291 alloca. Value is a pointer to the copy. */
293 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
295 /* Size of hash table of realized faces in face caches (should be a
298 #define FACE_CACHE_BUCKETS_SIZE 1001
300 /* Keyword symbols used for face attribute names. */
302 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
303 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
304 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
305 Lisp_Object QCreverse_video
;
306 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
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
;
319 Lisp_Object Qignore_defface
;
321 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
323 /* The name of the function to call when the background of the frame
324 has changed, frame_set_background_mode. */
326 Lisp_Object Qframe_set_background_mode
;
328 /* Names of basic faces. */
330 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
331 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
332 Lisp_Object Qmode_line_inactive
, Qvertical_border
;
333 extern Lisp_Object Qmode_line
;
335 /* The symbol `face-alias'. A symbols having that property is an
336 alias for another face. Value of the property is the name of
339 Lisp_Object Qface_alias
;
341 extern Lisp_Object Qcircular_list
;
343 /* Default stipple pattern used on monochrome displays. This stipple
344 pattern is used on monochrome displays instead of shades of gray
345 for a face background color. See `set-face-stipple' for possible
346 values for this variable. */
348 Lisp_Object Vface_default_stipple
;
350 /* Alist of alternative font families. Each element is of the form
351 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
352 try FAMILY1, then FAMILY2, ... */
354 Lisp_Object Vface_alternative_font_family_alist
;
356 /* Alist of alternative font registries. Each element is of the form
357 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
358 loaded, try REGISTRY1, then REGISTRY2, ... */
360 Lisp_Object Vface_alternative_font_registry_alist
;
362 /* Allowed scalable fonts. A value of nil means don't allow any
363 scalable fonts. A value of t means allow the use of any scalable
364 font. Otherwise, value must be a list of regular expressions. A
365 font may be scaled if its name matches a regular expression in the
368 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
370 /* List of regular expressions that matches names of fonts to ignore. */
372 Lisp_Object Vface_ignored_fonts
;
374 /* Alist of font name patterns vs the rescaling factor. */
376 Lisp_Object Vface_font_rescale_alist
;
378 /* Maximum number of fonts to consider in font_list. If not an
379 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
381 Lisp_Object Vfont_list_limit
;
382 #define DEFAULT_FONT_LIST_LIMIT 100
384 /* The symbols `foreground-color' and `background-color' which can be
385 used as part of a `face' property. This is for compatibility with
388 Lisp_Object Qforeground_color
, Qbackground_color
;
390 /* The symbols `face' and `mouse-face' used as text properties. */
393 extern Lisp_Object Qmouse_face
;
395 /* Property for basic faces which other faces cannot inherit. */
397 Lisp_Object Qface_no_inherit
;
399 /* Error symbol for wrong_type_argument in load_pixmap. */
401 Lisp_Object Qbitmap_spec_p
;
403 /* Alist of global face definitions. Each element is of the form
404 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
405 is a Lisp vector of face attributes. These faces are used
406 to initialize faces for new frames. */
408 Lisp_Object Vface_new_frame_defaults
;
410 /* The next ID to assign to Lisp faces. */
412 static int next_lface_id
;
414 /* A vector mapping Lisp face Id's to face names. */
416 static Lisp_Object
*lface_id_to_name
;
417 static int lface_id_to_name_size
;
419 /* TTY color-related functions (defined in tty-colors.el). */
421 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
423 /* The name of the function used to compute colors on TTYs. */
425 Lisp_Object Qtty_color_alist
;
427 /* An alist of defined terminal colors and their RGB values. */
429 Lisp_Object Vtty_defined_color_alist
;
431 /* Counter for calls to clear_face_cache. If this counter reaches
432 CLEAR_FONT_TABLE_COUNT, and a frame has more than
433 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
435 static int clear_font_table_count
;
436 #define CLEAR_FONT_TABLE_COUNT 100
437 #define CLEAR_FONT_TABLE_NFONTS 10
439 /* Non-zero means face attributes have been changed since the last
440 redisplay. Used in redisplay_internal. */
442 int face_change_count
;
444 /* Non-zero means don't display bold text if a face's foreground
445 and background colors are the inverse of the default colors of the
446 display. This is a kluge to suppress `bold black' foreground text
447 which is hard to read on an LCD monitor. */
449 int tty_suppress_bold_inverse_default_colors_p
;
451 /* A list of the form `((x . y))' used to avoid consing in
452 Finternal_set_lisp_face_attribute. */
454 static Lisp_Object Vparam_value_alist
;
456 /* The total number of colors currently allocated. */
459 static int ncolors_allocated
;
460 static int npixmaps_allocated
;
464 /* Non-zero means the definition of the `menu' face for new frames has
467 int menu_face_changed_default
;
470 /* Function prototypes. */
474 struct named_merge_point
;
476 static void map_tty_color
P_ ((struct frame
*, struct face
*,
477 enum lface_attribute_index
, int *));
478 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
, int));
479 static int may_use_scalable_font_p
P_ ((const char *));
480 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
481 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
483 static int x_face_list_fonts
P_ ((struct frame
*, char *,
484 struct font_name
**, int, int));
485 static int font_scalable_p
P_ ((struct font_name
*));
486 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
487 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
488 static unsigned char *xstrlwr
P_ ((unsigned char *));
489 static void signal_error
P_ ((char *, Lisp_Object
));
490 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
491 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
492 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
493 static void free_face_colors
P_ ((struct frame
*, struct face
*));
494 static int face_color_gray_p
P_ ((struct frame
*, char *));
495 static char *build_font_name
P_ ((struct font_name
*));
496 static void free_font_names
P_ ((struct font_name
*, int));
497 static int sorted_font_list
P_ ((struct frame
*, char *,
498 int (*cmpfn
) P_ ((const void *, const void *)),
499 struct font_name
**));
500 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
501 Lisp_Object
, struct font_name
**));
502 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
503 Lisp_Object
, struct font_name
**));
504 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
505 Lisp_Object
, Lisp_Object
, struct font_name
**,
507 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
508 Lisp_Object
, struct font_name
**));
509 static int cmp_font_names
P_ ((const void *, const void *));
510 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
511 struct face
*, int));
512 static struct face
*realize_x_face
P_ ((struct face_cache
*,
513 Lisp_Object
*, int, struct face
*));
514 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
515 Lisp_Object
*, int));
516 static int realize_basic_faces
P_ ((struct frame
*));
517 static int realize_default_face
P_ ((struct frame
*));
518 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
519 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
520 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
521 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
522 static unsigned lface_hash
P_ ((Lisp_Object
*));
523 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
524 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
525 static void free_realized_face
P_ ((struct frame
*, struct face
*));
526 static void clear_face_gcs
P_ ((struct face_cache
*));
527 static void free_face_cache
P_ ((struct face_cache
*));
528 static int face_numeric_weight
P_ ((Lisp_Object
));
529 static int face_numeric_slant
P_ ((Lisp_Object
));
530 static int face_numeric_swidth
P_ ((Lisp_Object
));
531 static int face_fontset
P_ ((Lisp_Object
*));
532 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int, int*));
533 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
534 struct named_merge_point
*));
535 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
536 int, struct named_merge_point
*));
537 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
538 Lisp_Object
, int, int));
539 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
540 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
541 static void free_realized_faces
P_ ((struct face_cache
*));
542 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
543 struct font_name
*, int, int, int *));
544 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
545 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
546 static int xlfd_numeric_slant
P_ ((struct font_name
*));
547 static int xlfd_numeric_weight
P_ ((struct font_name
*));
548 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
549 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
550 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
551 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
552 static int xlfd_fixed_p
P_ ((struct font_name
*));
553 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
555 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
556 struct font_name
*, int,
558 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
559 struct font_name
*, int));
561 #ifdef HAVE_WINDOW_SYSTEM
563 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
564 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
565 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
566 int (*cmpfn
) P_ ((const void *, const void *))));
567 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
568 static void x_free_gc
P_ ((struct frame
*, GC
));
569 static void clear_font_table
P_ ((struct x_display_info
*));
572 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
573 #endif /* WINDOWSNT */
576 static void x_update_menu_appearance
P_ ((struct frame
*));
578 extern void free_frame_menubar
P_ ((struct frame
*));
579 #endif /* USE_X_TOOLKIT */
581 #endif /* HAVE_WINDOW_SYSTEM */
584 /***********************************************************************
586 ***********************************************************************/
588 #ifdef HAVE_X_WINDOWS
590 #ifdef DEBUG_X_COLORS
592 /* The following is a poor mans infrastructure for debugging X color
593 allocation problems on displays with PseudoColor-8. Some X servers
594 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
595 color reference counts completely so that they don't signal an
596 error when a color is freed whose reference count is already 0.
597 Other X servers do. To help me debug this, the following code
598 implements a simple reference counting schema of its own, for a
599 single display/screen. --gerd. */
601 /* Reference counts for pixel colors. */
603 int color_count
[256];
605 /* Register color PIXEL as allocated. */
608 register_color (pixel
)
611 xassert (pixel
< 256);
612 ++color_count
[pixel
];
616 /* Register color PIXEL as deallocated. */
619 unregister_color (pixel
)
622 xassert (pixel
< 256);
623 if (color_count
[pixel
] > 0)
624 --color_count
[pixel
];
630 /* Register N colors from PIXELS as deallocated. */
633 unregister_colors (pixels
, n
)
634 unsigned long *pixels
;
638 for (i
= 0; i
< n
; ++i
)
639 unregister_color (pixels
[i
]);
643 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
644 doc
: /* Dump currently allocated colors to stderr. */)
649 fputc ('\n', stderr
);
651 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
654 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
657 fputc ('\n', stderr
);
659 fputc ('\t', stderr
);
663 fputc ('\n', stderr
);
667 #endif /* DEBUG_X_COLORS */
670 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
671 color values. Interrupt input must be blocked when this function
675 x_free_colors (f
, pixels
, npixels
)
677 unsigned long *pixels
;
680 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
682 /* If display has an immutable color map, freeing colors is not
683 necessary and some servers don't allow it. So don't do it. */
684 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
686 #ifdef DEBUG_X_COLORS
687 unregister_colors (pixels
, npixels
);
689 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
695 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
696 color values. Interrupt input must be blocked when this function
700 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
704 unsigned long *pixels
;
707 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
708 int class = dpyinfo
->visual
->class;
710 /* If display has an immutable color map, freeing colors is not
711 necessary and some servers don't allow it. So don't do it. */
712 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
714 #ifdef DEBUG_X_COLORS
715 unregister_colors (pixels
, npixels
);
717 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
722 /* Create and return a GC for use on frame F. GC values and mask
723 are given by XGCV and MASK. */
726 x_create_gc (f
, mask
, xgcv
)
733 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
740 /* Free GC which was used on frame F. */
748 IF_DEBUG (xassert (--ngcs
>= 0));
749 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
753 #endif /* HAVE_X_WINDOWS */
756 /* W32 emulation of GCs */
759 x_create_gc (f
, mask
, xgcv
)
766 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
773 /* Free GC which was used on frame F. */
781 IF_DEBUG (xassert (--ngcs
>= 0));
786 #endif /* WINDOWSNT */
789 /* Mac OS emulation of GCs */
792 x_create_gc (f
, mask
, xgcv
)
799 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
811 IF_DEBUG (xassert (--ngcs
>= 0));
812 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
818 /* Like stricmp. Used to compare parts of font names which are in
823 const unsigned char *s1
, *s2
;
827 unsigned char c1
= tolower (*s1
);
828 unsigned char c2
= tolower (*s2
);
830 return c1
< c2
? -1 : 1;
835 return *s2
== 0 ? 0 : -1;
840 /* Like strlwr, which might not always be available. */
842 static unsigned char *
846 unsigned char *p
= s
;
849 /* On Mac OS X 10.3, tolower also converts non-ASCII characters
858 /* Signal `error' with message S, and additional argument ARG. */
861 signal_error (s
, arg
)
865 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
869 /* If FRAME is nil, return a pointer to the selected frame.
870 Otherwise, check that FRAME is a live frame, and return a pointer
871 to it. NPARAM is the parameter number of FRAME, for
872 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
873 Lisp function definitions. */
875 static INLINE
struct frame
*
876 frame_or_selected_frame (frame
, nparam
)
881 frame
= selected_frame
;
883 CHECK_LIVE_FRAME (frame
);
884 return XFRAME (frame
);
888 /***********************************************************************
890 ***********************************************************************/
892 /* Initialize face cache and basic faces for frame F. */
898 /* Make a face cache, if F doesn't have one. */
899 if (FRAME_FACE_CACHE (f
) == NULL
)
900 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
902 #ifdef HAVE_WINDOW_SYSTEM
903 /* Make the image cache. */
904 if (FRAME_WINDOW_P (f
))
906 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
907 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
908 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
910 #endif /* HAVE_WINDOW_SYSTEM */
912 /* Realize basic faces. Must have enough information in frame
913 parameters to realize basic faces at this point. */
914 #ifdef HAVE_X_WINDOWS
915 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
918 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
921 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
923 if (!realize_basic_faces (f
))
928 /* Free face cache of frame F. Called from Fdelete_frame. */
934 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
938 free_face_cache (face_cache
);
939 FRAME_FACE_CACHE (f
) = NULL
;
942 #ifdef HAVE_WINDOW_SYSTEM
943 if (FRAME_WINDOW_P (f
))
945 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
948 --image_cache
->refcount
;
949 if (image_cache
->refcount
== 0)
950 free_image_cache (f
);
953 #endif /* HAVE_WINDOW_SYSTEM */
957 /* Clear face caches, and recompute basic faces for frame F. Call
958 this after changing frame parameters on which those faces depend,
959 or when realized faces have been freed due to changing attributes
963 recompute_basic_faces (f
)
966 if (FRAME_FACE_CACHE (f
))
968 clear_face_cache (0);
969 if (!realize_basic_faces (f
))
975 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
976 try to free unused fonts, too. */
979 clear_face_cache (clear_fonts_p
)
982 #ifdef HAVE_WINDOW_SYSTEM
983 Lisp_Object tail
, frame
;
987 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
989 struct x_display_info
*dpyinfo
;
991 /* Fonts are common for frames on one display, i.e. on
993 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
994 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
995 clear_font_table (dpyinfo
);
997 /* From time to time see if we can unload some fonts. This also
998 frees all realized faces on all frames. Fonts needed by
999 faces will be loaded again when faces are realized again. */
1000 clear_font_table_count
= 0;
1002 FOR_EACH_FRAME (tail
, frame
)
1004 struct frame
*f
= XFRAME (frame
);
1005 if (FRAME_WINDOW_P (f
)
1006 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1007 free_all_realized_faces (frame
);
1012 /* Clear GCs of realized faces. */
1013 FOR_EACH_FRAME (tail
, frame
)
1016 if (FRAME_WINDOW_P (f
))
1018 clear_face_gcs (FRAME_FACE_CACHE (f
));
1019 clear_image_cache (f
, 0);
1023 #endif /* HAVE_WINDOW_SYSTEM */
1027 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1028 doc
: /* Clear face caches on all frames.
1029 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1031 Lisp_Object thoroughly
;
1033 clear_face_cache (!NILP (thoroughly
));
1034 ++face_change_count
;
1035 ++windows_or_buffers_changed
;
1041 #ifdef HAVE_WINDOW_SYSTEM
1044 /* Remove fonts from the font table of DPYINFO except for the default
1045 ASCII fonts of frames on that display. Called from clear_face_cache
1046 from time to time. */
1049 clear_font_table (dpyinfo
)
1050 struct x_display_info
*dpyinfo
;
1054 /* Free those fonts that are not used by frames on DPYINFO. */
1055 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1057 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1058 Lisp_Object tail
, frame
;
1060 /* Check if slot is already free. */
1061 if (font_info
->name
== NULL
)
1064 /* Don't free a default font of some frame. */
1065 FOR_EACH_FRAME (tail
, frame
)
1067 struct frame
*f
= XFRAME (frame
);
1068 if (FRAME_WINDOW_P (f
)
1069 && font_info
->font
== FRAME_FONT (f
))
1077 if (font_info
->full_name
!= font_info
->name
)
1078 xfree (font_info
->full_name
);
1079 xfree (font_info
->name
);
1081 /* Free the font. */
1083 #ifdef HAVE_X_WINDOWS
1084 XFreeFont (dpyinfo
->display
, font_info
->font
);
1087 w32_unload_font (dpyinfo
, font_info
->font
);
1090 mac_unload_font (dpyinfo
, font_info
->font
);
1094 /* Mark font table slot free. */
1095 font_info
->font
= NULL
;
1096 font_info
->name
= font_info
->full_name
= NULL
;
1100 #endif /* HAVE_WINDOW_SYSTEM */
1104 /***********************************************************************
1106 ***********************************************************************/
1108 #ifdef HAVE_WINDOW_SYSTEM
1110 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1111 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1112 A bitmap specification is either a string, a file name, or a list
1113 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1114 HEIGHT is its height, and DATA is a string containing the bits of
1115 the pixmap. Bits are stored row by row, each row occupies
1116 \(WIDTH + 7)/8 bytes. */)
1122 if (STRINGP (object
))
1123 /* If OBJECT is a string, it's a file name. */
1125 else if (CONSP (object
))
1127 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1128 HEIGHT must be integers > 0, and DATA must be string large
1129 enough to hold a bitmap of the specified size. */
1130 Lisp_Object width
, height
, data
;
1132 height
= width
= data
= Qnil
;
1136 width
= XCAR (object
);
1137 object
= XCDR (object
);
1140 height
= XCAR (object
);
1141 object
= XCDR (object
);
1143 data
= XCAR (object
);
1147 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1149 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1151 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1156 return pixmap_p
? Qt
: Qnil
;
1160 /* Load a bitmap according to NAME (which is either a file name or a
1161 pixmap spec) for use on frame F. Value is the bitmap_id (see
1162 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1163 bitmap cannot be loaded, display a message saying so, and return
1164 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1165 if these pointers are not null. */
1168 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1171 unsigned int *w_ptr
, *h_ptr
;
1179 tem
= Fbitmap_spec_p (name
);
1181 wrong_type_argument (Qbitmap_spec_p
, name
);
1186 /* Decode a bitmap spec into a bitmap. */
1191 w
= XINT (Fcar (name
));
1192 h
= XINT (Fcar (Fcdr (name
)));
1193 bits
= Fcar (Fcdr (Fcdr (name
)));
1195 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1200 /* It must be a string -- a file name. */
1201 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1207 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1218 ++npixmaps_allocated
;
1221 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1224 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1230 #endif /* HAVE_WINDOW_SYSTEM */
1234 /***********************************************************************
1236 ***********************************************************************/
1238 #ifdef HAVE_WINDOW_SYSTEM
1240 /* Load font of face FACE which is used on frame F to display
1241 character C. The name of the font to load is determined by lface
1242 and fontset of FACE. */
1245 load_face_font (f
, face
, c
)
1250 struct font_info
*font_info
= NULL
;
1252 int needs_overstrike
;
1254 face
->font_info_id
= -1;
1257 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
,
1263 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1268 face
->font_info_id
= font_info
->font_idx
;
1269 face
->font
= font_info
->font
;
1270 face
->font_name
= font_info
->full_name
;
1271 face
->overstrike
= needs_overstrike
;
1274 x_free_gc (f
, face
->gc
);
1279 add_to_log ("Unable to load font %s",
1280 build_string (font_name
), Qnil
);
1284 #endif /* HAVE_WINDOW_SYSTEM */
1288 /***********************************************************************
1290 ***********************************************************************/
1292 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1293 RGB_LIST should contain (at least) 3 lisp integers.
1294 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1297 parse_rgb_list (rgb_list
, color
)
1298 Lisp_Object rgb_list
;
1301 #define PARSE_RGB_LIST_FIELD(field) \
1302 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1304 color->field = XINT (XCAR (rgb_list)); \
1305 rgb_list = XCDR (rgb_list); \
1310 PARSE_RGB_LIST_FIELD (red
);
1311 PARSE_RGB_LIST_FIELD (green
);
1312 PARSE_RGB_LIST_FIELD (blue
);
1318 /* Lookup on frame F the color described by the lisp string COLOR.
1319 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1320 non-zero, then the `standard' definition of the same color is
1324 tty_lookup_color (f
, color
, tty_color
, std_color
)
1327 XColor
*tty_color
, *std_color
;
1329 Lisp_Object frame
, color_desc
;
1331 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1334 XSETFRAME (frame
, f
);
1336 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1337 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1341 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1344 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1346 rgb
= XCDR (XCDR (color_desc
));
1347 if (! parse_rgb_list (rgb
, tty_color
))
1350 /* Should we fill in STD_COLOR too? */
1353 /* Default STD_COLOR to the same as TTY_COLOR. */
1354 *std_color
= *tty_color
;
1356 /* Do a quick check to see if the returned descriptor is
1357 actually _exactly_ equal to COLOR, otherwise we have to
1358 lookup STD_COLOR separately. If it's impossible to lookup
1359 a standard color, we just give up and use TTY_COLOR. */
1360 if ((!STRINGP (XCAR (color_desc
))
1361 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1362 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1364 /* Look up STD_COLOR separately. */
1365 rgb
= call1 (Qtty_color_standard_values
, color
);
1366 if (! parse_rgb_list (rgb
, std_color
))
1373 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1374 /* We were called early during startup, and the colors are not
1375 yet set up in tty-defined-color-alist. Don't return a failure
1376 indication, since this produces the annoying "Unable to
1377 load color" messages in the *Messages* buffer. */
1380 /* tty-color-desc seems to have returned a bad value. */
1384 /* A version of defined_color for non-X frames. */
1387 tty_defined_color (f
, color_name
, color_def
, alloc
)
1396 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1398 color_def
->blue
= 0;
1399 color_def
->green
= 0;
1402 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, 0);
1404 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1406 if (strcmp (color_name
, "unspecified-fg") == 0)
1407 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1408 else if (strcmp (color_name
, "unspecified-bg") == 0)
1409 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1412 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1419 /* Decide if color named COLOR_NAME is valid for the display
1420 associated with the frame F; if so, return the rgb values in
1421 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1423 This does the right thing for any type of frame. */
1426 defined_color (f
, color_name
, color_def
, alloc
)
1432 if (!FRAME_WINDOW_P (f
))
1433 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1434 #ifdef HAVE_X_WINDOWS
1435 else if (FRAME_X_P (f
))
1436 return x_defined_color (f
, color_name
, color_def
, alloc
);
1439 else if (FRAME_W32_P (f
))
1440 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1443 else if (FRAME_MAC_P (f
))
1444 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1451 /* Given the index IDX of a tty color on frame F, return its name, a
1455 tty_color_name (f
, idx
)
1459 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1462 Lisp_Object coldesc
;
1464 XSETFRAME (frame
, f
);
1465 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1467 if (!NILP (coldesc
))
1468 return XCAR (coldesc
);
1471 /* We can have an MSDOG frame under -nw for a short window of
1472 opportunity before internal_terminal_init is called. DTRT. */
1473 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1474 return msdos_stdcolor_name (idx
);
1477 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1478 return build_string (unspecified_fg
);
1479 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1480 return build_string (unspecified_bg
);
1483 return vga_stdcolor_name (idx
);
1486 return Qunspecified
;
1490 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1493 The criterion implemented here is not a terribly sophisticated one. */
1496 face_color_gray_p (f
, color_name
)
1503 if (defined_color (f
, color_name
, &color
, 0))
1504 gray_p
= (/* Any color sufficiently close to black counts as grey. */
1505 (color
.red
< 5000 && color
.green
< 5000 && color
.blue
< 5000)
1507 ((abs (color
.red
- color
.green
)
1508 < max (color
.red
, color
.green
) / 20)
1509 && (abs (color
.green
- color
.blue
)
1510 < max (color
.green
, color
.blue
) / 20)
1511 && (abs (color
.blue
- color
.red
)
1512 < max (color
.blue
, color
.red
) / 20)));
1520 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1521 BACKGROUND_P non-zero means the color will be used as background
1525 face_color_supported_p (f
, color_name
, background_p
)
1533 XSETFRAME (frame
, f
);
1535 #ifdef HAVE_WINDOW_SYSTEM
1537 ? (!NILP (Fxw_display_color_p (frame
))
1538 || xstricmp (color_name
, "black") == 0
1539 || xstricmp (color_name
, "white") == 0
1541 && face_color_gray_p (f
, color_name
))
1542 || (!NILP (Fx_display_grayscale_p (frame
))
1543 && face_color_gray_p (f
, color_name
)))
1546 tty_defined_color (f
, color_name
, ¬_used
, 0);
1550 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1551 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1552 FRAME specifies the frame and thus the display for interpreting COLOR.
1553 If FRAME is nil or omitted, use the selected frame. */)
1555 Lisp_Object color
, frame
;
1559 CHECK_STRING (color
);
1561 frame
= selected_frame
;
1563 CHECK_FRAME (frame
);
1565 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1569 DEFUN ("color-supported-p", Fcolor_supported_p
,
1570 Scolor_supported_p
, 1, 3, 0,
1571 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1572 BACKGROUND-P non-nil means COLOR is used as a background.
1573 Otherwise, this function tells whether it can be used as a foreground.
1574 If FRAME is nil or omitted, use the selected frame.
1575 COLOR must be a valid color name. */)
1576 (color
, frame
, background_p
)
1577 Lisp_Object frame
, color
, background_p
;
1581 CHECK_STRING (color
);
1583 frame
= selected_frame
;
1585 CHECK_FRAME (frame
);
1587 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1593 /* Load color with name NAME for use by face FACE on frame F.
1594 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1595 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1596 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1597 pixel color. If color cannot be loaded, display a message, and
1598 return the foreground, background or underline color of F, but
1599 record that fact in flags of the face so that we don't try to free
1603 load_color (f
, face
, name
, target_index
)
1607 enum lface_attribute_index target_index
;
1611 xassert (STRINGP (name
));
1612 xassert (target_index
== LFACE_FOREGROUND_INDEX
1613 || target_index
== LFACE_BACKGROUND_INDEX
1614 || target_index
== LFACE_UNDERLINE_INDEX
1615 || target_index
== LFACE_OVERLINE_INDEX
1616 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1617 || target_index
== LFACE_BOX_INDEX
);
1619 /* if the color map is full, defined_color will return a best match
1620 to the values in an existing cell. */
1621 if (!defined_color (f
, SDATA (name
), &color
, 1))
1623 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1625 switch (target_index
)
1627 case LFACE_FOREGROUND_INDEX
:
1628 face
->foreground_defaulted_p
= 1;
1629 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1632 case LFACE_BACKGROUND_INDEX
:
1633 face
->background_defaulted_p
= 1;
1634 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1637 case LFACE_UNDERLINE_INDEX
:
1638 face
->underline_defaulted_p
= 1;
1639 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1642 case LFACE_OVERLINE_INDEX
:
1643 face
->overline_color_defaulted_p
= 1;
1644 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1647 case LFACE_STRIKE_THROUGH_INDEX
:
1648 face
->strike_through_color_defaulted_p
= 1;
1649 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1652 case LFACE_BOX_INDEX
:
1653 face
->box_color_defaulted_p
= 1;
1654 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1663 ++ncolors_allocated
;
1670 #ifdef HAVE_WINDOW_SYSTEM
1672 /* Load colors for face FACE which is used on frame F. Colors are
1673 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1674 of ATTRS. If the background color specified is not supported on F,
1675 try to emulate gray colors with a stipple from Vface_default_stipple. */
1678 load_face_colors (f
, face
, attrs
)
1685 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1686 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1688 /* Swap colors if face is inverse-video. */
1689 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1697 /* Check for support for foreground, not for background because
1698 face_color_supported_p is smart enough to know that grays are
1699 "supported" as background because we are supposed to use stipple
1701 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1702 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1704 x_destroy_bitmap (f
, face
->stipple
);
1705 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1706 &face
->pixmap_w
, &face
->pixmap_h
);
1709 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1710 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1714 /* Free color PIXEL on frame F. */
1717 unload_color (f
, pixel
)
1719 unsigned long pixel
;
1721 #ifdef HAVE_X_WINDOWS
1725 x_free_colors (f
, &pixel
, 1);
1732 /* Free colors allocated for FACE. */
1735 free_face_colors (f
, face
)
1739 #ifdef HAVE_X_WINDOWS
1740 if (face
->colors_copied_bitwise_p
)
1745 if (!face
->foreground_defaulted_p
)
1747 x_free_colors (f
, &face
->foreground
, 1);
1748 IF_DEBUG (--ncolors_allocated
);
1751 if (!face
->background_defaulted_p
)
1753 x_free_colors (f
, &face
->background
, 1);
1754 IF_DEBUG (--ncolors_allocated
);
1757 if (face
->underline_p
1758 && !face
->underline_defaulted_p
)
1760 x_free_colors (f
, &face
->underline_color
, 1);
1761 IF_DEBUG (--ncolors_allocated
);
1764 if (face
->overline_p
1765 && !face
->overline_color_defaulted_p
)
1767 x_free_colors (f
, &face
->overline_color
, 1);
1768 IF_DEBUG (--ncolors_allocated
);
1771 if (face
->strike_through_p
1772 && !face
->strike_through_color_defaulted_p
)
1774 x_free_colors (f
, &face
->strike_through_color
, 1);
1775 IF_DEBUG (--ncolors_allocated
);
1778 if (face
->box
!= FACE_NO_BOX
1779 && !face
->box_color_defaulted_p
)
1781 x_free_colors (f
, &face
->box_color
, 1);
1782 IF_DEBUG (--ncolors_allocated
);
1786 #endif /* HAVE_X_WINDOWS */
1789 #endif /* HAVE_WINDOW_SYSTEM */
1793 /***********************************************************************
1795 ***********************************************************************/
1797 /* An enumerator for each field of an XLFD font name. */
1818 /* An enumerator for each possible slant value of a font. Taken from
1819 the XLFD specification. */
1827 XLFD_SLANT_REVERSE_ITALIC
,
1828 XLFD_SLANT_REVERSE_OBLIQUE
,
1832 /* Relative font weight according to XLFD documentation. */
1836 XLFD_WEIGHT_UNKNOWN
,
1837 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1838 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1839 XLFD_WEIGHT_LIGHT
, /* 30 */
1840 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1841 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1842 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1843 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1844 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1845 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1848 /* Relative proportionate width. */
1852 XLFD_SWIDTH_UNKNOWN
,
1853 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1854 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1855 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1856 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1857 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1858 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1859 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1860 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1861 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1864 /* Structure used for tables mapping XLFD weight, slant, and width
1865 names to numeric and symbolic values. */
1871 Lisp_Object
*symbol
;
1874 /* Table of XLFD slant names and their numeric and symbolic
1875 representations. This table must be sorted by slant names in
1878 static struct table_entry slant_table
[] =
1880 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1881 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1882 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1883 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1884 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1885 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1888 /* Table of XLFD weight names. This table must be sorted by weight
1889 names in ascending order. */
1891 static struct table_entry weight_table
[] =
1893 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1894 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1895 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1896 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1897 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1898 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1899 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1900 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1901 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1902 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1903 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1904 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1905 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1906 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1907 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1908 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1911 /* Table of XLFD width names. This table must be sorted by width
1912 names in ascending order. */
1914 static struct table_entry swidth_table
[] =
1916 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1917 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1918 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1919 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1920 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1921 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1922 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1923 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1924 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1925 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1926 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1927 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1928 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1929 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1930 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1933 /* Structure used to hold the result of splitting font names in XLFD
1934 format into their fields. */
1938 /* The original name which is modified destructively by
1939 split_font_name. The pointer is kept here to be able to free it
1940 if it was allocated from the heap. */
1943 /* Font name fields. Each vector element points into `name' above.
1944 Fields are NUL-terminated. */
1945 char *fields
[XLFD_LAST
];
1947 /* Numeric values for those fields that interest us. See
1948 split_font_name for which these are. */
1949 int numeric
[XLFD_LAST
];
1951 /* If the original name matches one of Vface_font_rescale_alist,
1952 the value is the corresponding rescale ratio. Otherwise, the
1954 double rescale_ratio
;
1956 /* Lower value mean higher priority. */
1957 int registry_priority
;
1960 /* The frame in effect when sorting font names. Set temporarily in
1961 sort_fonts so that it is available in font comparison functions. */
1963 static struct frame
*font_frame
;
1965 /* Order by which font selection chooses fonts. The default values
1966 mean `first, find a best match for the font width, then for the
1967 font height, then for weight, then for slant.' This variable can be
1968 set via set-face-font-sort-order. */
1971 static int font_sort_order
[4] = {
1972 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1975 static int font_sort_order
[4];
1978 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1979 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1980 is a pointer to the matching table entry or null if no table entry
1983 static struct table_entry
*
1984 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1985 struct table_entry
*table
;
1987 struct font_name
*font
;
1990 /* Function split_font_name converts fields to lower-case, so there
1991 is no need to use xstrlwr or xstricmp here. */
1992 char *s
= font
->fields
[field_index
];
1993 int low
, mid
, high
, cmp
;
2000 mid
= (low
+ high
) / 2;
2001 cmp
= strcmp (table
[mid
].name
, s
);
2015 /* Return a numeric representation for font name field
2016 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2017 has DIM entries. Value is the numeric value found or DFLT if no
2018 table entry matches. This function is used to translate weight,
2019 slant, and swidth names of XLFD font names to numeric values. */
2022 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
2023 struct table_entry
*table
;
2025 struct font_name
*font
;
2029 struct table_entry
*p
;
2030 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2031 return p
? p
->numeric
: dflt
;
2035 /* Return a symbolic representation for font name field
2036 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2037 has DIM entries. Value is the symbolic value found or DFLT if no
2038 table entry matches. This function is used to translate weight,
2039 slant, and swidth names of XLFD font names to symbols. */
2041 static INLINE Lisp_Object
2042 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2043 struct table_entry
*table
;
2045 struct font_name
*font
;
2049 struct table_entry
*p
;
2050 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2051 return p
? *p
->symbol
: dflt
;
2055 /* Return a numeric value for the slant of the font given by FONT. */
2058 xlfd_numeric_slant (font
)
2059 struct font_name
*font
;
2061 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2062 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2066 /* Return a symbol representing the weight of the font given by FONT. */
2068 static INLINE Lisp_Object
2069 xlfd_symbolic_slant (font
)
2070 struct font_name
*font
;
2072 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2073 font
, XLFD_SLANT
, Qnormal
);
2077 /* Return a numeric value for the weight of the font given by FONT. */
2080 xlfd_numeric_weight (font
)
2081 struct font_name
*font
;
2083 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2084 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2088 /* Return a symbol representing the slant of the font given by FONT. */
2090 static INLINE Lisp_Object
2091 xlfd_symbolic_weight (font
)
2092 struct font_name
*font
;
2094 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2095 font
, XLFD_WEIGHT
, Qnormal
);
2099 /* Return a numeric value for the swidth of the font whose XLFD font
2100 name fields are found in FONT. */
2103 xlfd_numeric_swidth (font
)
2104 struct font_name
*font
;
2106 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2107 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2111 /* Return a symbolic value for the swidth of FONT. */
2113 static INLINE Lisp_Object
2114 xlfd_symbolic_swidth (font
)
2115 struct font_name
*font
;
2117 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2118 font
, XLFD_SWIDTH
, Qnormal
);
2122 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2123 entries. Value is a pointer to the matching table entry or null if
2124 no element of TABLE contains SYMBOL. */
2126 static struct table_entry
*
2127 face_value (table
, dim
, symbol
)
2128 struct table_entry
*table
;
2134 xassert (SYMBOLP (symbol
));
2136 for (i
= 0; i
< dim
; ++i
)
2137 if (EQ (*table
[i
].symbol
, symbol
))
2140 return i
< dim
? table
+ i
: NULL
;
2144 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2145 entries. Value is -1 if SYMBOL is not found in TABLE. */
2148 face_numeric_value (table
, dim
, symbol
)
2149 struct table_entry
*table
;
2153 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2154 return p
? p
->numeric
: -1;
2158 /* Return a numeric value representing the weight specified by Lisp
2159 symbol WEIGHT. Value is one of the enumerators of enum
2163 face_numeric_weight (weight
)
2166 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2170 /* Return a numeric value representing the slant specified by Lisp
2171 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2174 face_numeric_slant (slant
)
2177 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2181 /* Return a numeric value representing the swidth specified by Lisp
2182 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2185 face_numeric_swidth (width
)
2188 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2192 #ifdef HAVE_WINDOW_SYSTEM
2194 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2198 struct font_name
*font
;
2200 /* Function split_font_name converts fields to lower-case, so there
2201 is no need to use tolower here. */
2202 return *font
->fields
[XLFD_SPACING
] != 'p';
2206 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2208 The actual height of the font when displayed on F depends on the
2209 resolution of both the font and frame. For example, a 10pt font
2210 designed for a 100dpi display will display larger than 10pt on a
2211 75dpi display. (It's not unusual to use fonts not designed for the
2212 display one is using. For example, some intlfonts are available in
2213 72dpi versions, only.)
2215 Value is the real point size of FONT on frame F, or 0 if it cannot
2219 xlfd_point_size (f
, font
)
2221 struct font_name
*font
;
2223 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2224 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2228 if (*pixel_field
== '[')
2230 /* The pixel size field is `[A B C D]' which specifies
2231 a transformation matrix.
2237 by which all glyphs of the font are transformed. The spec
2238 says that s scalar value N for the pixel size is equivalent
2239 to A = N * resx/resy, B = C = 0, D = N. */
2240 char *start
= pixel_field
+ 1, *end
;
2244 for (i
= 0; i
< 4; ++i
)
2246 matrix
[i
] = strtod (start
, &end
);
2253 pixel
= atoi (pixel_field
);
2258 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2264 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2265 of frame F. This function is used to guess a point size of font
2266 when only the pixel height of the font is available. */
2269 pixel_point_size (f
, pixel
)
2273 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2277 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2278 point size of one dot. */
2279 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2280 int_pt
= real_pt
+ 0.5;
2286 /* Return a rescaling ratio of a font of NAME. */
2289 font_rescale_ratio (name
)
2292 Lisp_Object tail
, elt
;
2294 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2297 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2298 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2299 return XFLOAT_DATA (XCDR (elt
));
2305 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2306 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2307 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2308 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2309 zero if the font name doesn't have the format we expect. The
2310 expected format is a font name that starts with a `-' and has
2311 XLFD_LAST fields separated by `-'. */
2314 split_font_name (f
, font
, numeric_p
)
2316 struct font_name
*font
;
2321 double rescale_ratio
;
2324 /* This must be done before splitting the font name. */
2325 rescale_ratio
= font_rescale_ratio (font
->name
);
2327 if (*font
->name
== '-')
2329 char *p
= xstrlwr (font
->name
) + 1;
2331 while (i
< XLFD_LAST
)
2333 font
->fields
[i
] = p
;
2336 /* Pixel and point size may be of the form `[....]'. For
2337 BNF, see XLFD spec, chapter 4. Negative values are
2338 indicated by tilde characters which we replace with
2339 `-' characters, here. */
2341 && (i
- 1 == XLFD_PIXEL_SIZE
2342 || i
- 1 == XLFD_POINT_SIZE
))
2347 for (++p
; *p
&& *p
!= ']'; ++p
)
2351 /* Check that the matrix contains 4 floating point
2353 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2356 if (strtod (start
, &end
) == 0 && start
== end
)
2363 while (*p
&& *p
!= '-')
2373 success_p
= i
== XLFD_LAST
;
2375 /* If requested, and font name was in the expected format,
2376 compute numeric values for some fields. */
2377 if (numeric_p
&& success_p
)
2379 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2380 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2381 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2382 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2383 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2384 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2385 font
->rescale_ratio
= rescale_ratio
;
2388 /* Initialize it to zero. It will be overridden by font_list while
2389 trying alternate registries. */
2390 font
->registry_priority
= 0;
2396 /* Build an XLFD font name from font name fields in FONT. Value is a
2397 pointer to the font name, which is allocated via xmalloc. */
2400 build_font_name (font
)
2401 struct font_name
*font
;
2405 char *font_name
= (char *) xmalloc (size
);
2406 int total_length
= 0;
2408 for (i
= 0; i
< XLFD_LAST
; ++i
)
2410 /* Add 1 because of the leading `-'. */
2411 int len
= strlen (font
->fields
[i
]) + 1;
2413 /* Reallocate font_name if necessary. Add 1 for the final
2415 if (total_length
+ len
+ 1 >= size
)
2417 int new_size
= max (2 * size
, size
+ len
+ 1);
2418 int sz
= new_size
* sizeof *font_name
;
2419 font_name
= (char *) xrealloc (font_name
, sz
);
2423 font_name
[total_length
] = '-';
2424 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2425 total_length
+= len
;
2428 font_name
[total_length
] = 0;
2433 /* Free an array FONTS of N font_name structures. This frees FONTS
2434 itself and all `name' fields in its elements. */
2437 free_font_names (fonts
, n
)
2438 struct font_name
*fonts
;
2442 xfree (fonts
[--n
].name
);
2447 /* Sort vector FONTS of font_name structures which contains NFONTS
2448 elements using qsort and comparison function CMPFN. F is the frame
2449 on which the fonts will be used. The global variable font_frame
2450 is temporarily set to F to make it available in CMPFN. */
2453 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2455 struct font_name
*fonts
;
2457 int (*cmpfn
) P_ ((const void *, const void *));
2460 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2465 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2466 display in x_display_list. FONTS is a pointer to a vector of
2467 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2468 alternative patterns from Valternate_fontname_alist if no fonts are
2469 found matching PATTERN.
2471 For all fonts found, set FONTS[i].name to the name of the font,
2472 allocated via xmalloc, and split font names into fields. Ignore
2473 fonts that we can't parse. Value is the number of fonts found. */
2476 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2479 struct font_name
**pfonts
;
2480 int nfonts
, try_alternatives_p
;
2484 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2485 better to do it the other way around. */
2487 Lisp_Object lpattern
, tem
;
2488 struct font_name
*fonts
= 0;
2489 int num_fonts
= nfonts
;
2492 lpattern
= build_string (pattern
);
2494 /* Get the list of fonts matching PATTERN. */
2497 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2500 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2503 if (nfonts
< 0 && CONSP (lfonts
))
2504 num_fonts
= XFASTINT (Flength (lfonts
));
2506 /* Make a copy of the font names we got from X, and
2507 split them into fields. */
2509 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2511 Lisp_Object elt
, tail
;
2512 const char *name
= SDATA (XCAR (tem
));
2514 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2515 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2519 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2530 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2534 /* Make a copy of the font name. */
2535 fonts
[n
].name
= xstrdup (name
);
2537 if (split_font_name (f
, fonts
+ n
, 1))
2539 if (font_scalable_p (fonts
+ n
)
2540 && !may_use_scalable_font_p (name
))
2543 xfree (fonts
[n
].name
);
2549 xfree (fonts
[n
].name
);
2552 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2553 if (n
== 0 && try_alternatives_p
)
2555 Lisp_Object list
= Valternate_fontname_alist
;
2563 while (CONSP (list
))
2565 Lisp_Object entry
= XCAR (list
);
2567 && STRINGP (XCAR (entry
))
2568 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2575 Lisp_Object patterns
= XCAR (list
);
2578 while (CONSP (patterns
)
2579 /* If list is screwed up, give up. */
2580 && (name
= XCAR (patterns
),
2582 /* Ignore patterns equal to PATTERN because we tried that
2583 already with no success. */
2584 && (strcmp (SDATA (name
), pattern
) == 0
2585 || (n
= x_face_list_fonts (f
, SDATA (name
),
2588 patterns
= XCDR (patterns
);
2596 /* Check if a font matching pattern_offset_t on frame F is available
2597 or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
2598 a font name pattern is generated from FAMILY and REGISTRY. */
2601 face_font_available_p (f
, pattern
)
2603 Lisp_Object pattern
;
2607 if (! STRINGP (pattern
))
2609 Lisp_Object family
, registry
;
2610 char *family_str
, *registry_str
, *pattern_str
;
2612 CHECK_CONS (pattern
);
2613 family
= XCAR (pattern
);
2618 CHECK_STRING (family
);
2619 family_str
= (char *) SDATA (family
);
2621 registry
= XCDR (pattern
);
2622 if (NILP (registry
))
2626 CHECK_STRING (registry
);
2627 registry_str
= (char *) SDATA (registry
);
2630 pattern_str
= (char *) alloca (strlen (family_str
)
2631 + strlen (registry_str
)
2633 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2634 strcat (pattern_str
, family_str
);
2635 strcat (pattern_str
, "-*-");
2636 strcat (pattern_str
, registry_str
);
2637 if (!index (registry_str
, '-'))
2639 if (registry_str
[strlen (registry_str
) - 1] == '*')
2640 strcat (pattern_str
, "-*");
2642 strcat (pattern_str
, "*-*");
2644 pattern
= build_string (pattern_str
);
2647 /* Get the list of fonts matching PATTERN. */
2650 fonts
= w32_list_fonts (f
, pattern
, 0, 1);
2653 fonts
= x_list_fonts (f
, pattern
, -1, 1);
2655 return XINT (Flength (fonts
));
2659 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2660 using comparison function CMPFN. Value is the number of fonts
2661 found. If value is non-zero, *FONTS is set to a vector of
2662 font_name structures allocated from the heap containing matching
2663 fonts. Each element of *FONTS contains a name member that is also
2664 allocated from the heap. Font names in these structures are split
2665 into fields. Use free_font_names to free such an array. */
2668 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2671 int (*cmpfn
) P_ ((const void *, const void *));
2672 struct font_name
**fonts
;
2676 /* Get the list of fonts matching pattern. 100 should suffice. */
2677 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2678 if (INTEGERP (Vfont_list_limit
))
2679 nfonts
= XINT (Vfont_list_limit
);
2682 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2684 /* Sort the resulting array and return it in *FONTS. If no
2685 fonts were found, make sure to set *FONTS to null. */
2687 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2698 /* Compare two font_name structures *A and *B. Value is analogous to
2699 strcmp. Sort order is given by the global variable
2700 font_sort_order. Font names are sorted so that, everything else
2701 being equal, fonts with a resolution closer to that of the frame on
2702 which they are used are listed first. The global variable
2703 font_frame is the frame on which we operate. */
2706 cmp_font_names (a
, b
)
2709 struct font_name
*x
= (struct font_name
*) a
;
2710 struct font_name
*y
= (struct font_name
*) b
;
2713 /* All strings have been converted to lower-case by split_font_name,
2714 so we can use strcmp here. */
2715 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2720 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2722 int j
= font_sort_order
[i
];
2723 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2728 /* Everything else being equal, we prefer fonts with an
2729 y-resolution closer to that of the frame. */
2730 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2731 int x_resy
= x
->numeric
[XLFD_RESY
];
2732 int y_resy
= y
->numeric
[XLFD_RESY
];
2733 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2741 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2742 is non-nil list fonts matching that pattern. Otherwise, if
2743 REGISTRY is non-nil return only fonts with that registry, otherwise
2744 return fonts of any registry. Set *FONTS to a vector of font_name
2745 structures allocated from the heap containing the fonts found.
2746 Value is the number of fonts found. */
2749 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2751 Lisp_Object pattern
, family
, registry
;
2752 struct font_name
**fonts
;
2754 char *pattern_str
, *family_str
, *registry_str
;
2758 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2759 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2761 pattern_str
= (char *) alloca (strlen (family_str
)
2762 + strlen (registry_str
)
2764 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2765 strcat (pattern_str
, family_str
);
2766 strcat (pattern_str
, "-*-");
2767 strcat (pattern_str
, registry_str
);
2768 if (!index (registry_str
, '-'))
2770 if (registry_str
[strlen (registry_str
) - 1] == '*')
2771 strcat (pattern_str
, "-*");
2773 strcat (pattern_str
, "*-*");
2777 pattern_str
= (char *) SDATA (pattern
);
2779 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2783 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2784 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2785 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2788 static struct font_name
*
2789 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2790 struct font_name
*fonts1
, *fonts2
;
2791 int nfonts1
, nfonts2
;
2793 int new_nfonts
= nfonts1
+ nfonts2
;
2794 struct font_name
*new_fonts
;
2796 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2797 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2798 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2805 /* Get a sorted list of fonts of family FAMILY on frame F.
2807 If PATTERN is non-nil list fonts matching that pattern.
2809 If REGISTRY is non-nil, return fonts with that registry and the
2810 alternative registries from Vface_alternative_font_registry_alist.
2812 If REGISTRY is nil return fonts of any registry.
2814 Set *FONTS to a vector of font_name structures allocated from the
2815 heap containing the fonts found. Value is the number of fonts
2819 font_list (f
, pattern
, family
, registry
, fonts
)
2821 Lisp_Object pattern
, family
, registry
;
2822 struct font_name
**fonts
;
2824 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2826 if (!NILP (registry
)
2827 && CONSP (Vface_alternative_font_registry_alist
))
2831 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2836 for (alter
= XCDR (alter
), reg_prio
= 1;
2838 alter
= XCDR (alter
), reg_prio
++)
2839 if (STRINGP (XCAR (alter
)))
2842 struct font_name
*fonts2
;
2844 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2846 for (i
= 0; i
< nfonts2
; i
++)
2847 fonts2
[i
].registry_priority
= reg_prio
;
2848 *fonts
= (nfonts
> 0
2849 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2860 /* Remove elements from LIST whose cars are `equal'. Called from
2861 x-family-fonts and x-font-family-list to remove duplicate font
2865 remove_duplicates (list
)
2868 Lisp_Object tail
= list
;
2870 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2872 Lisp_Object next
= XCDR (tail
);
2873 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2874 XSETCDR (tail
, XCDR (next
));
2881 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2882 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2883 If FAMILY is omitted or nil, list all families.
2884 Otherwise, FAMILY must be a string, possibly containing wildcards
2886 If FRAME is omitted or nil, use the selected frame.
2887 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2888 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2889 FAMILY is the font family name. POINT-SIZE is the size of the
2890 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2891 width, weight and slant of the font. These symbols are the same as for
2892 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2893 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2894 giving the registry and encoding of the font.
2895 The result list is sorted according to the current setting of
2896 the face font sort order. */)
2898 Lisp_Object family
, frame
;
2900 struct frame
*f
= check_x_frame (frame
);
2901 struct font_name
*fonts
;
2904 struct gcpro gcpro1
;
2907 CHECK_STRING (family
);
2911 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2912 for (i
= nfonts
- 1; i
>= 0; --i
)
2914 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2917 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2918 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2919 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2920 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2921 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2922 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2923 tem
= build_font_name (fonts
+ i
);
2924 ASET (v
, 6, build_string (tem
));
2925 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2926 fonts
[i
].fields
[XLFD_ENCODING
]);
2927 ASET (v
, 7, build_string (tem
));
2930 result
= Fcons (v
, result
);
2933 remove_duplicates (result
);
2934 free_font_names (fonts
, nfonts
);
2940 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2942 doc
: /* Return a list of available font families on FRAME.
2943 If FRAME is omitted or nil, use the selected frame.
2944 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2945 is a font family, and FIXED-P is non-nil if fonts of that family
2946 are fixed-pitch. */)
2950 struct frame
*f
= check_x_frame (frame
);
2952 struct font_name
*fonts
;
2954 struct gcpro gcpro1
;
2955 int count
= SPECPDL_INDEX ();
2957 /* Let's consider all fonts. */
2958 specbind (intern ("font-list-limit"), make_number (-1));
2959 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2963 for (i
= nfonts
- 1; i
>= 0; --i
)
2964 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2965 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2968 remove_duplicates (result
);
2969 free_font_names (fonts
, nfonts
);
2971 return unbind_to (count
, result
);
2975 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2976 doc
: /* Return a list of the names of available fonts matching PATTERN.
2977 If optional arguments FACE and FRAME are specified, return only fonts
2978 the same size as FACE on FRAME.
2979 PATTERN is a string, perhaps with wildcard characters;
2980 the * character matches any substring, and
2981 the ? character matches any single character.
2982 PATTERN is case-insensitive.
2983 FACE is a face name--a symbol.
2985 The return value is a list of strings, suitable as arguments to
2988 Fonts Emacs can't use may or may not be excluded
2989 even if they match PATTERN and FACE.
2990 The optional fourth argument MAXIMUM sets a limit on how many
2991 fonts to match. The first MAXIMUM fonts are reported.
2992 The optional fifth argument WIDTH, if specified, is a number of columns
2993 occupied by a character of a font. In that case, return only fonts
2994 the WIDTH times as wide as FACE on FRAME. */)
2995 (pattern
, face
, frame
, maximum
, width
)
2996 Lisp_Object pattern
, face
, frame
, maximum
, width
;
3003 CHECK_STRING (pattern
);
3009 CHECK_NATNUM (maximum
);
3010 maxnames
= XINT (maximum
);
3014 CHECK_NUMBER (width
);
3016 /* We can't simply call check_x_frame because this function may be
3017 called before any frame is created. */
3018 f
= frame_or_selected_frame (frame
, 2);
3019 if (!FRAME_WINDOW_P (f
))
3021 /* Perhaps we have not yet created any frame. */
3026 /* Determine the width standard for comparison with the fonts we find. */
3032 /* This is of limited utility since it works with character
3033 widths. Keep it for compatibility. --gerd. */
3034 int face_id
= lookup_named_face (f
, face
, 0, 0);
3035 struct face
*face
= (face_id
< 0
3037 : FACE_FROM_ID (f
, face_id
));
3040 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3041 not maximum as on X. Redefine here. */
3043 #define FONT_WIDTH FONT_MAX_WIDTH
3046 if (face
&& face
->font
)
3047 size
= FONT_WIDTH (face
->font
);
3049 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3052 size
*= XINT (width
);
3056 Lisp_Object args
[2];
3058 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3060 /* We don't have to check fontsets. */
3062 args
[1] = list_fontsets (f
, pattern
, size
);
3063 return Fnconc (2, args
);
3067 #endif /* HAVE_WINDOW_SYSTEM */
3071 /***********************************************************************
3073 ***********************************************************************/
3075 /* Access face attributes of face LFACE, a Lisp vector. */
3077 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3078 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3079 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3080 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3081 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3082 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3083 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3084 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3085 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3086 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3087 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3088 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3089 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3090 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3091 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3092 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3094 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3095 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3097 #define LFACEP(LFACE) \
3099 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3100 && EQ (AREF (LFACE, 0), Qface))
3105 /* Check consistency of Lisp face attribute vector ATTRS. */
3108 check_lface_attrs (attrs
)
3111 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3112 || IGNORE_DEFFACE_P (attrs
[LFACE_FAMILY_INDEX
])
3113 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3114 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3115 || IGNORE_DEFFACE_P (attrs
[LFACE_SWIDTH_INDEX
])
3116 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3117 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3118 || IGNORE_DEFFACE_P (attrs
[LFACE_AVGWIDTH_INDEX
])
3119 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3120 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3121 || IGNORE_DEFFACE_P (attrs
[LFACE_HEIGHT_INDEX
])
3122 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3123 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3124 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3125 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3126 || IGNORE_DEFFACE_P (attrs
[LFACE_WEIGHT_INDEX
])
3127 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3128 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3129 || IGNORE_DEFFACE_P (attrs
[LFACE_SLANT_INDEX
])
3130 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3131 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3132 || IGNORE_DEFFACE_P (attrs
[LFACE_UNDERLINE_INDEX
])
3133 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3134 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3135 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3136 || IGNORE_DEFFACE_P (attrs
[LFACE_OVERLINE_INDEX
])
3137 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3138 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3139 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3140 || IGNORE_DEFFACE_P (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3141 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3142 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3143 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3144 || IGNORE_DEFFACE_P (attrs
[LFACE_BOX_INDEX
])
3145 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3146 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3147 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3148 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3149 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3150 || IGNORE_DEFFACE_P (attrs
[LFACE_INVERSE_INDEX
])
3151 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3152 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3153 || IGNORE_DEFFACE_P (attrs
[LFACE_FOREGROUND_INDEX
])
3154 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3155 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3156 || IGNORE_DEFFACE_P (attrs
[LFACE_BACKGROUND_INDEX
])
3157 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3158 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3159 || IGNORE_DEFFACE_P (attrs
[LFACE_INHERIT_INDEX
])
3160 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3161 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3162 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3163 #ifdef HAVE_WINDOW_SYSTEM
3164 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3165 || IGNORE_DEFFACE_P (attrs
[LFACE_STIPPLE_INDEX
])
3166 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3167 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3168 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3169 || IGNORE_DEFFACE_P (attrs
[LFACE_FONT_INDEX
])
3170 || NILP (attrs
[LFACE_FONT_INDEX
])
3171 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3176 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3184 xassert (LFACEP (lface
));
3185 check_lface_attrs (XVECTOR (lface
)->contents
);
3189 #else /* GLYPH_DEBUG == 0 */
3191 #define check_lface_attrs(attrs) (void) 0
3192 #define check_lface(lface) (void) 0
3194 #endif /* GLYPH_DEBUG == 0 */
3198 /* Face-merge cycle checking. */
3200 /* A `named merge point' is simply a point during face-merging where we
3201 look up a face by name. We keep a stack of which named lookups we're
3202 currently processing so that we can easily detect cycles, using a
3203 linked- list of struct named_merge_point structures, typically
3204 allocated on the stack frame of the named lookup functions which are
3205 active (so no consing is required). */
3206 struct named_merge_point
3208 Lisp_Object face_name
;
3209 struct named_merge_point
*prev
;
3213 /* If a face merging cycle is detected for FACE_NAME, return 0,
3214 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
3215 FACE_NAME, as the head of the linked list pointed to by
3216 NAMED_MERGE_POINTS, and return 1. */
3219 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
3220 Lisp_Object face_name
,
3221 struct named_merge_point
**named_merge_points
)
3223 struct named_merge_point
*prev
;
3225 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
3226 if (EQ (face_name
, prev
->face_name
))
3229 new_named_merge_point
->face_name
= face_name
;
3230 new_named_merge_point
->prev
= *named_merge_points
;
3232 *named_merge_points
= new_named_merge_point
;
3240 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3241 to make it a symbol. If FACE_NAME is an alias for another face,
3242 return that face's name.
3244 Return default face in case of errors. */
3247 resolve_face_name (face_name
, signal_p
)
3248 Lisp_Object face_name
;
3251 Lisp_Object orig_face
;
3252 Lisp_Object tortoise
, hare
;
3254 if (STRINGP (face_name
))
3255 face_name
= intern (SDATA (face_name
));
3257 if (NILP (face_name
) || !SYMBOLP (face_name
))
3260 orig_face
= face_name
;
3261 tortoise
= hare
= face_name
;
3266 hare
= Fget (hare
, Qface_alias
);
3267 if (NILP (hare
) || !SYMBOLP (hare
))
3271 hare
= Fget (hare
, Qface_alias
);
3272 if (NILP (hare
) || !SYMBOLP (hare
))
3275 tortoise
= Fget (tortoise
, Qface_alias
);
3276 if (EQ (hare
, tortoise
))
3279 Fsignal (Qcircular_list
, Fcons (orig_face
, Qnil
));
3288 /* Return the face definition of FACE_NAME on frame F. F null means
3289 return the definition for new frames. FACE_NAME may be a string or
3290 a symbol (apparently Emacs 20.2 allowed strings as face names in
3291 face text properties; Ediff uses that). If FACE_NAME is an alias
3292 for another face, return that face's definition. If SIGNAL_P is
3293 non-zero, signal an error if FACE_NAME is not a valid face name.
3294 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3297 static INLINE Lisp_Object
3298 lface_from_face_name (f
, face_name
, signal_p
)
3300 Lisp_Object face_name
;
3305 face_name
= resolve_face_name (face_name
, signal_p
);
3308 lface
= assq_no_quit (face_name
, f
->face_alist
);
3310 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3313 lface
= XCDR (lface
);
3315 signal_error ("Invalid face", face_name
);
3317 check_lface (lface
);
3322 /* Get face attributes of face FACE_NAME from frame-local faces on
3323 frame F. Store the resulting attributes in ATTRS which must point
3324 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3325 is non-zero, signal an error if FACE_NAME does not name a face.
3326 Otherwise, value is zero if FACE_NAME is not a face. */
3329 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3331 Lisp_Object face_name
;
3338 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3341 bcopy (XVECTOR (lface
)->contents
, attrs
,
3342 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3352 /* Non-zero if all attributes in face attribute vector ATTRS are
3353 specified, i.e. are non-nil. */
3356 lface_fully_specified_p (attrs
)
3361 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3362 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3363 && i
!= LFACE_AVGWIDTH_INDEX
)
3364 if ((UNSPECIFIEDP (attrs
[i
]) || IGNORE_DEFFACE_P (attrs
[i
]))
3366 /* MAC_TODO: No stipple support on Mac OS yet, this index is
3367 always unspecified. */
3368 && i
!= LFACE_STIPPLE_INDEX
3373 return i
== LFACE_VECTOR_SIZE
;
3376 #ifdef HAVE_WINDOW_SYSTEM
3378 /* Set font-related attributes of Lisp face LFACE from the fullname of
3379 the font opened by FONTNAME. If FORCE_P is zero, set only
3380 unspecified attributes of LFACE. The exception is `font'
3381 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3383 If FONTNAME is not available on frame F,
3384 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3385 If the fullname is not in a valid XLFD format,
3386 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3387 in LFACE and return 1.
3388 Otherwise, return 1. */
3391 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3394 Lisp_Object fontname
;
3395 int force_p
, may_fail_p
;
3397 struct font_name font
;
3402 char *font_name
= SDATA (fontname
);
3403 struct font_info
*font_info
;
3405 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3406 fontset
= fs_query_fontset (fontname
, 0);
3408 font_name
= SDATA (fontset_ascii (fontset
));
3410 /* Check if FONT_NAME is surely available on the system. Usually
3411 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3412 returns quickly. But, even if FONT_NAME is not yet cached,
3413 caching it now is not futail because we anyway load the font
3416 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3426 font
.name
= STRDUPA (font_info
->full_name
);
3427 have_xlfd_p
= split_font_name (f
, &font
, 1);
3429 /* Set attributes only if unspecified, otherwise face defaults for
3430 new frames would never take effect. If we couldn't get a font
3431 name conforming to XLFD, set normal values. */
3433 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3438 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3439 + strlen (font
.fields
[XLFD_FOUNDRY
])
3441 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3442 font
.fields
[XLFD_FAMILY
]);
3443 val
= build_string (buffer
);
3446 val
= build_string ("*");
3447 LFACE_FAMILY (lface
) = val
;
3450 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3453 pt
= xlfd_point_size (f
, &font
);
3455 pt
= pixel_point_size (f
, font_info
->height
* 10);
3457 LFACE_HEIGHT (lface
) = make_number (pt
);
3460 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3461 LFACE_SWIDTH (lface
)
3462 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3464 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3465 LFACE_AVGWIDTH (lface
)
3467 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3470 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3471 LFACE_WEIGHT (lface
)
3472 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3474 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3476 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3478 LFACE_FONT (lface
) = fontname
;
3483 #endif /* HAVE_WINDOW_SYSTEM */
3486 /* Merges the face height FROM with the face height TO, and returns the
3487 merged height. If FROM is an invalid height, then INVALID is
3488 returned instead. FROM and TO may be either absolute face heights or
3489 `relative' heights; the returned value is always an absolute height
3490 unless both FROM and TO are relative. GCPRO is a lisp value that
3491 will be protected from garbage-collection if this function makes a
3495 merge_face_heights (from
, to
, invalid
)
3496 Lisp_Object from
, to
, invalid
;
3498 Lisp_Object result
= invalid
;
3500 if (INTEGERP (from
))
3501 /* FROM is absolute, just use it as is. */
3503 else if (FLOATP (from
))
3504 /* FROM is a scale, use it to adjust TO. */
3507 /* relative X absolute => absolute */
3508 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3509 else if (FLOATP (to
))
3510 /* relative X relative => relative */
3511 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3512 else if (UNSPECIFIEDP (to
))
3515 else if (FUNCTIONP (from
))
3516 /* FROM is a function, which use to adjust TO. */
3518 /* Call function with current height as argument.
3519 From is the new height. */
3520 Lisp_Object args
[2];
3524 result
= safe_call (2, args
);
3526 /* Ensure that if TO was absolute, so is the result. */
3527 if (INTEGERP (to
) && !INTEGERP (result
))
3535 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3536 store the resulting attributes in TO, which must be already be
3537 completely specified and contain only absolute attributes. Every
3538 specified attribute of FROM overrides the corresponding attribute of
3539 TO; relative attributes in FROM are merged with the absolute value in
3540 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
3541 loops in face inheritance; it should be 0 when called from other
3545 merge_face_vectors (f
, from
, to
, named_merge_points
)
3547 Lisp_Object
*from
, *to
;
3548 struct named_merge_point
*named_merge_points
;
3552 /* If FROM inherits from some other faces, merge their attributes into
3553 TO before merging FROM's direct attributes. Note that an :inherit
3554 attribute of `unspecified' is the same as one of nil; we never
3555 merge :inherit attributes, so nil is more correct, but lots of
3556 other code uses `unspecified' as a generic value for face attributes. */
3557 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3558 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3559 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
3561 /* If TO specifies a :font attribute, and FROM specifies some
3562 font-related attribute, we need to clear TO's :font attribute
3563 (because it will be inconsistent with whatever FROM specifies, and
3564 FROM takes precedence). */
3565 if (!NILP (to
[LFACE_FONT_INDEX
])
3566 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3567 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3568 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3569 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3570 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3571 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3572 to
[LFACE_FONT_INDEX
] = Qnil
;
3574 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3575 if (!UNSPECIFIEDP (from
[i
]))
3577 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3578 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
3583 /* TO is always an absolute face, which should inherit from nothing.
3584 We blindly copy the :inherit attribute above and fix it up here. */
3585 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3588 /* Merge the named face FACE_NAME on frame F, into the vector of face
3589 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
3590 inheritance. Returns true if FACE_NAME is a valid face name and
3591 merging succeeded. */
3594 merge_named_face (f
, face_name
, to
, named_merge_points
)
3596 Lisp_Object face_name
;
3598 struct named_merge_point
*named_merge_points
;
3600 struct named_merge_point named_merge_point
;
3602 if (push_named_merge_point (&named_merge_point
,
3603 face_name
, &named_merge_points
))
3605 struct gcpro gcpro1
;
3606 Lisp_Object from
[LFACE_VECTOR_SIZE
];
3607 int ok
= get_lface_attributes (f
, face_name
, from
, 0);
3611 GCPRO1 (named_merge_point
.face_name
);
3612 merge_face_vectors (f
, from
, to
, named_merge_points
);
3623 /* Merge face attributes from the lisp `face reference' FACE_REF on
3624 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
3625 problems with FACE_REF cause an error message to be shown. Return
3626 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
3627 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
3628 list structure; it may be 0 for most callers.
3630 FACE_REF may be a single face specification or a list of such
3631 specifications. Each face specification can be:
3633 1. A symbol or string naming a Lisp face.
3635 2. A property list of the form (KEYWORD VALUE ...) where each
3636 KEYWORD is a face attribute name, and value is an appropriate value
3639 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3640 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3641 for compatibility with 20.2.
3643 Face specifications earlier in lists take precedence over later
3647 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
3649 Lisp_Object face_ref
;
3652 struct named_merge_point
*named_merge_points
;
3654 int ok
= 1; /* Succeed without an error? */
3656 if (CONSP (face_ref
))
3658 Lisp_Object first
= XCAR (face_ref
);
3660 if (EQ (first
, Qforeground_color
)
3661 || EQ (first
, Qbackground_color
))
3663 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3664 . COLOR). COLOR must be a string. */
3665 Lisp_Object color_name
= XCDR (face_ref
);
3666 Lisp_Object color
= first
;
3668 if (STRINGP (color_name
))
3670 if (EQ (color
, Qforeground_color
))
3671 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3673 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3678 add_to_log ("Invalid face color", color_name
, Qnil
);
3682 else if (SYMBOLP (first
)
3683 && *SDATA (SYMBOL_NAME (first
)) == ':')
3685 /* Assume this is the property list form. */
3686 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
3688 Lisp_Object keyword
= XCAR (face_ref
);
3689 Lisp_Object value
= XCAR (XCDR (face_ref
));
3692 /* Specifying `unspecified' is a no-op. */
3693 if (EQ (value
, Qunspecified
))
3695 else if (EQ (keyword
, QCfamily
))
3697 if (STRINGP (value
))
3698 to
[LFACE_FAMILY_INDEX
] = value
;
3702 else if (EQ (keyword
, QCheight
))
3704 Lisp_Object new_height
=
3705 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
3707 if (! NILP (new_height
))
3708 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3712 else if (EQ (keyword
, QCweight
))
3715 && face_numeric_weight (value
) >= 0)
3716 to
[LFACE_WEIGHT_INDEX
] = value
;
3720 else if (EQ (keyword
, QCslant
))
3723 && face_numeric_slant (value
) >= 0)
3724 to
[LFACE_SLANT_INDEX
] = value
;
3728 else if (EQ (keyword
, QCunderline
))
3733 to
[LFACE_UNDERLINE_INDEX
] = value
;
3737 else if (EQ (keyword
, QCoverline
))
3742 to
[LFACE_OVERLINE_INDEX
] = value
;
3746 else if (EQ (keyword
, QCstrike_through
))
3751 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3755 else if (EQ (keyword
, QCbox
))
3758 value
= make_number (1);
3759 if (INTEGERP (value
)
3763 to
[LFACE_BOX_INDEX
] = value
;
3767 else if (EQ (keyword
, QCinverse_video
)
3768 || EQ (keyword
, QCreverse_video
))
3770 if (EQ (value
, Qt
) || NILP (value
))
3771 to
[LFACE_INVERSE_INDEX
] = value
;
3775 else if (EQ (keyword
, QCforeground
))
3777 if (STRINGP (value
))
3778 to
[LFACE_FOREGROUND_INDEX
] = value
;
3782 else if (EQ (keyword
, QCbackground
))
3784 if (STRINGP (value
))
3785 to
[LFACE_BACKGROUND_INDEX
] = value
;
3789 else if (EQ (keyword
, QCstipple
))
3791 #ifdef HAVE_X_WINDOWS
3792 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3793 if (!NILP (pixmap_p
))
3794 to
[LFACE_STIPPLE_INDEX
] = value
;
3799 else if (EQ (keyword
, QCwidth
))
3802 && face_numeric_swidth (value
) >= 0)
3803 to
[LFACE_SWIDTH_INDEX
] = value
;
3807 else if (EQ (keyword
, QCinherit
))
3809 /* This is not really very useful; it's just like a
3810 normal face reference. */
3811 if (! merge_face_ref (f
, value
, to
,
3812 err_msgs
, named_merge_points
))
3820 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
3824 face_ref
= XCDR (XCDR (face_ref
));
3829 /* This is a list of face refs. Those at the beginning of the
3830 list take precedence over what follows, so we have to merge
3831 from the end backwards. */
3832 Lisp_Object next
= XCDR (face_ref
);
3835 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
3837 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
3843 /* FACE_REF ought to be a face name. */
3844 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
3845 if (!ok
&& err_msgs
)
3846 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
3853 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3854 Sinternal_make_lisp_face
, 1, 2, 0,
3855 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3856 If FACE was not known as a face before, create a new one.
3857 If optional argument FRAME is specified, make a frame-local face
3858 for that frame. Otherwise operate on the global face definition.
3859 Value is a vector of face attributes. */)
3861 Lisp_Object face
, frame
;
3863 Lisp_Object global_lface
, lface
;
3867 CHECK_SYMBOL (face
);
3868 global_lface
= lface_from_face_name (NULL
, face
, 0);
3872 CHECK_LIVE_FRAME (frame
);
3874 lface
= lface_from_face_name (f
, face
, 0);
3877 f
= NULL
, lface
= Qnil
;
3879 /* Add a global definition if there is none. */
3880 if (NILP (global_lface
))
3882 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3884 AREF (global_lface
, 0) = Qface
;
3885 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3886 Vface_new_frame_defaults
);
3888 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3889 face id to Lisp face is given by the vector lface_id_to_name.
3890 The mapping from Lisp face to Lisp face id is given by the
3891 property `face' of the Lisp face name. */
3892 if (next_lface_id
== lface_id_to_name_size
)
3894 int new_size
= max (50, 2 * lface_id_to_name_size
);
3895 int sz
= new_size
* sizeof *lface_id_to_name
;
3896 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3897 lface_id_to_name_size
= new_size
;
3900 lface_id_to_name
[next_lface_id
] = face
;
3901 Fput (face
, Qface
, make_number (next_lface_id
));
3905 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3906 AREF (global_lface
, i
) = Qunspecified
;
3908 /* Add a frame-local definition. */
3913 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3915 AREF (lface
, 0) = Qface
;
3916 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3919 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3920 AREF (lface
, i
) = Qunspecified
;
3923 lface
= global_lface
;
3925 /* Changing a named face means that all realized faces depending on
3926 that face are invalid. Since we cannot tell which realized faces
3927 depend on the face, make sure they are all removed. This is done
3928 by incrementing face_change_count. The next call to
3929 init_iterator will then free realized faces. */
3930 if (NILP (Fget (face
, Qface_no_inherit
)))
3932 ++face_change_count
;
3933 ++windows_or_buffers_changed
;
3936 xassert (LFACEP (lface
));
3937 check_lface (lface
);
3942 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3943 Sinternal_lisp_face_p
, 1, 2, 0,
3944 doc
: /* Return non-nil if FACE names a face.
3945 If optional second argument FRAME is non-nil, check for the
3946 existence of a frame-local face with name FACE on that frame.
3947 Otherwise check for the existence of a global face. */)
3949 Lisp_Object face
, frame
;
3955 CHECK_LIVE_FRAME (frame
);
3956 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3959 lface
= lface_from_face_name (NULL
, face
, 0);
3965 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3966 Sinternal_copy_lisp_face
, 4, 4, 0,
3967 doc
: /* Copy face FROM to TO.
3968 If FRAME is t, copy the global face definition of FROM.
3969 Otherwise, copy the frame-local definition of FROM on FRAME.
3970 If NEW-FRAME is a frame, copy that data into the frame-local
3971 definition of TO on NEW-FRAME. If NEW-FRAME is nil.
3972 FRAME controls where the data is copied to.
3974 The value is TO. */)
3975 (from
, to
, frame
, new_frame
)
3976 Lisp_Object from
, to
, frame
, new_frame
;
3978 Lisp_Object lface
, copy
;
3980 CHECK_SYMBOL (from
);
3985 /* Copy global definition of FROM. We don't make copies of
3986 strings etc. because 20.2 didn't do it either. */
3987 lface
= lface_from_face_name (NULL
, from
, 1);
3988 copy
= Finternal_make_lisp_face (to
, Qnil
);
3992 /* Copy frame-local definition of FROM. */
3993 if (NILP (new_frame
))
3995 CHECK_LIVE_FRAME (frame
);
3996 CHECK_LIVE_FRAME (new_frame
);
3997 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3998 copy
= Finternal_make_lisp_face (to
, new_frame
);
4001 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
4002 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
4004 /* Changing a named face means that all realized faces depending on
4005 that face are invalid. Since we cannot tell which realized faces
4006 depend on the face, make sure they are all removed. This is done
4007 by incrementing face_change_count. The next call to
4008 init_iterator will then free realized faces. */
4009 if (NILP (Fget (to
, Qface_no_inherit
)))
4011 ++face_change_count
;
4012 ++windows_or_buffers_changed
;
4019 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
4020 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
4021 doc
: /* Set attribute ATTR of FACE to VALUE.
4022 FRAME being a frame means change the face on that frame.
4023 FRAME nil means change the face of the selected frame.
4024 FRAME t means change the default for new frames.
4025 FRAME 0 means change the face on all frames, and change the default
4027 (face
, attr
, value
, frame
)
4028 Lisp_Object face
, attr
, value
, frame
;
4031 Lisp_Object old_value
= Qnil
;
4032 /* Set 1 if ATTR is QCfont. */
4033 int font_attr_p
= 0;
4034 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
4035 int font_related_attr_p
= 0;
4037 CHECK_SYMBOL (face
);
4038 CHECK_SYMBOL (attr
);
4040 face
= resolve_face_name (face
, 1);
4042 /* If FRAME is 0, change face on all frames, and change the
4043 default for new frames. */
4044 if (INTEGERP (frame
) && XINT (frame
) == 0)
4047 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
4048 FOR_EACH_FRAME (tail
, frame
)
4049 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4053 /* Set lface to the Lisp attribute vector of FACE. */
4056 lface
= lface_from_face_name (NULL
, face
, 1);
4058 /* When updating face-new-frame-defaults, we put :ignore-defface
4059 where the caller wants `unspecified'. This forces the frame
4060 defaults to ignore the defface value. Otherwise, the defface
4061 will take effect, which is generally not what is intended.
4062 The value of that attribute will be inherited from some other
4063 face during face merging. See internal_merge_in_global_face. */
4064 if (UNSPECIFIEDP (value
))
4065 value
= Qignore_defface
;
4070 frame
= selected_frame
;
4072 CHECK_LIVE_FRAME (frame
);
4073 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4075 /* If a frame-local face doesn't exist yet, create one. */
4077 lface
= Finternal_make_lisp_face (face
, frame
);
4080 if (EQ (attr
, QCfamily
))
4082 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4084 CHECK_STRING (value
);
4085 if (SCHARS (value
) == 0)
4086 signal_error ("Invalid face family", value
);
4088 old_value
= LFACE_FAMILY (lface
);
4089 LFACE_FAMILY (lface
) = value
;
4090 font_related_attr_p
= 1;
4092 else if (EQ (attr
, QCheight
))
4094 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4098 test
= (EQ (face
, Qdefault
)
4100 /* The default face must have an absolute size,
4101 otherwise, we do a test merge with a random
4102 height to see if VALUE's ok. */
4103 : merge_face_heights (value
, make_number (10), Qnil
));
4105 if (!INTEGERP (test
) || XINT (test
) <= 0)
4106 signal_error ("Invalid face height", value
);
4109 old_value
= LFACE_HEIGHT (lface
);
4110 LFACE_HEIGHT (lface
) = value
;
4111 font_related_attr_p
= 1;
4113 else if (EQ (attr
, QCweight
))
4115 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4117 CHECK_SYMBOL (value
);
4118 if (face_numeric_weight (value
) < 0)
4119 signal_error ("Invalid face weight", value
);
4121 old_value
= LFACE_WEIGHT (lface
);
4122 LFACE_WEIGHT (lface
) = value
;
4123 font_related_attr_p
= 1;
4125 else if (EQ (attr
, QCslant
))
4127 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4129 CHECK_SYMBOL (value
);
4130 if (face_numeric_slant (value
) < 0)
4131 signal_error ("Invalid face slant", value
);
4133 old_value
= LFACE_SLANT (lface
);
4134 LFACE_SLANT (lface
) = value
;
4135 font_related_attr_p
= 1;
4137 else if (EQ (attr
, QCunderline
))
4139 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4140 if ((SYMBOLP (value
)
4142 && !EQ (value
, Qnil
))
4143 /* Underline color. */
4145 && SCHARS (value
) == 0))
4146 signal_error ("Invalid face underline", value
);
4148 old_value
= LFACE_UNDERLINE (lface
);
4149 LFACE_UNDERLINE (lface
) = value
;
4151 else if (EQ (attr
, QCoverline
))
4153 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4154 if ((SYMBOLP (value
)
4156 && !EQ (value
, Qnil
))
4157 /* Overline color. */
4159 && SCHARS (value
) == 0))
4160 signal_error ("Invalid face overline", value
);
4162 old_value
= LFACE_OVERLINE (lface
);
4163 LFACE_OVERLINE (lface
) = value
;
4165 else if (EQ (attr
, QCstrike_through
))
4167 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4168 if ((SYMBOLP (value
)
4170 && !EQ (value
, Qnil
))
4171 /* Strike-through color. */
4173 && SCHARS (value
) == 0))
4174 signal_error ("Invalid face strike-through", value
);
4176 old_value
= LFACE_STRIKE_THROUGH (lface
);
4177 LFACE_STRIKE_THROUGH (lface
) = value
;
4179 else if (EQ (attr
, QCbox
))
4183 /* Allow t meaning a simple box of width 1 in foreground color
4186 value
= make_number (1);
4188 if (UNSPECIFIEDP (value
) || IGNORE_DEFFACE_P (value
))
4190 else if (NILP (value
))
4192 else if (INTEGERP (value
))
4193 valid_p
= XINT (value
) != 0;
4194 else if (STRINGP (value
))
4195 valid_p
= SCHARS (value
) > 0;
4196 else if (CONSP (value
))
4212 if (EQ (k
, QCline_width
))
4214 if (!INTEGERP (v
) || XINT (v
) == 0)
4217 else if (EQ (k
, QCcolor
))
4219 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
4222 else if (EQ (k
, QCstyle
))
4224 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4231 valid_p
= NILP (tem
);
4237 signal_error ("Invalid face box", value
);
4239 old_value
= LFACE_BOX (lface
);
4240 LFACE_BOX (lface
) = value
;
4242 else if (EQ (attr
, QCinverse_video
)
4243 || EQ (attr
, QCreverse_video
))
4245 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4247 CHECK_SYMBOL (value
);
4248 if (!EQ (value
, Qt
) && !NILP (value
))
4249 signal_error ("Invalid inverse-video face attribute value", value
);
4251 old_value
= LFACE_INVERSE (lface
);
4252 LFACE_INVERSE (lface
) = value
;
4254 else if (EQ (attr
, QCforeground
))
4256 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4258 /* Don't check for valid color names here because it depends
4259 on the frame (display) whether the color will be valid
4260 when the face is realized. */
4261 CHECK_STRING (value
);
4262 if (SCHARS (value
) == 0)
4263 signal_error ("Empty foreground color value", value
);
4265 old_value
= LFACE_FOREGROUND (lface
);
4266 LFACE_FOREGROUND (lface
) = value
;
4268 else if (EQ (attr
, QCbackground
))
4270 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4272 /* Don't check for valid color names here because it depends
4273 on the frame (display) whether the color will be valid
4274 when the face is realized. */
4275 CHECK_STRING (value
);
4276 if (SCHARS (value
) == 0)
4277 signal_error ("Empty background color value", value
);
4279 old_value
= LFACE_BACKGROUND (lface
);
4280 LFACE_BACKGROUND (lface
) = value
;
4282 else if (EQ (attr
, QCstipple
))
4284 #ifdef HAVE_X_WINDOWS
4285 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
4287 && NILP (Fbitmap_spec_p (value
)))
4288 signal_error ("Invalid stipple attribute", value
);
4289 old_value
= LFACE_STIPPLE (lface
);
4290 LFACE_STIPPLE (lface
) = value
;
4291 #endif /* HAVE_X_WINDOWS */
4293 else if (EQ (attr
, QCwidth
))
4295 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4297 CHECK_SYMBOL (value
);
4298 if (face_numeric_swidth (value
) < 0)
4299 signal_error ("Invalid face width", value
);
4301 old_value
= LFACE_SWIDTH (lface
);
4302 LFACE_SWIDTH (lface
) = value
;
4303 font_related_attr_p
= 1;
4305 else if (EQ (attr
, QCfont
))
4307 #ifdef HAVE_WINDOW_SYSTEM
4308 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4310 /* Set font-related attributes of the Lisp face from an XLFD
4316 f
= SELECTED_FRAME ();
4318 f
= check_x_frame (frame
);
4320 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4322 CHECK_STRING (value
);
4324 /* VALUE may be a fontset name or an alias of fontset. In
4325 such a case, use the base fontset name. */
4326 tmp
= Fquery_fontset (value
, Qnil
);
4330 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4331 signal_error ("Invalid font or fontset name", value
);
4336 #endif /* HAVE_WINDOW_SYSTEM */
4338 else if (EQ (attr
, QCinherit
))
4341 if (SYMBOLP (value
))
4344 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4345 if (!SYMBOLP (XCAR (tail
)))
4348 LFACE_INHERIT (lface
) = value
;
4350 signal_error ("Invalid face inheritance", value
);
4352 else if (EQ (attr
, QCbold
))
4354 old_value
= LFACE_WEIGHT (lface
);
4355 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4356 font_related_attr_p
= 1;
4358 else if (EQ (attr
, QCitalic
))
4360 old_value
= LFACE_SLANT (lface
);
4361 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4362 font_related_attr_p
= 1;
4365 signal_error ("Invalid face attribute name", attr
);
4367 if (font_related_attr_p
4368 && !UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
))
4369 /* If a font-related attribute other than QCfont is specified, the
4370 original `font' attribute nor that of default face is useless
4371 to determine a new font. Thus, we set it to nil so that font
4372 selection mechanism doesn't use it. */
4373 LFACE_FONT (lface
) = Qnil
;
4375 /* Changing a named face means that all realized faces depending on
4376 that face are invalid. Since we cannot tell which realized faces
4377 depend on the face, make sure they are all removed. This is done
4378 by incrementing face_change_count. The next call to
4379 init_iterator will then free realized faces. */
4381 && NILP (Fget (face
, Qface_no_inherit
))
4382 && (EQ (attr
, QCfont
)
4383 || NILP (Fequal (old_value
, value
))))
4385 ++face_change_count
;
4386 ++windows_or_buffers_changed
;
4389 if (!UNSPECIFIEDP (value
) && !IGNORE_DEFFACE_P (value
)
4390 && NILP (Fequal (old_value
, value
)))
4396 if (EQ (face
, Qdefault
))
4398 #ifdef HAVE_WINDOW_SYSTEM
4399 /* Changed font-related attributes of the `default' face are
4400 reflected in changed `font' frame parameters. */
4402 && (font_related_attr_p
|| font_attr_p
)
4403 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4404 set_font_frame_param (frame
, lface
);
4406 #endif /* HAVE_WINDOW_SYSTEM */
4408 if (EQ (attr
, QCforeground
))
4409 param
= Qforeground_color
;
4410 else if (EQ (attr
, QCbackground
))
4411 param
= Qbackground_color
;
4413 #ifdef HAVE_WINDOW_SYSTEM
4415 else if (EQ (face
, Qscroll_bar
))
4417 /* Changing the colors of `scroll-bar' sets frame parameters
4418 `scroll-bar-foreground' and `scroll-bar-background'. */
4419 if (EQ (attr
, QCforeground
))
4420 param
= Qscroll_bar_foreground
;
4421 else if (EQ (attr
, QCbackground
))
4422 param
= Qscroll_bar_background
;
4424 #endif /* not WINDOWSNT */
4425 else if (EQ (face
, Qborder
))
4427 /* Changing background color of `border' sets frame parameter
4429 if (EQ (attr
, QCbackground
))
4430 param
= Qborder_color
;
4432 else if (EQ (face
, Qcursor
))
4434 /* Changing background color of `cursor' sets frame parameter
4436 if (EQ (attr
, QCbackground
))
4437 param
= Qcursor_color
;
4439 else if (EQ (face
, Qmouse
))
4441 /* Changing background color of `mouse' sets frame parameter
4443 if (EQ (attr
, QCbackground
))
4444 param
= Qmouse_color
;
4446 #endif /* HAVE_WINDOW_SYSTEM */
4447 else if (EQ (face
, Qmenu
))
4449 /* Indicate that we have to update the menu bar when
4450 realizing faces on FRAME. FRAME t change the
4451 default for new frames. We do this by setting
4452 setting the flag in new face caches */
4455 struct frame
*f
= XFRAME (frame
);
4456 if (FRAME_FACE_CACHE (f
) == NULL
)
4457 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4458 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4461 menu_face_changed_default
= 1;
4467 /* Update `default-frame-alist', which is used for new frames. */
4469 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4472 /* Update the current frame's parameters. */
4475 cons
= XCAR (Vparam_value_alist
);
4476 XSETCAR (cons
, param
);
4477 XSETCDR (cons
, value
);
4478 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4487 #ifdef HAVE_WINDOW_SYSTEM
4489 /* Set the `font' frame parameter of FRAME determined from `default'
4490 face attributes LFACE. If a face or fontset name is explicitely
4491 specfied in LFACE, use it as is. Otherwise, determine a font name
4492 from the other font-related atrributes of LFACE. In that case, if
4493 there's no matching font, signals an error. */
4496 set_font_frame_param (frame
, lface
)
4497 Lisp_Object frame
, lface
;
4499 struct frame
*f
= XFRAME (frame
);
4501 if (FRAME_WINDOW_P (f
))
4503 Lisp_Object font_name
;
4506 if (STRINGP (LFACE_FONT (lface
)))
4507 font_name
= LFACE_FONT (lface
);
4510 /* Choose a font name that reflects LFACE's attributes and has
4511 the registry and encoding pattern specified in the default
4512 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4513 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0, 0);
4515 error ("No font matches the specified attribute");
4516 font_name
= build_string (font
);
4520 f
->default_face_done_p
= 0;
4521 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4526 /* Update the corresponding face when frame parameter PARAM on frame F
4527 has been assigned the value NEW_VALUE. */
4530 update_face_from_frame_parameter (f
, param
, new_value
)
4532 Lisp_Object param
, new_value
;
4534 Lisp_Object face
= Qnil
;
4537 /* If there are no faces yet, give up. This is the case when called
4538 from Fx_create_frame, and we do the necessary things later in
4539 face-set-after-frame-defaults. */
4540 if (NILP (f
->face_alist
))
4543 if (EQ (param
, Qforeground_color
))
4546 lface
= lface_from_face_name (f
, face
, 1);
4547 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4548 ? new_value
: Qunspecified
);
4549 realize_basic_faces (f
);
4551 else if (EQ (param
, Qbackground_color
))
4555 /* Changing the background color might change the background
4556 mode, so that we have to load new defface specs.
4557 Call frame-set-background-mode to do that. */
4558 XSETFRAME (frame
, f
);
4559 call1 (Qframe_set_background_mode
, frame
);
4562 lface
= lface_from_face_name (f
, face
, 1);
4563 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4564 ? new_value
: Qunspecified
);
4565 realize_basic_faces (f
);
4567 else if (EQ (param
, Qborder_color
))
4570 lface
= lface_from_face_name (f
, face
, 1);
4571 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4572 ? new_value
: Qunspecified
);
4574 else if (EQ (param
, Qcursor_color
))
4577 lface
= lface_from_face_name (f
, face
, 1);
4578 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4579 ? new_value
: Qunspecified
);
4581 else if (EQ (param
, Qmouse_color
))
4584 lface
= lface_from_face_name (f
, face
, 1);
4585 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4586 ? new_value
: Qunspecified
);
4589 /* Changing a named face means that all realized faces depending on
4590 that face are invalid. Since we cannot tell which realized faces
4591 depend on the face, make sure they are all removed. This is done
4592 by incrementing face_change_count. The next call to
4593 init_iterator will then free realized faces. */
4595 && NILP (Fget (face
, Qface_no_inherit
)))
4597 ++face_change_count
;
4598 ++windows_or_buffers_changed
;
4603 /* Get the value of X resource RESOURCE, class CLASS for the display
4604 of frame FRAME. This is here because ordinary `x-get-resource'
4605 doesn't take a frame argument. */
4607 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4608 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4609 (resource
, class, frame
)
4610 Lisp_Object resource
, class, frame
;
4612 Lisp_Object value
= Qnil
;
4613 CHECK_STRING (resource
);
4614 CHECK_STRING (class);
4615 CHECK_LIVE_FRAME (frame
);
4617 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4618 resource
, class, Qnil
, Qnil
);
4624 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4625 If VALUE is "on" or "true", return t. If VALUE is "off" or
4626 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4627 error; if SIGNAL_P is zero, return 0. */
4630 face_boolean_x_resource_value (value
, signal_p
)
4634 Lisp_Object result
= make_number (0);
4636 xassert (STRINGP (value
));
4638 if (xstricmp (SDATA (value
), "on") == 0
4639 || xstricmp (SDATA (value
), "true") == 0)
4641 else if (xstricmp (SDATA (value
), "off") == 0
4642 || xstricmp (SDATA (value
), "false") == 0)
4644 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4645 result
= Qunspecified
;
4647 signal_error ("Invalid face attribute value from X resource", value
);
4653 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4654 Finternal_set_lisp_face_attribute_from_resource
,
4655 Sinternal_set_lisp_face_attribute_from_resource
,
4656 3, 4, 0, doc
: /* */)
4657 (face
, attr
, value
, frame
)
4658 Lisp_Object face
, attr
, value
, frame
;
4660 CHECK_SYMBOL (face
);
4661 CHECK_SYMBOL (attr
);
4662 CHECK_STRING (value
);
4664 if (xstricmp (SDATA (value
), "unspecified") == 0)
4665 value
= Qunspecified
;
4666 else if (EQ (attr
, QCheight
))
4668 value
= Fstring_to_number (value
, make_number (10));
4669 if (XINT (value
) <= 0)
4670 signal_error ("Invalid face height from X resource", value
);
4672 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4673 value
= face_boolean_x_resource_value (value
, 1);
4674 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4675 value
= intern (SDATA (value
));
4676 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4677 value
= face_boolean_x_resource_value (value
, 1);
4678 else if (EQ (attr
, QCunderline
)
4679 || EQ (attr
, QCoverline
)
4680 || EQ (attr
, QCstrike_through
))
4682 Lisp_Object boolean_value
;
4684 /* If the result of face_boolean_x_resource_value is t or nil,
4685 VALUE does NOT specify a color. */
4686 boolean_value
= face_boolean_x_resource_value (value
, 0);
4687 if (SYMBOLP (boolean_value
))
4688 value
= boolean_value
;
4690 else if (EQ (attr
, QCbox
) || EQ (attr
, QCinherit
))
4691 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4693 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4696 #endif /* HAVE_WINDOW_SYSTEM */
4699 /***********************************************************************
4701 ***********************************************************************/
4703 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4705 /* Make menus on frame F appear as specified by the `menu' face. */
4708 x_update_menu_appearance (f
)
4711 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4715 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4719 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4720 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4721 const char *myname
= SDATA (Vx_resource_name
);
4724 const char *popup_path
= "popup_menu";
4726 const char *popup_path
= "menu.popup";
4729 if (STRINGP (LFACE_FOREGROUND (lface
)))
4731 sprintf (line
, "%s.%s*foreground: %s",
4733 SDATA (LFACE_FOREGROUND (lface
)));
4734 XrmPutLineResource (&rdb
, line
);
4735 sprintf (line
, "%s.pane.menubar*foreground: %s",
4736 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4737 XrmPutLineResource (&rdb
, line
);
4741 if (STRINGP (LFACE_BACKGROUND (lface
)))
4743 sprintf (line
, "%s.%s*background: %s",
4745 SDATA (LFACE_BACKGROUND (lface
)));
4746 XrmPutLineResource (&rdb
, line
);
4747 sprintf (line
, "%s.pane.menubar*background: %s",
4748 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4749 XrmPutLineResource (&rdb
, line
);
4754 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4755 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4756 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4757 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4758 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4759 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4762 const char *suffix
= "List";
4765 #if defined HAVE_X_I18N
4767 const char *suffix
= "Set";
4769 const char *suffix
= "";
4773 #if defined HAVE_X_I18N
4774 extern char *xic_create_fontsetname
4775 P_ ((char *base_fontname
, Bool motif
));
4776 char *fontsetname
= xic_create_fontsetname (face
->font_name
, motif
);
4778 char *fontsetname
= face
->font_name
;
4780 sprintf (line
, "%s.pane.menubar*font%s: %s",
4781 myname
, suffix
, fontsetname
);
4782 XrmPutLineResource (&rdb
, line
);
4783 sprintf (line
, "%s.%s*font%s: %s",
4784 myname
, popup_path
, suffix
, fontsetname
);
4785 XrmPutLineResource (&rdb
, line
);
4787 if (fontsetname
!= face
->font_name
)
4788 xfree (fontsetname
);
4791 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4792 free_frame_menubar (f
);
4796 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4799 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4800 Sface_attribute_relative_p
,
4802 doc
: /* Check whether a face attribute value is relative.
4803 Specifically, this function returns t if the attribute ATTRIBUTE
4804 with the value VALUE is relative.
4806 A relative value is one that doesn't entirely override whatever is
4807 inherited from another face. For most possible attributes,
4808 the only relative value that users see is `unspecified'.
4809 However, for :height, floating point values are also relative. */)
4811 Lisp_Object attribute
, value
;
4813 if (EQ (value
, Qunspecified
) || (EQ (value
, Qignore_defface
)))
4815 else if (EQ (attribute
, QCheight
))
4816 return INTEGERP (value
) ? Qnil
: Qt
;
4821 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4823 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4824 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4825 the result will be absolute, otherwise it will be relative. */)
4826 (attribute
, value1
, value2
)
4827 Lisp_Object attribute
, value1
, value2
;
4829 if (EQ (value1
, Qunspecified
) || EQ (value1
, Qignore_defface
))
4831 else if (EQ (attribute
, QCheight
))
4832 return merge_face_heights (value1
, value2
, value1
);
4838 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4839 Sinternal_get_lisp_face_attribute
,
4841 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4842 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4843 face attribute name, signal an error.
4844 If the optional argument FRAME is given, report on face SYMBOL in that
4845 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
4846 frames). If FRAME is omitted or nil, use the selected frame. */)
4847 (symbol
, keyword
, frame
)
4848 Lisp_Object symbol
, keyword
, frame
;
4850 Lisp_Object lface
, value
= Qnil
;
4852 CHECK_SYMBOL (symbol
);
4853 CHECK_SYMBOL (keyword
);
4856 lface
= lface_from_face_name (NULL
, symbol
, 1);
4860 frame
= selected_frame
;
4861 CHECK_LIVE_FRAME (frame
);
4862 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4865 if (EQ (keyword
, QCfamily
))
4866 value
= LFACE_FAMILY (lface
);
4867 else if (EQ (keyword
, QCheight
))
4868 value
= LFACE_HEIGHT (lface
);
4869 else if (EQ (keyword
, QCweight
))
4870 value
= LFACE_WEIGHT (lface
);
4871 else if (EQ (keyword
, QCslant
))
4872 value
= LFACE_SLANT (lface
);
4873 else if (EQ (keyword
, QCunderline
))
4874 value
= LFACE_UNDERLINE (lface
);
4875 else if (EQ (keyword
, QCoverline
))
4876 value
= LFACE_OVERLINE (lface
);
4877 else if (EQ (keyword
, QCstrike_through
))
4878 value
= LFACE_STRIKE_THROUGH (lface
);
4879 else if (EQ (keyword
, QCbox
))
4880 value
= LFACE_BOX (lface
);
4881 else if (EQ (keyword
, QCinverse_video
)
4882 || EQ (keyword
, QCreverse_video
))
4883 value
= LFACE_INVERSE (lface
);
4884 else if (EQ (keyword
, QCforeground
))
4885 value
= LFACE_FOREGROUND (lface
);
4886 else if (EQ (keyword
, QCbackground
))
4887 value
= LFACE_BACKGROUND (lface
);
4888 else if (EQ (keyword
, QCstipple
))
4889 value
= LFACE_STIPPLE (lface
);
4890 else if (EQ (keyword
, QCwidth
))
4891 value
= LFACE_SWIDTH (lface
);
4892 else if (EQ (keyword
, QCinherit
))
4893 value
= LFACE_INHERIT (lface
);
4894 else if (EQ (keyword
, QCfont
))
4895 value
= LFACE_FONT (lface
);
4897 signal_error ("Invalid face attribute name", keyword
);
4899 if (IGNORE_DEFFACE_P (value
))
4900 return Qunspecified
;
4906 DEFUN ("internal-lisp-face-attribute-values",
4907 Finternal_lisp_face_attribute_values
,
4908 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4909 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4910 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4914 Lisp_Object result
= Qnil
;
4916 CHECK_SYMBOL (attr
);
4918 if (EQ (attr
, QCweight
)
4919 || EQ (attr
, QCslant
)
4920 || EQ (attr
, QCwidth
))
4922 /* Extract permissible symbols from tables. */
4923 struct table_entry
*table
;
4926 if (EQ (attr
, QCweight
))
4927 table
= weight_table
, dim
= DIM (weight_table
);
4928 else if (EQ (attr
, QCslant
))
4929 table
= slant_table
, dim
= DIM (slant_table
);
4931 table
= swidth_table
, dim
= DIM (swidth_table
);
4933 for (i
= 0; i
< dim
; ++i
)
4935 Lisp_Object symbol
= *table
[i
].symbol
;
4936 Lisp_Object tail
= result
;
4939 && !EQ (XCAR (tail
), symbol
))
4943 result
= Fcons (symbol
, result
);
4946 else if (EQ (attr
, QCunderline
))
4947 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4948 else if (EQ (attr
, QCoverline
))
4949 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4950 else if (EQ (attr
, QCstrike_through
))
4951 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4952 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4953 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4959 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4960 Sinternal_merge_in_global_face
, 2, 2, 0,
4961 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4962 Default face attributes override any local face attributes. */)
4964 Lisp_Object face
, frame
;
4967 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4969 CHECK_LIVE_FRAME (frame
);
4970 global_lface
= lface_from_face_name (NULL
, face
, 1);
4971 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4972 if (NILP (local_lface
))
4973 local_lface
= Finternal_make_lisp_face (face
, frame
);
4975 /* Make every specified global attribute override the local one.
4976 BEWARE!! This is only used from `face-set-after-frame-default' where
4977 the local frame is defined from default specs in `face-defface-spec'
4978 and those should be overridden by global settings. Hence the strange
4979 "global before local" priority. */
4980 lvec
= XVECTOR (local_lface
)->contents
;
4981 gvec
= XVECTOR (global_lface
)->contents
;
4982 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4983 if (! UNSPECIFIEDP (gvec
[i
]))
4985 if (IGNORE_DEFFACE_P (gvec
[i
]))
4986 lvec
[i
] = Qunspecified
;
4995 /* The following function is implemented for compatibility with 20.2.
4996 The function is used in x-resolve-fonts when it is asked to
4997 return fonts with the same size as the font of a face. This is
4998 done in fontset.el. */
5000 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
5001 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
5002 If the optional argument FRAME is given, report on face FACE in that frame.
5003 If FRAME is t, report on the defaults for face FACE (for new frames).
5004 The font default for a face is either nil, or a list
5005 of the form (bold), (italic) or (bold italic).
5006 If FRAME is omitted or nil, use the selected frame. */)
5008 Lisp_Object face
, frame
;
5012 Lisp_Object result
= Qnil
;
5013 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
5015 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
5016 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
5017 result
= Fcons (Qbold
, result
);
5019 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
5020 && !EQ (LFACE_SLANT (lface
), Qnormal
))
5021 result
= Fcons (Qitalic
, result
);
5027 struct frame
*f
= frame_or_selected_frame (frame
, 1);
5028 int face_id
= lookup_named_face (f
, face
, 0, 1);
5029 struct face
*face
= FACE_FROM_ID (f
, face_id
);
5030 return face
? build_string (face
->font_name
) : Qnil
;
5035 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
5036 all attributes are `equal'. Tries to be fast because this function
5037 is called quite often. */
5040 face_attr_equal_p (v1
, v2
)
5043 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
5044 and the other is specified. */
5045 if (XTYPE (v1
) != XTYPE (v2
))
5054 if (SBYTES (v1
) != SBYTES (v2
))
5057 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
5064 return !NILP (Fequal (v1
, v2
));
5069 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
5070 all attributes are `equal'. Tries to be fast because this function
5071 is called quite often. */
5074 lface_equal_p (v1
, v2
)
5075 Lisp_Object
*v1
, *v2
;
5079 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
5080 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
5086 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
5087 Sinternal_lisp_face_equal_p
, 2, 3, 0,
5088 doc
: /* True if FACE1 and FACE2 are equal.
5089 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
5090 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
5091 If FRAME is omitted or nil, use the selected frame. */)
5092 (face1
, face2
, frame
)
5093 Lisp_Object face1
, face2
, frame
;
5097 Lisp_Object lface1
, lface2
;
5102 /* Don't use check_x_frame here because this function is called
5103 before X frames exist. At that time, if FRAME is nil,
5104 selected_frame will be used which is the frame dumped with
5105 Emacs. That frame is not an X frame. */
5106 f
= frame_or_selected_frame (frame
, 2);
5108 lface1
= lface_from_face_name (f
, face1
, 1);
5109 lface2
= lface_from_face_name (f
, face2
, 1);
5110 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
5111 XVECTOR (lface2
)->contents
);
5112 return equal_p
? Qt
: Qnil
;
5116 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
5117 Sinternal_lisp_face_empty_p
, 1, 2, 0,
5118 doc
: /* True if FACE has no attribute specified.
5119 If the optional argument FRAME is given, report on face FACE in that frame.
5120 If FRAME is t, report on the defaults for face FACE (for new frames).
5121 If FRAME is omitted or nil, use the selected frame. */)
5123 Lisp_Object face
, frame
;
5130 frame
= selected_frame
;
5131 CHECK_LIVE_FRAME (frame
);
5135 lface
= lface_from_face_name (NULL
, face
, 1);
5137 lface
= lface_from_face_name (f
, face
, 1);
5139 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5140 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5143 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5147 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5149 doc
: /* Return an alist of frame-local faces defined on FRAME.
5150 For internal use only. */)
5154 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5155 return f
->face_alist
;
5159 /* Return a hash code for Lisp string STRING with case ignored. Used
5160 below in computing a hash value for a Lisp face. */
5162 static INLINE
unsigned
5163 hash_string_case_insensitive (string
)
5166 const unsigned char *s
;
5168 xassert (STRINGP (string
));
5169 for (s
= SDATA (string
); *s
; ++s
)
5170 hash
= (hash
<< 1) ^ tolower (*s
);
5175 /* Return a hash code for face attribute vector V. */
5177 static INLINE
unsigned
5181 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5182 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5183 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5184 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5185 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5186 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5187 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5191 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5192 considering charsets/registries). They do if they specify the same
5193 family, point size, weight, width, slant, and fontset. Both LFACE1
5194 and LFACE2 must be fully-specified. */
5197 lface_same_font_attributes_p (lface1
, lface2
)
5198 Lisp_Object
*lface1
, *lface2
;
5200 xassert (lface_fully_specified_p (lface1
)
5201 && lface_fully_specified_p (lface2
));
5202 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5203 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5204 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5205 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5206 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5207 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5208 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5209 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5210 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5211 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5212 && xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5213 SDATA (lface2
[LFACE_FONT_INDEX
])))));
5218 /***********************************************************************
5220 ***********************************************************************/
5222 /* Allocate and return a new realized face for Lisp face attribute
5225 static struct face
*
5226 make_realized_face (attr
)
5229 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5230 bzero (face
, sizeof *face
);
5231 face
->ascii_face
= face
;
5232 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5237 /* Free realized face FACE, including its X resources. FACE may
5241 free_realized_face (f
, face
)
5247 #ifdef HAVE_WINDOW_SYSTEM
5248 if (FRAME_WINDOW_P (f
))
5250 /* Free fontset of FACE if it is ASCII face. */
5251 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5252 free_face_fontset (f
, face
);
5255 x_free_gc (f
, face
->gc
);
5259 free_face_colors (f
, face
);
5260 x_destroy_bitmap (f
, face
->stipple
);
5262 #endif /* HAVE_WINDOW_SYSTEM */
5269 /* Prepare face FACE for subsequent display on frame F. This
5270 allocated GCs if they haven't been allocated yet or have been freed
5271 by clearing the face cache. */
5274 prepare_face_for_display (f
, face
)
5278 #ifdef HAVE_WINDOW_SYSTEM
5279 xassert (FRAME_WINDOW_P (f
));
5284 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5286 xgcv
.foreground
= face
->foreground
;
5287 xgcv
.background
= face
->background
;
5288 #ifdef HAVE_X_WINDOWS
5289 xgcv
.graphics_exposures
= False
;
5291 /* The font of FACE may be null if we couldn't load it. */
5294 #ifdef HAVE_X_WINDOWS
5295 xgcv
.font
= face
->font
->fid
;
5298 xgcv
.font
= face
->font
;
5301 xgcv
.font
= face
->font
;
5307 #ifdef HAVE_X_WINDOWS
5310 xgcv
.fill_style
= FillOpaqueStippled
;
5311 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5312 mask
|= GCFillStyle
| GCStipple
;
5315 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5318 #endif /* HAVE_WINDOW_SYSTEM */
5322 /* Returns the `distance' between the colors X and Y. */
5325 color_distance (x
, y
)
5328 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5329 Quoting from that paper:
5331 This formula has results that are very close to L*u*v* (with the
5332 modified lightness curve) and, more importantly, it is a more even
5333 algorithm: it does not have a range of colours where it suddenly
5334 gives far from optimal results.
5336 See <http://www.compuphase.com/cmetric.htm> for more info. */
5338 long r
= (x
->red
- y
->red
) >> 8;
5339 long g
= (x
->green
- y
->green
) >> 8;
5340 long b
= (x
->blue
- y
->blue
) >> 8;
5341 long r_mean
= (x
->red
+ y
->red
) >> 9;
5344 (((512 + r_mean
) * r
* r
) >> 8)
5346 + (((767 - r_mean
) * b
* b
) >> 8);
5350 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5351 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5352 COLOR1 and COLOR2 may be either strings containing the color name,
5353 or lists of the form (RED GREEN BLUE).
5354 If FRAME is unspecified or nil, the current frame is used. */)
5355 (color1
, color2
, frame
)
5356 Lisp_Object color1
, color2
, frame
;
5359 XColor cdef1
, cdef2
;
5362 frame
= selected_frame
;
5363 CHECK_LIVE_FRAME (frame
);
5366 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5367 || !STRINGP (color1
)
5368 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5369 signal_error ("Invalid color", color1
);
5370 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5371 || !STRINGP (color2
)
5372 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5373 signal_error ("Invalid color", color2
);
5375 return make_number (color_distance (&cdef1
, &cdef2
));
5379 /***********************************************************************
5381 ***********************************************************************/
5383 /* Return a new face cache for frame F. */
5385 static struct face_cache
*
5389 struct face_cache
*c
;
5392 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5393 bzero (c
, sizeof *c
);
5394 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5395 c
->buckets
= (struct face
**) xmalloc (size
);
5396 bzero (c
->buckets
, size
);
5398 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5400 c
->menu_face_changed_p
= menu_face_changed_default
;
5405 /* Clear out all graphics contexts for all realized faces, except for
5406 the basic faces. This should be done from time to time just to avoid
5407 keeping too many graphics contexts that are no longer needed. */
5411 struct face_cache
*c
;
5413 if (c
&& FRAME_WINDOW_P (c
->f
))
5415 #ifdef HAVE_WINDOW_SYSTEM
5417 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5419 struct face
*face
= c
->faces_by_id
[i
];
5420 if (face
&& face
->gc
)
5422 x_free_gc (c
->f
, face
->gc
);
5426 #endif /* HAVE_WINDOW_SYSTEM */
5431 /* Free all realized faces in face cache C, including basic faces.
5432 C may be null. If faces are freed, make sure the frame's current
5433 matrix is marked invalid, so that a display caused by an expose
5434 event doesn't try to use faces we destroyed. */
5437 free_realized_faces (c
)
5438 struct face_cache
*c
;
5443 struct frame
*f
= c
->f
;
5445 /* We must block input here because we can't process X events
5446 safely while only some faces are freed, or when the frame's
5447 current matrix still references freed faces. */
5450 for (i
= 0; i
< c
->used
; ++i
)
5452 free_realized_face (f
, c
->faces_by_id
[i
]);
5453 c
->faces_by_id
[i
] = NULL
;
5457 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5458 bzero (c
->buckets
, size
);
5460 /* Must do a thorough redisplay the next time. Mark current
5461 matrices as invalid because they will reference faces freed
5462 above. This function is also called when a frame is
5463 destroyed. In this case, the root window of F is nil. */
5464 if (WINDOWP (f
->root_window
))
5466 clear_current_matrices (f
);
5467 ++windows_or_buffers_changed
;
5475 /* Free all faces realized for multibyte characters on frame F that
5479 free_realized_multibyte_face (f
, fontset
)
5483 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5487 /* We must block input here because we can't process X events safely
5488 while only some faces are freed, or when the frame's current
5489 matrix still references freed faces. */
5492 for (i
= 0; i
< cache
->used
; i
++)
5494 face
= cache
->faces_by_id
[i
];
5496 && face
!= face
->ascii_face
5497 && face
->fontset
== fontset
)
5499 uncache_face (cache
, face
);
5500 free_realized_face (f
, face
);
5504 /* Must do a thorough redisplay the next time. Mark current
5505 matrices as invalid because they will reference faces freed
5506 above. This function is also called when a frame is destroyed.
5507 In this case, the root window of F is nil. */
5508 if (WINDOWP (f
->root_window
))
5510 clear_current_matrices (f
);
5511 ++windows_or_buffers_changed
;
5518 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5519 This is done after attributes of a named face have been changed,
5520 because we can't tell which realized faces depend on that face. */
5523 free_all_realized_faces (frame
)
5529 FOR_EACH_FRAME (rest
, frame
)
5530 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5533 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5537 /* Free face cache C and faces in it, including their X resources. */
5541 struct face_cache
*c
;
5545 free_realized_faces (c
);
5547 xfree (c
->faces_by_id
);
5553 /* Cache realized face FACE in face cache C. HASH is the hash value
5554 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5555 collision list of the face hash table of C. This is done because
5556 otherwise lookup_face would find FACE for every character, even if
5557 faces with the same attributes but for specific characters exist. */
5560 cache_face (c
, face
, hash
)
5561 struct face_cache
*c
;
5565 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5569 if (face
->fontset
>= 0)
5571 struct face
*last
= c
->buckets
[i
];
5582 c
->buckets
[i
] = face
;
5583 face
->prev
= face
->next
= NULL
;
5589 face
->next
= c
->buckets
[i
];
5591 face
->next
->prev
= face
;
5592 c
->buckets
[i
] = face
;
5595 /* Find a free slot in C->faces_by_id and use the index of the free
5596 slot as FACE->id. */
5597 for (i
= 0; i
< c
->used
; ++i
)
5598 if (c
->faces_by_id
[i
] == NULL
)
5602 /* Maybe enlarge C->faces_by_id. */
5605 if (c
->used
== c
->size
)
5608 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
5609 if (new_size
== c
->size
)
5610 abort (); /* Alternatives? ++kfs */
5611 sz
= new_size
* sizeof *c
->faces_by_id
;
5612 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5619 /* Check that FACE got a unique id. */
5624 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5625 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5631 #endif /* GLYPH_DEBUG */
5633 c
->faces_by_id
[i
] = face
;
5637 /* Remove face FACE from cache C. */
5640 uncache_face (c
, face
)
5641 struct face_cache
*c
;
5644 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5647 face
->prev
->next
= face
->next
;
5649 c
->buckets
[i
] = face
->next
;
5652 face
->next
->prev
= face
->prev
;
5654 c
->faces_by_id
[face
->id
] = NULL
;
5655 if (face
->id
== c
->used
)
5660 /* Look up a realized face with face attributes ATTR in the face cache
5661 of frame F. The face will be used to display character C. Value
5662 is the ID of the face found. If no suitable face is found, realize
5663 a new one. In that case, if C is a multibyte character, BASE_FACE
5664 is a face that has the same attributes. */
5667 lookup_face (f
, attr
, c
, base_face
)
5671 struct face
*base_face
;
5673 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5678 xassert (cache
!= NULL
);
5679 check_lface_attrs (attr
);
5681 /* Look up ATTR in the face cache. */
5682 hash
= lface_hash (attr
);
5683 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5685 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5686 if (face
->hash
== hash
5687 && (!FRAME_WINDOW_P (f
)
5688 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5689 && lface_equal_p (face
->lface
, attr
))
5692 /* If not found, realize a new face. */
5694 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5697 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5699 /* When this function is called from face_for_char (in this case, C is
5700 a multibyte character), a fontset of a face returned by
5701 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5702 C) is not sutisfied. The fontset is set for this face by
5703 face_for_char later. */
5705 if (FRAME_WINDOW_P (f
))
5706 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5708 #endif /* GLYPH_DEBUG */
5714 /* Return the face id of the realized face for named face SYMBOL on
5715 frame F suitable for displaying character C. Value is -1 if the
5716 face couldn't be determined, which might happen if the default face
5717 isn't realized and cannot be realized. */
5720 lookup_named_face (f
, symbol
, c
, signal_p
)
5726 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5727 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5728 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5730 if (default_face
== NULL
)
5732 if (!realize_basic_faces (f
))
5734 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5737 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
))
5740 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5741 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5743 return lookup_face (f
, attrs
, c
, NULL
);
5747 /* Return the ID of the realized ASCII face of Lisp face with ID
5748 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5751 ascii_face_of_lisp_face (f
, lface_id
)
5757 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5759 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5760 face_id
= lookup_named_face (f
, face_name
, 0, 1);
5769 /* Return a face for charset ASCII that is like the face with id
5770 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5771 STEPS < 0 means larger. Value is the id of the face. */
5774 smaller_face (f
, face_id
, steps
)
5778 #ifdef HAVE_WINDOW_SYSTEM
5780 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5781 int pt
, last_pt
, last_height
;
5784 struct face
*new_face
;
5786 /* If not called for an X frame, just return the original face. */
5787 if (FRAME_TERMCAP_P (f
))
5790 /* Try in increments of 1/2 pt. */
5791 delta
= steps
< 0 ? 5 : -5;
5792 steps
= abs (steps
);
5794 face
= FACE_FROM_ID (f
, face_id
);
5795 bcopy (face
->lface
, attrs
, sizeof attrs
);
5796 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5797 new_face_id
= face_id
;
5798 last_height
= FONT_HEIGHT (face
->font
);
5802 /* Give up if we cannot find a font within 10pt. */
5803 && abs (last_pt
- pt
) < 100)
5805 /* Look up a face for a slightly smaller/larger font. */
5807 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5808 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5809 new_face
= FACE_FROM_ID (f
, new_face_id
);
5811 /* If height changes, count that as one step. */
5812 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5813 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5816 last_height
= FONT_HEIGHT (new_face
->font
);
5823 #else /* not HAVE_WINDOW_SYSTEM */
5827 #endif /* not HAVE_WINDOW_SYSTEM */
5831 /* Return a face for charset ASCII that is like the face with id
5832 FACE_ID on frame F, but has height HEIGHT. */
5835 face_with_height (f
, face_id
, height
)
5840 #ifdef HAVE_WINDOW_SYSTEM
5842 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5844 if (FRAME_TERMCAP_P (f
)
5848 face
= FACE_FROM_ID (f
, face_id
);
5849 bcopy (face
->lface
, attrs
, sizeof attrs
);
5850 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5851 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5852 #endif /* HAVE_WINDOW_SYSTEM */
5858 /* Return the face id of the realized face for named face SYMBOL on
5859 frame F suitable for displaying character C, and use attributes of
5860 the face FACE_ID for attributes that aren't completely specified by
5861 SYMBOL. This is like lookup_named_face, except that the default
5862 attributes come from FACE_ID, not from the default face. FACE_ID
5863 is assumed to be already realized. */
5866 lookup_derived_face (f
, symbol
, c
, face_id
, signal_p
)
5873 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5874 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5875 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5880 get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
);
5881 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5882 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5883 return lookup_face (f
, attrs
, c
, default_face
);
5886 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5887 Sface_attributes_as_vector
, 1, 1, 0,
5888 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5893 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5895 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
5902 /***********************************************************************
5903 Face capability testing
5904 ***********************************************************************/
5907 /* If the distance (as returned by color_distance) between two colors is
5908 less than this, then they are considered the same, for determining
5909 whether a color is supported or not. The range of values is 0-65535. */
5911 #define TTY_SAME_COLOR_THRESHOLD 10000
5913 #ifdef HAVE_WINDOW_SYSTEM
5915 /* Return non-zero if all the face attributes in ATTRS are supported
5916 on the window-system frame F.
5918 The definition of `supported' is somewhat heuristic, but basically means
5919 that a face containing all the attributes in ATTRS, when merged with the
5920 default face for display, can be represented in a way that's
5922 \(1) different in appearance than the default face, and
5923 \(2) `close in spirit' to what the attributes specify, if not exact. */
5926 x_supports_face_attributes_p (f
, attrs
, def_face
)
5929 struct face
*def_face
;
5931 Lisp_Object
*def_attrs
= def_face
->lface
;
5933 /* Check that other specified attributes are different that the default
5935 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
5936 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
5937 def_attrs
[LFACE_UNDERLINE_INDEX
]))
5938 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
5939 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
5940 def_attrs
[LFACE_INVERSE_INDEX
]))
5941 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
5942 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
5943 def_attrs
[LFACE_FOREGROUND_INDEX
]))
5944 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
5945 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
5946 def_attrs
[LFACE_BACKGROUND_INDEX
]))
5947 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5948 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
5949 def_attrs
[LFACE_STIPPLE_INDEX
]))
5950 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5951 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
5952 def_attrs
[LFACE_OVERLINE_INDEX
]))
5953 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5954 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5955 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
5956 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5957 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
5958 def_attrs
[LFACE_BOX_INDEX
])))
5961 /* Check font-related attributes, as those are the most commonly
5962 "unsupported" on a window-system (because of missing fonts). */
5963 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5964 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5965 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
5966 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
5967 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
5968 || !UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
]))
5971 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
5973 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
5975 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
5977 face
= FACE_FROM_ID (f
, lookup_face (f
, merged_attrs
, 0, 0));
5980 error ("Cannot make face");
5982 /* If the font is the same, then not supported. */
5983 if (face
->font
== def_face
->font
)
5987 /* Everything checks out, this face is supported. */
5991 #endif /* HAVE_WINDOW_SYSTEM */
5993 /* Return non-zero if all the face attributes in ATTRS are supported
5996 The definition of `supported' is somewhat heuristic, but basically means
5997 that a face containing all the attributes in ATTRS, when merged
5998 with the default face for display, can be represented in a way that's
6000 \(1) different in appearance than the default face, and
6001 \(2) `close in spirit' to what the attributes specify, if not exact.
6003 Point (2) implies that a `:weight black' attribute will be satisfied
6004 by any terminal that can display bold, and a `:foreground "yellow"' as
6005 long as the terminal can display a yellowish color, but `:slant italic'
6006 will _not_ be satisfied by the tty display code's automatic
6007 substitution of a `dim' face for italic. */
6010 tty_supports_face_attributes_p (f
, attrs
, def_face
)
6013 struct face
*def_face
;
6016 Lisp_Object val
, fg
, bg
;
6017 XColor fg_tty_color
, fg_std_color
;
6018 XColor bg_tty_color
, bg_std_color
;
6019 unsigned test_caps
= 0;
6020 Lisp_Object
*def_attrs
= def_face
->lface
;
6023 /* First check some easy-to-check stuff; ttys support none of the
6024 following attributes, so we can just return false if any are requested
6025 (even if `nominal' values are specified, we should still return false,
6026 as that will be the same value that the default face uses). We
6027 consider :slant unsupportable on ttys, even though the face code
6028 actually `fakes' them using a dim attribute if possible. This is
6029 because the faked result is too different from what the face
6031 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
6032 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
6033 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
6034 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
6035 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
6036 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
6037 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
6038 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
6042 /* Test for terminal `capabilities' (non-color character attributes). */
6044 /* font weight (bold/dim) */
6045 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6048 int def_weight
= face_numeric_weight (def_attrs
[LFACE_WEIGHT_INDEX
]);
6050 if (weight
> XLFD_WEIGHT_MEDIUM
)
6052 if (def_weight
> XLFD_WEIGHT_MEDIUM
)
6053 return 0; /* same as default */
6054 test_caps
= TTY_CAP_BOLD
;
6056 else if (weight
< XLFD_WEIGHT_MEDIUM
)
6058 if (def_weight
< XLFD_WEIGHT_MEDIUM
)
6059 return 0; /* same as default */
6060 test_caps
= TTY_CAP_DIM
;
6062 else if (def_weight
== XLFD_WEIGHT_MEDIUM
)
6063 return 0; /* same as default */
6067 val
= attrs
[LFACE_UNDERLINE_INDEX
];
6068 if (!UNSPECIFIEDP (val
))
6071 return 0; /* ttys can't use colored underlines */
6072 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6073 return 0; /* same as default */
6075 test_caps
|= TTY_CAP_UNDERLINE
;
6079 val
= attrs
[LFACE_INVERSE_INDEX
];
6080 if (!UNSPECIFIEDP (val
))
6082 if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6083 return 0; /* same as default */
6085 test_caps
|= TTY_CAP_INVERSE
;
6089 /* Color testing. */
6091 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
6092 we use them when calling `tty_capable_p' below, even if the face
6093 specifies no colors. */
6094 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6095 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6097 /* Check if foreground color is close enough. */
6098 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
6101 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6103 if (face_attr_equal_p (fg
, def_fg
))
6104 return 0; /* same as default */
6105 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
6106 return 0; /* not a valid color */
6107 else if (color_distance (&fg_tty_color
, &fg_std_color
)
6108 > TTY_SAME_COLOR_THRESHOLD
)
6109 return 0; /* displayed color is too different */
6111 /* Make sure the color is really different than the default. */
6113 XColor def_fg_color
;
6114 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
6115 && (color_distance (&fg_tty_color
, &def_fg_color
)
6116 <= TTY_SAME_COLOR_THRESHOLD
))
6121 /* Check if background color is close enough. */
6122 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
6125 Lisp_Object def_bg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6127 if (face_attr_equal_p (bg
, def_bg
))
6128 return 0; /* same as default */
6129 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
6130 return 0; /* not a valid color */
6131 else if (color_distance (&bg_tty_color
, &bg_std_color
)
6132 > TTY_SAME_COLOR_THRESHOLD
)
6133 return 0; /* displayed color is too different */
6135 /* Make sure the color is really different than the default. */
6137 XColor def_bg_color
;
6138 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
6139 && (color_distance (&bg_tty_color
, &def_bg_color
)
6140 <= TTY_SAME_COLOR_THRESHOLD
))
6145 /* If both foreground and background are requested, see if the
6146 distance between them is OK. We just check to see if the distance
6147 between the tty's foreground and background is close enough to the
6148 distance between the standard foreground and background. */
6149 if (STRINGP (fg
) && STRINGP (bg
))
6152 = (color_distance (&fg_std_color
, &bg_std_color
)
6153 - color_distance (&fg_tty_color
, &bg_tty_color
));
6154 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
6155 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
6160 /* See if the capabilities we selected above are supported, with the
6162 if (test_caps
!= 0 &&
6163 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
6167 /* Hmmm, everything checks out, this terminal must support this face. */
6172 DEFUN ("display-supports-face-attributes-p",
6173 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
6175 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6176 The optional argument DISPLAY can be a display name, a frame, or
6177 nil (meaning the selected frame's display).
6179 The definition of `supported' is somewhat heuristic, but basically means
6180 that a face containing all the attributes in ATTRIBUTES, when merged
6181 with the default face for display, can be represented in a way that's
6183 \(1) different in appearance than the default face, and
6184 \(2) `close in spirit' to what the attributes specify, if not exact.
6186 Point (2) implies that a `:weight black' attribute will be satisfied by
6187 any display that can display bold, and a `:foreground \"yellow\"' as long
6188 as it can display a yellowish color, but `:slant italic' will _not_ be
6189 satisfied by the tty display code's automatic substitution of a `dim'
6190 face for italic. */)
6191 (attributes
, display
)
6192 Lisp_Object attributes
, display
;
6197 struct face
*def_face
;
6198 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6200 if (noninteractive
|| !initialized
)
6201 /* We may not be able to access low-level face information in batch
6202 mode, or before being dumped, and this function is not going to
6203 be very useful in those cases anyway, so just give up. */
6207 frame
= selected_frame
;
6208 else if (FRAMEP (display
))
6212 /* Find any frame on DISPLAY. */
6213 Lisp_Object fl_tail
;
6216 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
6218 frame
= XCAR (fl_tail
);
6219 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
6220 XFRAME (frame
)->param_alist
)),
6226 CHECK_LIVE_FRAME (frame
);
6229 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
6230 attrs
[i
] = Qunspecified
;
6231 merge_face_ref (f
, attributes
, attrs
, 1, 0);
6233 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6234 if (def_face
== NULL
)
6236 if (! realize_basic_faces (f
))
6237 error ("Cannot realize default face");
6238 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6241 /* Dispatch to the appropriate handler. */
6242 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6243 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
6244 #ifdef HAVE_WINDOW_SYSTEM
6246 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
6249 return supports
? Qt
: Qnil
;
6253 /***********************************************************************
6255 ***********************************************************************/
6257 DEFUN ("internal-set-font-selection-order",
6258 Finternal_set_font_selection_order
,
6259 Sinternal_set_font_selection_order
, 1, 1, 0,
6260 doc
: /* Set font selection order for face font selection to ORDER.
6261 ORDER must be a list of length 4 containing the symbols `:width',
6262 `:height', `:weight', and `:slant'. Face attributes appearing
6263 first in ORDER are matched first, e.g. if `:height' appears before
6264 `:weight' in ORDER, font selection first tries to find a font with
6265 a suitable height, and then tries to match the font weight.
6272 int indices
[DIM (font_sort_order
)];
6275 bzero (indices
, sizeof indices
);
6279 CONSP (list
) && i
< DIM (indices
);
6280 list
= XCDR (list
), ++i
)
6282 Lisp_Object attr
= XCAR (list
);
6285 if (EQ (attr
, QCwidth
))
6287 else if (EQ (attr
, QCheight
))
6288 xlfd
= XLFD_POINT_SIZE
;
6289 else if (EQ (attr
, QCweight
))
6291 else if (EQ (attr
, QCslant
))
6296 if (indices
[i
] != 0)
6301 if (!NILP (list
) || i
!= DIM (indices
))
6302 signal_error ("Invalid font sort order", order
);
6303 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6304 if (indices
[i
] == 0)
6305 signal_error ("Invalid font sort order", order
);
6307 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6309 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6310 free_all_realized_faces (Qnil
);
6317 DEFUN ("internal-set-alternative-font-family-alist",
6318 Finternal_set_alternative_font_family_alist
,
6319 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6320 doc
: /* Define alternative font families to try in face font selection.
6321 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6322 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6323 be found. Value is ALIST. */)
6328 Vface_alternative_font_family_alist
= alist
;
6329 free_all_realized_faces (Qnil
);
6334 DEFUN ("internal-set-alternative-font-registry-alist",
6335 Finternal_set_alternative_font_registry_alist
,
6336 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6337 doc
: /* Define alternative font registries to try in face font selection.
6338 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6339 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6340 be found. Value is ALIST. */)
6345 Vface_alternative_font_registry_alist
= alist
;
6346 free_all_realized_faces (Qnil
);
6351 #ifdef HAVE_WINDOW_SYSTEM
6353 /* Value is non-zero if FONT is the name of a scalable font. The
6354 X11R6 XLFD spec says that point size, pixel size, and average width
6355 are zero for scalable fonts. Intlfonts contain at least one
6356 scalable font ("*-muleindian-1") for which this isn't true, so we
6357 just test average width. */
6360 font_scalable_p (font
)
6361 struct font_name
*font
;
6363 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6364 return (*s
== '0' && *(s
+ 1) == '\0')
6366 /* Windows implementation of XLFD is slightly broken for backward
6367 compatibility with previous broken versions, so test for
6368 wildcards as well as 0. */
6375 /* Ignore the difference of font point size less than this value. */
6377 #define FONT_POINT_SIZE_QUANTUM 5
6379 /* Value is non-zero if FONT1 is a better match for font attributes
6380 VALUES than FONT2. VALUES is an array of face attribute values in
6381 font sort order. COMPARE_PT_P zero means don't compare point
6382 sizes. AVGWIDTH, if not zero, is a specified font average width
6386 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6388 struct font_name
*font1
, *font2
;
6389 int compare_pt_p
, avgwidth
;
6393 /* Any font is better than no font. */
6399 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6401 int xlfd_idx
= font_sort_order
[i
];
6403 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6407 if (xlfd_idx
== XLFD_POINT_SIZE
)
6409 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6410 / font1
->rescale_ratio
));
6411 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6412 / font2
->rescale_ratio
));
6413 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6418 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6419 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6422 if (delta1
> delta2
)
6424 else if (delta1
< delta2
)
6428 /* The difference may be equal because, e.g., the face
6429 specifies `italic' but we have only `regular' and
6430 `oblique'. Prefer `oblique' in this case. */
6431 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6432 && font1
->numeric
[xlfd_idx
] > values
[i
]
6433 && font2
->numeric
[xlfd_idx
] < values
[i
])
6441 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6442 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6443 if (delta1
> delta2
)
6445 else if (delta1
< delta2
)
6451 /* We prefer a real scalable font; i.e. not what autoscaled. */
6452 int auto_scaled_1
= (font1
->numeric
[XLFD_POINT_SIZE
] == 0
6453 && font1
->numeric
[XLFD_RESY
] > 0);
6454 int auto_scaled_2
= (font2
->numeric
[XLFD_POINT_SIZE
] == 0
6455 && font2
->numeric
[XLFD_RESY
] > 0);
6457 if (auto_scaled_1
!= auto_scaled_2
)
6458 return auto_scaled_2
;
6461 return font1
->registry_priority
< font2
->registry_priority
;
6465 /* Value is non-zero if FONT is an exact match for face attributes in
6466 SPECIFIED. SPECIFIED is an array of face attribute values in font
6467 sort order. AVGWIDTH, if non-zero, is an average width to compare
6471 exact_face_match_p (specified
, font
, avgwidth
)
6473 struct font_name
*font
;
6478 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6479 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6482 return (i
== DIM (font_sort_order
)
6484 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6488 /* Value is the name of a scaled font, generated from scalable font
6489 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6490 Value is allocated from heap. */
6493 build_scalable_font_name (f
, font
, specified_pt
)
6495 struct font_name
*font
;
6498 char pixel_size
[20];
6500 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6503 /* If scalable font is for a specific resolution, compute
6504 the point size we must specify from the resolution of
6505 the display and the specified resolution of the font. */
6506 if (font
->numeric
[XLFD_RESY
] != 0)
6508 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6509 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6514 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6516 /* We may need a font of the different size. */
6517 pixel_value
*= font
->rescale_ratio
;
6519 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6520 font of the specified PIXEL_SIZE. */
6522 { /* Set point size of the font. */
6523 char point_size
[20];
6524 sprintf (point_size
, "%d", (int) pt
);
6525 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6526 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6530 /* Set pixel size. */
6531 sprintf (pixel_size
, "%d", pixel_value
);
6532 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6533 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6535 /* If font doesn't specify its resolution, use the
6536 resolution of the display. */
6537 if (font
->numeric
[XLFD_RESY
] == 0)
6540 sprintf (buffer
, "%d", (int) resy
);
6541 font
->fields
[XLFD_RESY
] = buffer
;
6542 font
->numeric
[XLFD_RESY
] = resy
;
6545 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6548 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6549 sprintf (buffer
, "%d", resx
);
6550 font
->fields
[XLFD_RESX
] = buffer
;
6551 font
->numeric
[XLFD_RESX
] = resx
;
6554 return build_font_name (font
);
6558 /* Value is non-zero if we are allowed to use scalable font FONT. We
6559 can't run a Lisp function here since this function may be called
6560 with input blocked. */
6563 may_use_scalable_font_p (font
)
6566 if (EQ (Vscalable_fonts_allowed
, Qt
))
6568 else if (CONSP (Vscalable_fonts_allowed
))
6570 Lisp_Object tail
, regexp
;
6572 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6574 regexp
= XCAR (tail
);
6575 if (STRINGP (regexp
)
6576 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6586 /* Return the name of the best matching font for face attributes ATTRS
6587 in the array of font_name structures FONTS which contains NFONTS
6588 elements. WIDTH_RATIO is a factor with which to multiply average
6589 widths if ATTRS specifies such a width.
6591 Value is a font name which is allocated from the heap. FONTS is
6592 freed by this function.
6594 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6595 indicate whether the resulting font should be drawn using overstrike
6596 to simulate bold-face. */
6599 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6602 struct font_name
*fonts
;
6605 int *needs_overstrike
;
6608 struct font_name
*best
;
6611 int exact_p
, avgwidth
;
6616 /* Make specified font attributes available in `specified',
6617 indexed by sort order. */
6618 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6620 int xlfd_idx
= font_sort_order
[i
];
6622 if (xlfd_idx
== XLFD_SWIDTH
)
6623 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6624 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6625 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6626 else if (xlfd_idx
== XLFD_WEIGHT
)
6627 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6628 else if (xlfd_idx
== XLFD_SLANT
)
6629 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6634 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6636 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6640 if (needs_overstrike
)
6641 *needs_overstrike
= 0;
6645 /* Find the best match among the non-scalable fonts. */
6646 for (i
= 0; i
< nfonts
; ++i
)
6647 if (!font_scalable_p (fonts
+ i
)
6648 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6652 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6657 /* Unless we found an exact match among non-scalable fonts, see if
6658 we can find a better match among scalable fonts. */
6661 /* A scalable font is better if
6663 1. its weight, slant, swidth attributes are better, or.
6665 2. the best non-scalable font doesn't have the required
6666 point size, and the scalable fonts weight, slant, swidth
6669 int non_scalable_has_exact_height_p
;
6671 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6672 non_scalable_has_exact_height_p
= 1;
6674 non_scalable_has_exact_height_p
= 0;
6676 for (i
= 0; i
< nfonts
; ++i
)
6677 if (font_scalable_p (fonts
+ i
))
6679 if (better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6680 || (!non_scalable_has_exact_height_p
6681 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6683 non_scalable_has_exact_height_p
= 1;
6689 /* We should have found SOME font. */
6693 if (! exact_p
&& needs_overstrike
)
6695 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6696 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6698 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6700 /* We want a bold font, but didn't get one; try to use
6701 overstriking instead to simulate bold-face. However,
6702 don't overstrike an already-bold fontn unless the
6703 desired weight grossly exceeds the available weight. */
6704 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6705 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6707 *needs_overstrike
= 1;
6711 if (font_scalable_p (best
))
6712 font_name
= build_scalable_font_name (f
, best
, pt
);
6714 font_name
= build_font_name (best
);
6716 /* Free font_name structures. */
6717 free_font_names (fonts
, nfonts
);
6723 /* Get a list of matching fonts on frame F, considering FAMILY
6724 and alternative font families from Vface_alternative_font_registry_alist.
6726 FAMILY is the font family whose alternatives are considered.
6728 REGISTRY, if a string, specifies a font registry and encoding to
6729 match. A value of nil means include fonts of any registry and
6732 Return in *FONTS a pointer to a vector of font_name structures for
6733 the fonts matched. Value is the number of fonts found. */
6736 try_alternative_families (f
, family
, registry
, fonts
)
6738 Lisp_Object family
, registry
;
6739 struct font_name
**fonts
;
6744 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6747 /* Try alternative font families. */
6748 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6751 for (alter
= XCDR (alter
);
6752 CONSP (alter
) && nfonts
== 0;
6753 alter
= XCDR (alter
))
6755 if (STRINGP (XCAR (alter
)))
6756 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6760 /* Try all scalable fonts before giving up. */
6761 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6763 int count
= SPECPDL_INDEX ();
6764 specbind (Qscalable_fonts_allowed
, Qt
);
6765 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6766 unbind_to (count
, Qnil
);
6773 /* Get a list of matching fonts on frame F.
6775 FAMILY, if a string, specifies a font family derived from the fontset.
6776 It is only used if the face does not specify any family in ATTRS or
6777 if we cannot find any font of the face's family.
6779 REGISTRY, if a string, specifies a font registry and encoding to
6780 match. A value of nil means include fonts of any registry and
6783 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6784 Otherwise, prefer FAMILY.
6786 Return in *FONTS a pointer to a vector of font_name structures for
6787 the fonts matched. Value is the number of fonts found. */
6790 try_font_list (f
, attrs
, family
, registry
, fonts
, prefer_face_family
)
6793 Lisp_Object family
, registry
;
6794 struct font_name
**fonts
;
6795 int prefer_face_family
;
6798 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6799 Lisp_Object try_family
;
6801 try_family
= (prefer_face_family
|| NILP (family
)) ? face_family
: family
;
6803 if (STRINGP (try_family
))
6804 nfonts
= try_alternative_families (f
, try_family
, registry
, fonts
);
6807 if (nfonts
== 0 && STRINGP (try_family
) && STRINGP (registry
))
6809 if (xstricmp (SDATA (registry
), "mac-roman") == 0)
6810 /* When realizing the default face and a font spec does not
6811 matched exactly, Emacs looks for ones with the same registry
6812 as the default font. On the Mac, this is mac-roman, which
6813 does not work if the family is -etl-fixed, e.g. The
6814 following widens the choices and fixes that problem. */
6815 nfonts
= try_alternative_families (f
, try_family
, Qnil
, fonts
);
6816 else if (SBYTES (try_family
) > 0
6817 && SREF (try_family
, SBYTES (try_family
) - 1) != '*')
6818 /* Some Central European/Cyrillic font family names have the
6819 Roman counterpart name as their prefix. */
6820 nfonts
= try_alternative_families (f
, concat2 (try_family
,
6821 build_string ("*")),
6826 if (EQ (try_family
, family
))
6827 family
= face_family
;
6829 if (nfonts
== 0 && STRINGP (family
))
6830 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6832 /* Try font family of the default face or "fixed". */
6835 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6837 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6839 family
= build_string ("fixed");
6840 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6843 /* Try any family with the given registry. */
6845 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6851 /* Return the fontset id of the base fontset name or alias name given
6852 by the fontset attribute of ATTRS. Value is -1 if the fontset
6853 attribute of ATTRS doesn't name a fontset. */
6856 face_fontset (attrs
)
6861 name
= attrs
[LFACE_FONT_INDEX
];
6862 if (!STRINGP (name
))
6864 return fs_query_fontset (name
, 0);
6868 /* Choose a name of font to use on frame F to display character C with
6869 Lisp face attributes specified by ATTRS. The font name is
6870 determined by the font-related attributes in ATTRS and the name
6871 pattern for C in FONTSET. Value is the font name which is
6872 allocated from the heap and must be freed by the caller, or NULL if
6873 we can get no information about the font name of C. It is assured
6874 that we always get some information for a single byte
6877 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6878 indicate whether the resulting font should be drawn using overstrike
6879 to simulate bold-face. */
6882 choose_face_font (f
, attrs
, fontset
, c
, needs_overstrike
)
6886 int *needs_overstrike
;
6888 Lisp_Object pattern
;
6889 char *font_name
= NULL
;
6890 struct font_name
*fonts
;
6891 int nfonts
, width_ratio
;
6893 if (needs_overstrike
)
6894 *needs_overstrike
= 0;
6896 /* Get (foundry and) family name and registry (and encoding) name of
6898 pattern
= fontset_font_pattern (f
, fontset
, c
);
6901 xassert (!SINGLE_BYTE_CHAR_P (c
));
6905 /* If what we got is a name pattern, return it. */
6906 if (STRINGP (pattern
))
6907 return xstrdup (SDATA (pattern
));
6909 /* Get a list of fonts matching that pattern and choose the
6910 best match for the specified face attributes from it. */
6911 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
,
6912 (SINGLE_BYTE_CHAR_P (c
)
6913 || CHAR_CHARSET (c
) == charset_latin_iso8859_1
));
6914 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6916 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6917 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
,
6922 #endif /* HAVE_WINDOW_SYSTEM */
6926 /***********************************************************************
6928 ***********************************************************************/
6930 /* Realize basic faces on frame F. Value is zero if frame parameters
6931 of F don't contain enough information needed to realize the default
6935 realize_basic_faces (f
)
6939 int count
= SPECPDL_INDEX ();
6941 /* Block input here so that we won't be surprised by an X expose
6942 event, for instance, without having the faces set up. */
6944 specbind (Qscalable_fonts_allowed
, Qt
);
6946 if (realize_default_face (f
))
6948 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6949 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6950 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6951 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6952 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6953 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6954 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6955 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6956 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6957 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6958 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
6960 /* Reflect changes in the `menu' face in menu bars. */
6961 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6963 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6964 #ifdef USE_X_TOOLKIT
6965 x_update_menu_appearance (f
);
6972 unbind_to (count
, Qnil
);
6978 /* Realize the default face on frame F. If the face is not fully
6979 specified, make it fully-specified. Attributes of the default face
6980 that are not explicitly specified are taken from frame parameters. */
6983 realize_default_face (f
)
6986 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6988 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6989 Lisp_Object frame_font
;
6992 /* If the `default' face is not yet known, create it. */
6993 lface
= lface_from_face_name (f
, Qdefault
, 0);
6997 XSETFRAME (frame
, f
);
6998 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
7002 #ifdef HAVE_WINDOW_SYSTEM
7003 if (FRAME_WINDOW_P (f
))
7005 /* Set frame_font to the value of the `font' frame parameter. */
7006 frame_font
= Fassq (Qfont
, f
->param_alist
);
7007 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
7008 frame_font
= XCDR (frame_font
);
7009 set_lface_from_font_name (f
, lface
, frame_font
,
7010 f
->default_face_done_p
, 1);
7011 f
->default_face_done_p
= 1;
7013 #endif /* HAVE_WINDOW_SYSTEM */
7015 if (!FRAME_WINDOW_P (f
))
7017 LFACE_FAMILY (lface
) = build_string ("default");
7018 LFACE_SWIDTH (lface
) = Qnormal
;
7019 LFACE_HEIGHT (lface
) = make_number (1);
7020 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
7021 LFACE_WEIGHT (lface
) = Qnormal
;
7022 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
7023 LFACE_SLANT (lface
) = Qnormal
;
7024 LFACE_AVGWIDTH (lface
) = Qunspecified
;
7027 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
7028 LFACE_UNDERLINE (lface
) = Qnil
;
7030 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
7031 LFACE_OVERLINE (lface
) = Qnil
;
7033 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
7034 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
7036 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
7037 LFACE_BOX (lface
) = Qnil
;
7039 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
7040 LFACE_INVERSE (lface
) = Qnil
;
7042 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
7044 /* This function is called so early that colors are not yet
7045 set in the frame parameter list. */
7046 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
7048 if (CONSP (color
) && STRINGP (XCDR (color
)))
7049 LFACE_FOREGROUND (lface
) = XCDR (color
);
7050 else if (FRAME_WINDOW_P (f
))
7052 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7053 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
7058 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
7060 /* This function is called so early that colors are not yet
7061 set in the frame parameter list. */
7062 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
7063 if (CONSP (color
) && STRINGP (XCDR (color
)))
7064 LFACE_BACKGROUND (lface
) = XCDR (color
);
7065 else if (FRAME_WINDOW_P (f
))
7067 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7068 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
7073 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
7074 LFACE_STIPPLE (lface
) = Qnil
;
7076 /* Realize the face; it must be fully-specified now. */
7077 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
7078 check_lface (lface
);
7079 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
7080 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
7082 #ifdef HAVE_WINDOW_SYSTEM
7083 #ifdef HAVE_X_WINDOWS
7084 if (face
->font
!= FRAME_FONT (f
))
7085 /* As the font specified for the frame was not acceptable as a
7086 font for the default face (perhaps because auto-scaled fonts
7087 are rejected), we must adjust the frame font. */
7088 x_set_font (f
, build_string (face
->font_name
), Qnil
);
7089 #endif /* HAVE_X_WINDOWS */
7090 #endif /* HAVE_WINDOW_SYSTEM */
7095 /* Realize basic faces other than the default face in face cache C.
7096 SYMBOL is the face name, ID is the face id the realized face must
7097 have. The default face must have been realized already. */
7100 realize_named_face (f
, symbol
, id
)
7105 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7106 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
7107 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7108 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
7109 struct face
*new_face
;
7111 /* The default face must exist and be fully specified. */
7112 get_lface_attributes (f
, Qdefault
, attrs
, 1);
7113 check_lface_attrs (attrs
);
7114 xassert (lface_fully_specified_p (attrs
));
7116 /* If SYMBOL isn't know as a face, create it. */
7120 XSETFRAME (frame
, f
);
7121 lface
= Finternal_make_lisp_face (symbol
, frame
);
7124 /* Merge SYMBOL's face with the default face. */
7125 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
7126 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
7128 /* Realize the face. */
7129 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
7133 /* Realize the fully-specified face with attributes ATTRS in face
7134 cache CACHE for character C. If C is a multibyte character,
7135 BASE_FACE is a face that has the same attributes. Otherwise,
7136 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
7137 ID of face to remove before caching the new face. Value is a
7138 pointer to the newly created realized face. */
7140 static struct face
*
7141 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
7142 struct face_cache
*cache
;
7145 struct face
*base_face
;
7150 /* LFACE must be fully specified. */
7151 xassert (cache
!= NULL
);
7152 check_lface_attrs (attrs
);
7154 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
7156 /* Remove the former face. */
7157 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
7158 uncache_face (cache
, former_face
);
7159 free_realized_face (cache
->f
, former_face
);
7162 if (FRAME_WINDOW_P (cache
->f
))
7163 face
= realize_x_face (cache
, attrs
, c
, base_face
);
7164 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
7165 face
= realize_tty_face (cache
, attrs
, c
);
7169 /* Insert the new face. */
7170 cache_face (cache
, face
, lface_hash (attrs
));
7171 #ifdef HAVE_WINDOW_SYSTEM
7172 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
7173 load_face_font (cache
->f
, face
, c
);
7174 #endif /* HAVE_WINDOW_SYSTEM */
7179 /* Realize the fully-specified face with attributes ATTRS in face
7180 cache CACHE for character C. Do it for X frame CACHE->f. If C is
7181 a multibyte character, BASE_FACE is a face that has the same
7182 attributes. Otherwise, BASE_FACE is ignored. If the new face
7183 doesn't share font with the default face, a fontname is allocated
7184 from the heap and set in `font_name' of the new face, but it is not
7185 yet loaded here. Value is a pointer to the newly created realized
7188 static struct face
*
7189 realize_x_face (cache
, attrs
, c
, base_face
)
7190 struct face_cache
*cache
;
7193 struct face
*base_face
;
7195 struct face
*face
= NULL
;
7196 #ifdef HAVE_WINDOW_SYSTEM
7197 struct face
*default_face
;
7199 Lisp_Object stipple
, overline
, strike_through
, box
;
7201 xassert (FRAME_WINDOW_P (cache
->f
));
7202 xassert (SINGLE_BYTE_CHAR_P (c
)
7205 /* Allocate a new realized face. */
7206 face
= make_realized_face (attrs
);
7210 /* If C is a multibyte character, we share all face attirbutes with
7211 BASE_FACE including the realized fontset. But, we must load a
7213 if (!SINGLE_BYTE_CHAR_P (c
))
7215 bcopy (base_face
, face
, sizeof *face
);
7218 /* Don't try to free the colors copied bitwise from BASE_FACE. */
7219 face
->colors_copied_bitwise_p
= 1;
7221 /* to force realize_face to load font */
7226 /* Now we are realizing a face for ASCII (and unibyte) characters. */
7228 /* Determine the font to use. Most of the time, the font will be
7229 the same as the font of the default face, so try that first. */
7230 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7232 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
7233 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
7235 face
->font
= default_face
->font
;
7236 face
->fontset
= default_face
->fontset
;
7237 face
->font_info_id
= default_face
->font_info_id
;
7238 face
->font_name
= default_face
->font_name
;
7239 face
->ascii_face
= face
;
7241 /* But, as we can't share the fontset, make a new realized
7242 fontset that has the same base fontset as of the default
7245 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
7249 /* If the face attribute ATTRS specifies a fontset, use it as
7250 the base of a new realized fontset. Otherwise, use the same
7251 base fontset as of the default face. The base determines
7252 registry and encoding of a font. It may also determine
7253 foundry and family. The other fields of font name pattern
7254 are constructed from ATTRS. */
7255 int fontset
= face_fontset (attrs
);
7257 if ((fontset
== -1) && default_face
)
7258 fontset
= default_face
->fontset
;
7259 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
7260 face
->font
= NULL
; /* to force realize_face to load font */
7263 /* Load colors, and set remaining attributes. */
7265 load_face_colors (f
, face
, attrs
);
7268 box
= attrs
[LFACE_BOX_INDEX
];
7271 /* A simple box of line width 1 drawn in color given by
7273 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7275 face
->box
= FACE_SIMPLE_BOX
;
7276 face
->box_line_width
= 1;
7278 else if (INTEGERP (box
))
7280 /* Simple box of specified line width in foreground color of the
7282 xassert (XINT (box
) != 0);
7283 face
->box
= FACE_SIMPLE_BOX
;
7284 face
->box_line_width
= XINT (box
);
7285 face
->box_color
= face
->foreground
;
7286 face
->box_color_defaulted_p
= 1;
7288 else if (CONSP (box
))
7290 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7291 being one of `raised' or `sunken'. */
7292 face
->box
= FACE_SIMPLE_BOX
;
7293 face
->box_color
= face
->foreground
;
7294 face
->box_color_defaulted_p
= 1;
7295 face
->box_line_width
= 1;
7299 Lisp_Object keyword
, value
;
7301 keyword
= XCAR (box
);
7309 if (EQ (keyword
, QCline_width
))
7311 if (INTEGERP (value
) && XINT (value
) != 0)
7312 face
->box_line_width
= XINT (value
);
7314 else if (EQ (keyword
, QCcolor
))
7316 if (STRINGP (value
))
7318 face
->box_color
= load_color (f
, face
, value
,
7320 face
->use_box_color_for_shadows_p
= 1;
7323 else if (EQ (keyword
, QCstyle
))
7325 if (EQ (value
, Qreleased_button
))
7326 face
->box
= FACE_RAISED_BOX
;
7327 else if (EQ (value
, Qpressed_button
))
7328 face
->box
= FACE_SUNKEN_BOX
;
7333 /* Text underline, overline, strike-through. */
7335 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7337 /* Use default color (same as foreground color). */
7338 face
->underline_p
= 1;
7339 face
->underline_defaulted_p
= 1;
7340 face
->underline_color
= 0;
7342 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7344 /* Use specified color. */
7345 face
->underline_p
= 1;
7346 face
->underline_defaulted_p
= 0;
7347 face
->underline_color
7348 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7349 LFACE_UNDERLINE_INDEX
);
7351 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7353 face
->underline_p
= 0;
7354 face
->underline_defaulted_p
= 0;
7355 face
->underline_color
= 0;
7358 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7359 if (STRINGP (overline
))
7361 face
->overline_color
7362 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7363 LFACE_OVERLINE_INDEX
);
7364 face
->overline_p
= 1;
7366 else if (EQ (overline
, Qt
))
7368 face
->overline_color
= face
->foreground
;
7369 face
->overline_color_defaulted_p
= 1;
7370 face
->overline_p
= 1;
7373 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7374 if (STRINGP (strike_through
))
7376 face
->strike_through_color
7377 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7378 LFACE_STRIKE_THROUGH_INDEX
);
7379 face
->strike_through_p
= 1;
7381 else if (EQ (strike_through
, Qt
))
7383 face
->strike_through_color
= face
->foreground
;
7384 face
->strike_through_color_defaulted_p
= 1;
7385 face
->strike_through_p
= 1;
7388 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7389 if (!NILP (stipple
))
7390 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7392 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
7393 #endif /* HAVE_WINDOW_SYSTEM */
7398 /* Map a specified color of face FACE on frame F to a tty color index.
7399 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7400 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7401 default foreground/background colors. */
7404 map_tty_color (f
, face
, idx
, defaulted
)
7407 enum lface_attribute_index idx
;
7410 Lisp_Object frame
, color
, def
;
7411 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7412 unsigned long default_pixel
, default_other_pixel
, pixel
;
7414 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7418 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7419 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7423 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7424 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7427 XSETFRAME (frame
, f
);
7428 color
= face
->lface
[idx
];
7432 && CONSP (Vtty_defined_color_alist
)
7433 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7436 /* Associations in tty-defined-color-alist are of the form
7437 (NAME INDEX R G B). We need the INDEX part. */
7438 pixel
= XINT (XCAR (XCDR (def
)));
7441 if (pixel
== default_pixel
&& STRINGP (color
))
7443 pixel
= load_color (f
, face
, color
, idx
);
7445 #if defined (MSDOS) || defined (WINDOWSNT)
7446 /* If the foreground of the default face is the default color,
7447 use the foreground color defined by the frame. */
7449 if (FRAME_MSDOS_P (f
))
7452 if (pixel
== default_pixel
7453 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7456 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7458 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7459 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7462 else if (pixel
== default_other_pixel
)
7465 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7467 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7468 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7474 #endif /* MSDOS or WINDOWSNT */
7478 face
->foreground
= pixel
;
7480 face
->background
= pixel
;
7484 /* Realize the fully-specified face with attributes ATTRS in face
7485 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7486 pointer to the newly created realized face. */
7488 static struct face
*
7489 realize_tty_face (cache
, attrs
, c
)
7490 struct face_cache
*cache
;
7496 int face_colors_defaulted
= 0;
7497 struct frame
*f
= cache
->f
;
7499 /* Frame must be a termcap frame. */
7500 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7502 /* Allocate a new realized face. */
7503 face
= make_realized_face (attrs
);
7504 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7506 /* Map face attributes to TTY appearances. We map slant to
7507 dimmed text because we want italic text to appear differently
7508 and because dimmed text is probably used infrequently. */
7509 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7510 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7512 if (weight
> XLFD_WEIGHT_MEDIUM
)
7513 face
->tty_bold_p
= 1;
7514 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7515 face
->tty_dim_p
= 1;
7516 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7517 face
->tty_underline_p
= 1;
7518 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7519 face
->tty_reverse_p
= 1;
7521 /* Map color names to color indices. */
7522 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7523 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7525 /* Swap colors if face is inverse-video. If the colors are taken
7526 from the frame colors, they are already inverted, since the
7527 frame-creation function calls x-handle-reverse-video. */
7528 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7530 unsigned long tem
= face
->foreground
;
7531 face
->foreground
= face
->background
;
7532 face
->background
= tem
;
7535 if (tty_suppress_bold_inverse_default_colors_p
7537 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7538 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7539 face
->tty_bold_p
= 0;
7545 DEFUN ("tty-suppress-bold-inverse-default-colors",
7546 Ftty_suppress_bold_inverse_default_colors
,
7547 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7548 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7549 SUPPRESS non-nil means suppress it.
7550 This affects bold faces on TTYs whose foreground is the default background
7551 color of the display and whose background is the default foreground color.
7552 For such faces, the bold face attribute is ignored if this variable
7555 Lisp_Object suppress
;
7557 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7558 ++face_change_count
;
7564 /***********************************************************************
7566 ***********************************************************************/
7568 /* Return the ID of the face to use to display character CH with face
7569 property PROP on frame F in current_buffer. */
7572 compute_char_face (f
, ch
, prop
)
7579 if (NILP (current_buffer
->enable_multibyte_characters
))
7584 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7585 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7589 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7590 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7591 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7592 merge_face_ref (f
, prop
, attrs
, 1, 0);
7593 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
7599 /* Return the face ID associated with buffer position POS for
7600 displaying ASCII characters. Return in *ENDPTR the position at
7601 which a different face is needed, as far as text properties and
7602 overlays are concerned. W is a window displaying current_buffer.
7604 REGION_BEG, REGION_END delimit the region, so it can be
7607 LIMIT is a position not to scan beyond. That is to limit the time
7608 this function can take.
7610 If MOUSE is non-zero, use the character's mouse-face, not its face.
7612 The face returned is suitable for displaying ASCII characters. */
7615 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7616 endptr
, limit
, mouse
)
7619 int region_beg
, region_end
;
7624 struct frame
*f
= XFRAME (w
->frame
);
7625 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7626 Lisp_Object prop
, position
;
7628 Lisp_Object
*overlay_vec
;
7631 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7632 Lisp_Object limit1
, end
;
7633 struct face
*default_face
;
7635 /* W must display the current buffer. We could write this function
7636 to use the frame and buffer of W, but right now it doesn't. */
7637 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7639 XSETFRAME (frame
, f
);
7640 XSETFASTINT (position
, pos
);
7643 if (pos
< region_beg
&& region_beg
< endpos
)
7644 endpos
= region_beg
;
7646 /* Get the `face' or `mouse_face' text property at POS, and
7647 determine the next position at which the property changes. */
7648 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7649 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7650 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7652 endpos
= XINT (end
);
7654 /* Look at properties from overlays. */
7658 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
7659 if (next_overlay
< endpos
)
7660 endpos
= next_overlay
;
7665 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7667 /* Optimize common cases where we can use the default face. */
7670 && !(pos
>= region_beg
&& pos
< region_end
))
7671 return DEFAULT_FACE_ID
;
7673 /* Begin with attributes from the default face. */
7674 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7676 /* Merge in attributes specified via text properties. */
7678 merge_face_ref (f
, prop
, attrs
, 1, 0);
7680 /* Now merge the overlay data. */
7681 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7682 for (i
= 0; i
< noverlays
; i
++)
7687 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7689 merge_face_ref (f
, prop
, attrs
, 1, 0);
7691 oend
= OVERLAY_END (overlay_vec
[i
]);
7692 oendpos
= OVERLAY_POSITION (oend
);
7693 if (oendpos
< endpos
)
7697 /* If in the region, merge in the region face. */
7698 if (pos
>= region_beg
&& pos
< region_end
)
7700 merge_named_face (f
, Qregion
, attrs
, 0);
7702 if (region_end
< endpos
)
7703 endpos
= region_end
;
7708 /* Look up a realized face with the given face attributes,
7709 or realize a new one for ASCII characters. */
7710 return lookup_face (f
, attrs
, 0, NULL
);
7714 /* Compute the face at character position POS in Lisp string STRING on
7715 window W, for ASCII characters.
7717 If STRING is an overlay string, it comes from position BUFPOS in
7718 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7719 not an overlay string. W must display the current buffer.
7720 REGION_BEG and REGION_END give the start and end positions of the
7721 region; both are -1 if no region is visible.
7723 BASE_FACE_ID is the id of a face to merge with. For strings coming
7724 from overlays or the `display' property it is the face at BUFPOS.
7726 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7728 Set *ENDPTR to the next position where to check for faces in
7729 STRING; -1 if the face is constant from POS to the end of the
7732 Value is the id of the face to use. The face returned is suitable
7733 for displaying ASCII characters. */
7736 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7737 region_end
, endptr
, base_face_id
, mouse_p
)
7741 int region_beg
, region_end
;
7743 enum face_id base_face_id
;
7746 Lisp_Object prop
, position
, end
, limit
;
7747 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7748 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7749 struct face
*base_face
;
7750 int multibyte_p
= STRING_MULTIBYTE (string
);
7751 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7753 /* Get the value of the face property at the current position within
7754 STRING. Value is nil if there is no face property. */
7755 XSETFASTINT (position
, pos
);
7756 prop
= Fget_text_property (position
, prop_name
, string
);
7758 /* Get the next position at which to check for faces. Value of end
7759 is nil if face is constant all the way to the end of the string.
7760 Otherwise it is a string position where to check faces next.
7761 Limit is the maximum position up to which to check for property
7762 changes in Fnext_single_property_change. Strings are usually
7763 short, so set the limit to the end of the string. */
7764 XSETFASTINT (limit
, SCHARS (string
));
7765 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7767 *endptr
= XFASTINT (end
);
7771 base_face
= FACE_FROM_ID (f
, base_face_id
);
7772 xassert (base_face
);
7774 /* Optimize the default case that there is no face property and we
7775 are not in the region. */
7777 && (base_face_id
!= DEFAULT_FACE_ID
7778 /* BUFPOS <= 0 means STRING is not an overlay string, so
7779 that the region doesn't have to be taken into account. */
7781 || bufpos
< region_beg
7782 || bufpos
>= region_end
)
7784 /* We can't realize faces for different charsets differently
7785 if we don't have fonts, so we can stop here if not working
7786 on a window-system frame. */
7787 || !FRAME_WINDOW_P (f
)
7788 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7789 return base_face
->id
;
7791 /* Begin with attributes from the base face. */
7792 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7794 /* Merge in attributes specified via text properties. */
7796 merge_face_ref (f
, prop
, attrs
, 1, 0);
7798 /* If in the region, merge in the region face. */
7800 && bufpos
>= region_beg
7801 && bufpos
< region_end
)
7802 merge_named_face (f
, Qregion
, attrs
, 0);
7804 /* Look up a realized face with the given face attributes,
7805 or realize a new one for ASCII characters. */
7806 return lookup_face (f
, attrs
, 0, NULL
);
7810 /* Merge a face into a realized face.
7812 F is frame where faces are (to be) realized.
7814 FACE_NAME is named face to merge.
7816 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
7818 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
7820 BASE_FACE_ID is realized face to merge into.
7826 merge_faces (f
, face_name
, face_id
, base_face_id
)
7828 Lisp_Object face_name
;
7829 int face_id
, base_face_id
;
7831 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7832 struct face
*base_face
;
7834 base_face
= FACE_FROM_ID (f
, base_face_id
);
7836 return base_face_id
;
7838 if (EQ (face_name
, Qt
))
7840 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
7841 return base_face_id
;
7842 face_name
= lface_id_to_name
[face_id
];
7843 face_id
= lookup_derived_face (f
, face_name
, 0, base_face_id
, 1);
7846 return base_face_id
;
7849 /* Begin with attributes from the base face. */
7850 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7852 if (!NILP (face_name
))
7854 if (!merge_named_face (f
, face_name
, attrs
, 0))
7855 return base_face_id
;
7861 return base_face_id
;
7862 face
= FACE_FROM_ID (f
, face_id
);
7864 return base_face_id
;
7865 merge_face_vectors (f
, face
->lface
, attrs
, 0);
7868 /* Look up a realized face with the given face attributes,
7869 or realize a new one for ASCII characters. */
7870 return lookup_face (f
, attrs
, 0, NULL
);
7874 /***********************************************************************
7876 ***********************************************************************/
7880 /* Print the contents of the realized face FACE to stderr. */
7883 dump_realized_face (face
)
7886 fprintf (stderr
, "ID: %d\n", face
->id
);
7887 #ifdef HAVE_X_WINDOWS
7888 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
7890 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7892 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7893 fprintf (stderr
, "background: 0x%lx (%s)\n",
7895 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7896 fprintf (stderr
, "font_name: %s (%s)\n",
7898 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7899 #ifdef HAVE_X_WINDOWS
7900 fprintf (stderr
, "font = %p\n", face
->font
);
7902 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7903 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7904 fprintf (stderr
, "underline: %d (%s)\n",
7906 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7907 fprintf (stderr
, "hash: %d\n", face
->hash
);
7908 fprintf (stderr
, "charset: %d\n", face
->charset
);
7912 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7920 fprintf (stderr
, "font selection order: ");
7921 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7922 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7923 fprintf (stderr
, "\n");
7925 fprintf (stderr
, "alternative fonts: ");
7926 debug_print (Vface_alternative_font_family_alist
);
7927 fprintf (stderr
, "\n");
7929 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7930 Fdump_face (make_number (i
));
7936 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7938 error ("Not a valid face");
7939 dump_realized_face (face
);
7946 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7947 0, 0, 0, doc
: /* */)
7950 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7951 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7952 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7956 #endif /* GLYPH_DEBUG != 0 */
7960 /***********************************************************************
7962 ***********************************************************************/
7967 Qface
= intern ("face");
7969 Qface_no_inherit
= intern ("face-no-inherit");
7970 staticpro (&Qface_no_inherit
);
7971 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7972 staticpro (&Qbitmap_spec_p
);
7973 Qframe_set_background_mode
= intern ("frame-set-background-mode");
7974 staticpro (&Qframe_set_background_mode
);
7976 /* Lisp face attribute keywords. */
7977 QCfamily
= intern (":family");
7978 staticpro (&QCfamily
);
7979 QCheight
= intern (":height");
7980 staticpro (&QCheight
);
7981 QCweight
= intern (":weight");
7982 staticpro (&QCweight
);
7983 QCslant
= intern (":slant");
7984 staticpro (&QCslant
);
7985 QCunderline
= intern (":underline");
7986 staticpro (&QCunderline
);
7987 QCinverse_video
= intern (":inverse-video");
7988 staticpro (&QCinverse_video
);
7989 QCreverse_video
= intern (":reverse-video");
7990 staticpro (&QCreverse_video
);
7991 QCforeground
= intern (":foreground");
7992 staticpro (&QCforeground
);
7993 QCbackground
= intern (":background");
7994 staticpro (&QCbackground
);
7995 QCstipple
= intern (":stipple");;
7996 staticpro (&QCstipple
);
7997 QCwidth
= intern (":width");
7998 staticpro (&QCwidth
);
7999 QCfont
= intern (":font");
8000 staticpro (&QCfont
);
8001 QCbold
= intern (":bold");
8002 staticpro (&QCbold
);
8003 QCitalic
= intern (":italic");
8004 staticpro (&QCitalic
);
8005 QCoverline
= intern (":overline");
8006 staticpro (&QCoverline
);
8007 QCstrike_through
= intern (":strike-through");
8008 staticpro (&QCstrike_through
);
8009 QCbox
= intern (":box");
8011 QCinherit
= intern (":inherit");
8012 staticpro (&QCinherit
);
8014 /* Symbols used for Lisp face attribute values. */
8015 QCcolor
= intern (":color");
8016 staticpro (&QCcolor
);
8017 QCline_width
= intern (":line-width");
8018 staticpro (&QCline_width
);
8019 QCstyle
= intern (":style");
8020 staticpro (&QCstyle
);
8021 Qreleased_button
= intern ("released-button");
8022 staticpro (&Qreleased_button
);
8023 Qpressed_button
= intern ("pressed-button");
8024 staticpro (&Qpressed_button
);
8025 Qnormal
= intern ("normal");
8026 staticpro (&Qnormal
);
8027 Qultra_light
= intern ("ultra-light");
8028 staticpro (&Qultra_light
);
8029 Qextra_light
= intern ("extra-light");
8030 staticpro (&Qextra_light
);
8031 Qlight
= intern ("light");
8032 staticpro (&Qlight
);
8033 Qsemi_light
= intern ("semi-light");
8034 staticpro (&Qsemi_light
);
8035 Qsemi_bold
= intern ("semi-bold");
8036 staticpro (&Qsemi_bold
);
8037 Qbold
= intern ("bold");
8039 Qextra_bold
= intern ("extra-bold");
8040 staticpro (&Qextra_bold
);
8041 Qultra_bold
= intern ("ultra-bold");
8042 staticpro (&Qultra_bold
);
8043 Qoblique
= intern ("oblique");
8044 staticpro (&Qoblique
);
8045 Qitalic
= intern ("italic");
8046 staticpro (&Qitalic
);
8047 Qreverse_oblique
= intern ("reverse-oblique");
8048 staticpro (&Qreverse_oblique
);
8049 Qreverse_italic
= intern ("reverse-italic");
8050 staticpro (&Qreverse_italic
);
8051 Qultra_condensed
= intern ("ultra-condensed");
8052 staticpro (&Qultra_condensed
);
8053 Qextra_condensed
= intern ("extra-condensed");
8054 staticpro (&Qextra_condensed
);
8055 Qcondensed
= intern ("condensed");
8056 staticpro (&Qcondensed
);
8057 Qsemi_condensed
= intern ("semi-condensed");
8058 staticpro (&Qsemi_condensed
);
8059 Qsemi_expanded
= intern ("semi-expanded");
8060 staticpro (&Qsemi_expanded
);
8061 Qexpanded
= intern ("expanded");
8062 staticpro (&Qexpanded
);
8063 Qextra_expanded
= intern ("extra-expanded");
8064 staticpro (&Qextra_expanded
);
8065 Qultra_expanded
= intern ("ultra-expanded");
8066 staticpro (&Qultra_expanded
);
8067 Qbackground_color
= intern ("background-color");
8068 staticpro (&Qbackground_color
);
8069 Qforeground_color
= intern ("foreground-color");
8070 staticpro (&Qforeground_color
);
8071 Qunspecified
= intern ("unspecified");
8072 staticpro (&Qunspecified
);
8073 Qignore_defface
= intern (":ignore-defface");
8074 staticpro (&Qignore_defface
);
8076 Qface_alias
= intern ("face-alias");
8077 staticpro (&Qface_alias
);
8078 Qdefault
= intern ("default");
8079 staticpro (&Qdefault
);
8080 Qtool_bar
= intern ("tool-bar");
8081 staticpro (&Qtool_bar
);
8082 Qregion
= intern ("region");
8083 staticpro (&Qregion
);
8084 Qfringe
= intern ("fringe");
8085 staticpro (&Qfringe
);
8086 Qheader_line
= intern ("header-line");
8087 staticpro (&Qheader_line
);
8088 Qscroll_bar
= intern ("scroll-bar");
8089 staticpro (&Qscroll_bar
);
8090 Qmenu
= intern ("menu");
8092 Qcursor
= intern ("cursor");
8093 staticpro (&Qcursor
);
8094 Qborder
= intern ("border");
8095 staticpro (&Qborder
);
8096 Qmouse
= intern ("mouse");
8097 staticpro (&Qmouse
);
8098 Qmode_line_inactive
= intern ("mode-line-inactive");
8099 staticpro (&Qmode_line_inactive
);
8100 Qvertical_border
= intern ("vertical-border");
8101 staticpro (&Qvertical_border
);
8102 Qtty_color_desc
= intern ("tty-color-desc");
8103 staticpro (&Qtty_color_desc
);
8104 Qtty_color_standard_values
= intern ("tty-color-standard-values");
8105 staticpro (&Qtty_color_standard_values
);
8106 Qtty_color_by_index
= intern ("tty-color-by-index");
8107 staticpro (&Qtty_color_by_index
);
8108 Qtty_color_alist
= intern ("tty-color-alist");
8109 staticpro (&Qtty_color_alist
);
8110 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
8111 staticpro (&Qscalable_fonts_allowed
);
8113 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
8114 staticpro (&Vparam_value_alist
);
8115 Vface_alternative_font_family_alist
= Qnil
;
8116 staticpro (&Vface_alternative_font_family_alist
);
8117 Vface_alternative_font_registry_alist
= Qnil
;
8118 staticpro (&Vface_alternative_font_registry_alist
);
8120 defsubr (&Sinternal_make_lisp_face
);
8121 defsubr (&Sinternal_lisp_face_p
);
8122 defsubr (&Sinternal_set_lisp_face_attribute
);
8123 #ifdef HAVE_WINDOW_SYSTEM
8124 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
8126 defsubr (&Scolor_gray_p
);
8127 defsubr (&Scolor_supported_p
);
8128 defsubr (&Sface_attribute_relative_p
);
8129 defsubr (&Smerge_face_attribute
);
8130 defsubr (&Sinternal_get_lisp_face_attribute
);
8131 defsubr (&Sinternal_lisp_face_attribute_values
);
8132 defsubr (&Sinternal_lisp_face_equal_p
);
8133 defsubr (&Sinternal_lisp_face_empty_p
);
8134 defsubr (&Sinternal_copy_lisp_face
);
8135 defsubr (&Sinternal_merge_in_global_face
);
8136 defsubr (&Sface_font
);
8137 defsubr (&Sframe_face_alist
);
8138 defsubr (&Sdisplay_supports_face_attributes_p
);
8139 defsubr (&Scolor_distance
);
8140 defsubr (&Sinternal_set_font_selection_order
);
8141 defsubr (&Sinternal_set_alternative_font_family_alist
);
8142 defsubr (&Sinternal_set_alternative_font_registry_alist
);
8143 defsubr (&Sface_attributes_as_vector
);
8145 defsubr (&Sdump_face
);
8146 defsubr (&Sshow_face_resources
);
8147 #endif /* GLYPH_DEBUG */
8148 defsubr (&Sclear_face_cache
);
8149 defsubr (&Stty_suppress_bold_inverse_default_colors
);
8151 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
8152 defsubr (&Sdump_colors
);
8155 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
8156 doc
: /* *Limit for font matching.
8157 If an integer > 0, font matching functions won't load more than
8158 that number of fonts when searching for a matching font. */);
8159 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
8161 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
8162 doc
: /* List of global face definitions (for internal use only.) */);
8163 Vface_new_frame_defaults
= Qnil
;
8165 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
8166 doc
: /* *Default stipple pattern used on monochrome displays.
8167 This stipple pattern is used on monochrome displays
8168 instead of shades of gray for a face background color.
8169 See `set-face-stipple' for possible values for this variable. */);
8170 Vface_default_stipple
= build_string ("gray3");
8172 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
8173 doc
: /* An alist of defined terminal colors and their RGB values. */);
8174 Vtty_defined_color_alist
= Qnil
;
8176 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
8177 doc
: /* Allowed scalable fonts.
8178 A value of nil means don't allow any scalable fonts.
8179 A value of t means allow any scalable font.
8180 Otherwise, value must be a list of regular expressions. A font may be
8181 scaled if its name matches a regular expression in the list.
8182 Note that if value is nil, a scalable font might still be used, if no
8183 other font of the appropriate family and registry is available. */);
8184 Vscalable_fonts_allowed
= Qnil
;
8186 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
8187 doc
: /* List of ignored fonts.
8188 Each element is a regular expression that matches names of fonts to
8190 Vface_ignored_fonts
= Qnil
;
8192 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
8193 doc
: /* Alist of fonts vs the rescaling factors.
8194 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
8195 FONT-NAME-PATTERN is a regular expression matching a font name, and
8196 RESCALE-RATIO is a floating point number to specify how much larger
8197 \(or smaller) font we should use. For instance, if a face requests
8198 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
8199 Vface_font_rescale_alist
= Qnil
;
8201 #ifdef HAVE_WINDOW_SYSTEM
8202 defsubr (&Sbitmap_spec_p
);
8203 defsubr (&Sx_list_fonts
);
8204 defsubr (&Sinternal_face_x_get_resource
);
8205 defsubr (&Sx_family_fonts
);
8206 defsubr (&Sx_font_family_list
);
8207 #endif /* HAVE_WINDOW_SYSTEM */
8210 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
8211 (do not change this comment) */