1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 Boston, MA 02110-1301, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font 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 /* Value is the number of elements of VECTOR. */
279 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
281 /* Make a copy of string S on the stack using alloca. Value is a pointer
284 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
286 /* Make a copy of the contents of Lisp string S on the stack using
287 alloca. Value is a pointer to the copy. */
289 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
291 /* Size of hash table of realized faces in face caches (should be a
294 #define FACE_CACHE_BUCKETS_SIZE 1001
296 /* Keyword symbols used for face attribute names. */
298 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
299 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
300 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
301 Lisp_Object QCreverse_video
;
302 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
304 /* Symbols used for attribute values. */
306 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
307 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
308 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
309 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
310 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
311 Lisp_Object Qultra_expanded
;
312 Lisp_Object Qreleased_button
, Qpressed_button
;
313 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
314 Lisp_Object Qunspecified
;
316 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
318 /* The name of the function to call when the background of the frame
319 has changed, frame_set_background_mode. */
321 Lisp_Object Qframe_set_background_mode
;
323 /* Names of basic faces. */
325 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
326 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
327 Lisp_Object Qmode_line_inactive
, Qvertical_border
;
328 extern Lisp_Object Qmode_line
;
330 /* The symbol `face-alias'. A symbols having that property is an
331 alias for another face. Value of the property is the name of
334 Lisp_Object Qface_alias
;
336 extern Lisp_Object Qcircular_list
;
338 /* Default stipple pattern used on monochrome displays. This stipple
339 pattern is used on monochrome displays instead of shades of gray
340 for a face background color. See `set-face-stipple' for possible
341 values for this variable. */
343 Lisp_Object Vface_default_stipple
;
345 /* Alist of alternative font families. Each element is of the form
346 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
347 try FAMILY1, then FAMILY2, ... */
349 Lisp_Object Vface_alternative_font_family_alist
;
351 /* Alist of alternative font registries. Each element is of the form
352 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
353 loaded, try REGISTRY1, then REGISTRY2, ... */
355 Lisp_Object Vface_alternative_font_registry_alist
;
357 /* Allowed scalable fonts. A value of nil means don't allow any
358 scalable fonts. A value of t means allow the use of any scalable
359 font. Otherwise, value must be a list of regular expressions. A
360 font may be scaled if its name matches a regular expression in the
363 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
365 /* List of regular expressions that matches names of fonts to ignore. */
367 Lisp_Object Vface_ignored_fonts
;
369 /* Alist of font name patterns vs the rescaling factor. */
371 Lisp_Object Vface_font_rescale_alist
;
373 /* Maximum number of fonts to consider in font_list. If not an
374 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
376 Lisp_Object Vfont_list_limit
;
377 #define DEFAULT_FONT_LIST_LIMIT 100
379 /* The symbols `foreground-color' and `background-color' which can be
380 used as part of a `face' property. This is for compatibility with
383 Lisp_Object Qforeground_color
, Qbackground_color
;
385 /* The symbols `face' and `mouse-face' used as text properties. */
388 extern Lisp_Object Qmouse_face
;
390 /* Property for basic faces which other faces cannot inherit. */
392 Lisp_Object Qface_no_inherit
;
394 /* Error symbol for wrong_type_argument in load_pixmap. */
396 Lisp_Object Qbitmap_spec_p
;
398 /* Alist of global face definitions. Each element is of the form
399 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
400 is a Lisp vector of face attributes. These faces are used
401 to initialize faces for new frames. */
403 Lisp_Object Vface_new_frame_defaults
;
405 /* The next ID to assign to Lisp faces. */
407 static int next_lface_id
;
409 /* A vector mapping Lisp face Id's to face names. */
411 static Lisp_Object
*lface_id_to_name
;
412 static int lface_id_to_name_size
;
414 /* TTY color-related functions (defined in tty-colors.el). */
416 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
418 /* The name of the function used to compute colors on TTYs. */
420 Lisp_Object Qtty_color_alist
;
422 /* An alist of defined terminal colors and their RGB values. */
424 Lisp_Object Vtty_defined_color_alist
;
426 /* Counter for calls to clear_face_cache. If this counter reaches
427 CLEAR_FONT_TABLE_COUNT, and a frame has more than
428 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
430 static int clear_font_table_count
;
431 #define CLEAR_FONT_TABLE_COUNT 100
432 #define CLEAR_FONT_TABLE_NFONTS 10
434 /* Non-zero means face attributes have been changed since the last
435 redisplay. Used in redisplay_internal. */
437 int face_change_count
;
439 /* Non-zero means don't display bold text if a face's foreground
440 and background colors are the inverse of the default colors of the
441 display. This is a kluge to suppress `bold black' foreground text
442 which is hard to read on an LCD monitor. */
444 int tty_suppress_bold_inverse_default_colors_p
;
446 /* A list of the form `((x . y))' used to avoid consing in
447 Finternal_set_lisp_face_attribute. */
449 static Lisp_Object Vparam_value_alist
;
451 /* The total number of colors currently allocated. */
454 static int ncolors_allocated
;
455 static int npixmaps_allocated
;
459 /* Non-zero means the definition of the `menu' face for new frames has
462 int menu_face_changed_default
;
465 /* Function prototypes. */
469 struct named_merge_point
;
471 static void map_tty_color
P_ ((struct frame
*, struct face
*,
472 enum lface_attribute_index
, int *));
473 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
, int));
474 static int may_use_scalable_font_p
P_ ((const char *));
475 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
476 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
478 static int x_face_list_fonts
P_ ((struct frame
*, char *,
479 struct font_name
**, int, int));
480 static int font_scalable_p
P_ ((struct font_name
*));
481 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
482 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
483 static unsigned char *xstrlwr
P_ ((unsigned char *));
484 static void signal_error
P_ ((char *, Lisp_Object
));
485 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
486 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
487 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
488 static void free_face_colors
P_ ((struct frame
*, struct face
*));
489 static int face_color_gray_p
P_ ((struct frame
*, char *));
490 static char *build_font_name
P_ ((struct font_name
*));
491 static void free_font_names
P_ ((struct font_name
*, int));
492 static int sorted_font_list
P_ ((struct frame
*, char *,
493 int (*cmpfn
) P_ ((const void *, const void *)),
494 struct font_name
**));
495 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
496 Lisp_Object
, struct font_name
**));
497 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
498 Lisp_Object
, struct font_name
**));
499 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
500 Lisp_Object
, Lisp_Object
, struct font_name
**,
502 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
503 Lisp_Object
, struct font_name
**));
504 static int cmp_font_names
P_ ((const void *, const void *));
505 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
506 struct face
*, int));
507 static struct face
*realize_x_face
P_ ((struct face_cache
*,
508 Lisp_Object
*, int, struct face
*));
509 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
510 Lisp_Object
*, int));
511 static int realize_basic_faces
P_ ((struct frame
*));
512 static int realize_default_face
P_ ((struct frame
*));
513 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
514 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
515 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
516 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
517 static unsigned lface_hash
P_ ((Lisp_Object
*));
518 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
519 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
520 static void free_realized_face
P_ ((struct frame
*, struct face
*));
521 static void clear_face_gcs
P_ ((struct face_cache
*));
522 static void free_face_cache
P_ ((struct face_cache
*));
523 static int face_numeric_weight
P_ ((Lisp_Object
));
524 static int face_numeric_slant
P_ ((Lisp_Object
));
525 static int face_numeric_swidth
P_ ((Lisp_Object
));
526 static int face_fontset
P_ ((Lisp_Object
*));
527 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int, int*));
528 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
529 struct named_merge_point
*));
530 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
531 int, struct named_merge_point
*));
532 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
533 Lisp_Object
, int, int));
534 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
535 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
536 static void free_realized_faces
P_ ((struct face_cache
*));
537 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
538 struct font_name
*, int, int, int *));
539 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
540 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
541 static int xlfd_numeric_slant
P_ ((struct font_name
*));
542 static int xlfd_numeric_weight
P_ ((struct font_name
*));
543 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
544 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
545 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
546 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
547 static int xlfd_fixed_p
P_ ((struct font_name
*));
548 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
550 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
551 struct font_name
*, int,
553 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
554 struct font_name
*, int));
556 #ifdef HAVE_WINDOW_SYSTEM
558 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
559 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
560 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
561 int (*cmpfn
) P_ ((const void *, const void *))));
562 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
563 static void x_free_gc
P_ ((struct frame
*, GC
));
564 static void clear_font_table
P_ ((struct x_display_info
*));
567 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
568 #endif /* WINDOWSNT */
571 static void x_update_menu_appearance
P_ ((struct frame
*));
573 extern void free_frame_menubar
P_ ((struct frame
*));
574 #endif /* USE_X_TOOLKIT */
576 #endif /* HAVE_WINDOW_SYSTEM */
579 /***********************************************************************
581 ***********************************************************************/
583 #ifdef HAVE_X_WINDOWS
585 #ifdef DEBUG_X_COLORS
587 /* The following is a poor mans infrastructure for debugging X color
588 allocation problems on displays with PseudoColor-8. Some X servers
589 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
590 color reference counts completely so that they don't signal an
591 error when a color is freed whose reference count is already 0.
592 Other X servers do. To help me debug this, the following code
593 implements a simple reference counting schema of its own, for a
594 single display/screen. --gerd. */
596 /* Reference counts for pixel colors. */
598 int color_count
[256];
600 /* Register color PIXEL as allocated. */
603 register_color (pixel
)
606 xassert (pixel
< 256);
607 ++color_count
[pixel
];
611 /* Register color PIXEL as deallocated. */
614 unregister_color (pixel
)
617 xassert (pixel
< 256);
618 if (color_count
[pixel
] > 0)
619 --color_count
[pixel
];
625 /* Register N colors from PIXELS as deallocated. */
628 unregister_colors (pixels
, n
)
629 unsigned long *pixels
;
633 for (i
= 0; i
< n
; ++i
)
634 unregister_color (pixels
[i
]);
638 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
639 doc
: /* Dump currently allocated colors to stderr. */)
644 fputc ('\n', stderr
);
646 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
649 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
652 fputc ('\n', stderr
);
654 fputc ('\t', stderr
);
658 fputc ('\n', stderr
);
662 #endif /* DEBUG_X_COLORS */
665 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
666 color values. Interrupt input must be blocked when this function
670 x_free_colors (f
, pixels
, npixels
)
672 unsigned long *pixels
;
675 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
677 /* If display has an immutable color map, freeing colors is not
678 necessary and some servers don't allow it. So don't do it. */
679 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
681 #ifdef DEBUG_X_COLORS
682 unregister_colors (pixels
, npixels
);
684 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
690 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
691 color values. Interrupt input must be blocked when this function
695 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
699 unsigned long *pixels
;
702 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
703 int class = dpyinfo
->visual
->class;
705 /* If display has an immutable color map, freeing colors is not
706 necessary and some servers don't allow it. So don't do it. */
707 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
709 #ifdef DEBUG_X_COLORS
710 unregister_colors (pixels
, npixels
);
712 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
717 /* Create and return a GC for use on frame F. GC values and mask
718 are given by XGCV and MASK. */
721 x_create_gc (f
, mask
, xgcv
)
728 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
735 /* Free GC which was used on frame F. */
743 IF_DEBUG (xassert (--ngcs
>= 0));
744 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
748 #endif /* HAVE_X_WINDOWS */
751 /* W32 emulation of GCs */
754 x_create_gc (f
, mask
, xgcv
)
761 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
768 /* Free GC which was used on frame F. */
776 IF_DEBUG (xassert (--ngcs
>= 0));
781 #endif /* WINDOWSNT */
784 /* Mac OS emulation of GCs */
786 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
789 x_create_gc (f
, mask
, xgcv
)
795 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
804 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
809 /* Like stricmp. Used to compare parts of font names which are in
814 const unsigned char *s1
, *s2
;
818 unsigned char c1
= tolower (*s1
);
819 unsigned char c2
= tolower (*s2
);
821 return c1
< c2
? -1 : 1;
826 return *s2
== 0 ? 0 : -1;
831 /* Like strlwr, which might not always be available. */
833 static unsigned char *
837 unsigned char *p
= s
;
846 /* Signal `error' with message S, and additional argument ARG. */
849 signal_error (s
, arg
)
853 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
857 /* If FRAME is nil, return a pointer to the selected frame.
858 Otherwise, check that FRAME is a live frame, and return a pointer
859 to it. NPARAM is the parameter number of FRAME, for
860 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
861 Lisp function definitions. */
863 static INLINE
struct frame
*
864 frame_or_selected_frame (frame
, nparam
)
869 frame
= selected_frame
;
871 CHECK_LIVE_FRAME (frame
);
872 return XFRAME (frame
);
876 /***********************************************************************
878 ***********************************************************************/
880 /* Initialize face cache and basic faces for frame F. */
886 /* Make a face cache, if F doesn't have one. */
887 if (FRAME_FACE_CACHE (f
) == NULL
)
888 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
890 #ifdef HAVE_WINDOW_SYSTEM
891 /* Make the image cache. */
892 if (FRAME_WINDOW_P (f
))
894 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
895 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
896 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
898 #endif /* HAVE_WINDOW_SYSTEM */
900 /* Realize basic faces. Must have enough information in frame
901 parameters to realize basic faces at this point. */
902 #ifdef HAVE_X_WINDOWS
903 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
906 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
909 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
911 if (!realize_basic_faces (f
))
916 /* Free face cache of frame F. Called from Fdelete_frame. */
922 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
926 free_face_cache (face_cache
);
927 FRAME_FACE_CACHE (f
) = NULL
;
930 #ifdef HAVE_WINDOW_SYSTEM
931 if (FRAME_WINDOW_P (f
))
933 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
936 --image_cache
->refcount
;
937 if (image_cache
->refcount
== 0)
938 free_image_cache (f
);
941 #endif /* HAVE_WINDOW_SYSTEM */
945 /* Clear face caches, and recompute basic faces for frame F. Call
946 this after changing frame parameters on which those faces depend,
947 or when realized faces have been freed due to changing attributes
951 recompute_basic_faces (f
)
954 if (FRAME_FACE_CACHE (f
))
956 clear_face_cache (0);
957 if (!realize_basic_faces (f
))
963 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
964 try to free unused fonts, too. */
967 clear_face_cache (clear_fonts_p
)
970 #ifdef HAVE_WINDOW_SYSTEM
971 Lisp_Object tail
, frame
;
975 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
977 struct x_display_info
*dpyinfo
;
979 /* Fonts are common for frames on one display, i.e. on
981 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
982 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
983 clear_font_table (dpyinfo
);
985 /* From time to time see if we can unload some fonts. This also
986 frees all realized faces on all frames. Fonts needed by
987 faces will be loaded again when faces are realized again. */
988 clear_font_table_count
= 0;
990 FOR_EACH_FRAME (tail
, frame
)
992 struct frame
*f
= XFRAME (frame
);
993 if (FRAME_WINDOW_P (f
)
994 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
995 free_all_realized_faces (frame
);
1000 /* Clear GCs of realized faces. */
1001 FOR_EACH_FRAME (tail
, frame
)
1004 if (FRAME_WINDOW_P (f
))
1006 clear_face_gcs (FRAME_FACE_CACHE (f
));
1007 clear_image_cache (f
, 0);
1011 #endif /* HAVE_WINDOW_SYSTEM */
1015 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1016 doc
: /* Clear face caches on all frames.
1017 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1019 Lisp_Object thoroughly
;
1021 clear_face_cache (!NILP (thoroughly
));
1022 ++face_change_count
;
1023 ++windows_or_buffers_changed
;
1029 #ifdef HAVE_WINDOW_SYSTEM
1032 /* Remove fonts from the font table of DPYINFO except for the default
1033 ASCII fonts of frames on that display. Called from clear_face_cache
1034 from time to time. */
1037 clear_font_table (dpyinfo
)
1038 struct x_display_info
*dpyinfo
;
1042 /* Free those fonts that are not used by frames on DPYINFO. */
1043 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1045 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1046 Lisp_Object tail
, frame
;
1048 /* Check if slot is already free. */
1049 if (font_info
->name
== NULL
)
1052 /* Don't free a default font of some frame. */
1053 FOR_EACH_FRAME (tail
, frame
)
1055 struct frame
*f
= XFRAME (frame
);
1056 if (FRAME_WINDOW_P (f
)
1057 && font_info
->font
== FRAME_FONT (f
))
1065 if (font_info
->full_name
!= font_info
->name
)
1066 xfree (font_info
->full_name
);
1067 xfree (font_info
->name
);
1069 /* Free the font. */
1071 #ifdef HAVE_X_WINDOWS
1072 XFreeFont (dpyinfo
->display
, font_info
->font
);
1075 w32_unload_font (dpyinfo
, font_info
->font
);
1078 mac_unload_font (dpyinfo
, font_info
->font
);
1082 /* Mark font table slot free. */
1083 font_info
->font
= NULL
;
1084 font_info
->name
= font_info
->full_name
= NULL
;
1088 #endif /* HAVE_WINDOW_SYSTEM */
1092 /***********************************************************************
1094 ***********************************************************************/
1096 #ifdef HAVE_WINDOW_SYSTEM
1098 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1099 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1100 A bitmap specification is either a string, a file name, or a list
1101 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1102 HEIGHT is its height, and DATA is a string containing the bits of
1103 the pixmap. Bits are stored row by row, each row occupies
1104 \(WIDTH + 7)/8 bytes. */)
1110 if (STRINGP (object
))
1111 /* If OBJECT is a string, it's a file name. */
1113 else if (CONSP (object
))
1115 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1116 HEIGHT must be integers > 0, and DATA must be string large
1117 enough to hold a bitmap of the specified size. */
1118 Lisp_Object width
, height
, data
;
1120 height
= width
= data
= Qnil
;
1124 width
= XCAR (object
);
1125 object
= XCDR (object
);
1128 height
= XCAR (object
);
1129 object
= XCDR (object
);
1131 data
= XCAR (object
);
1135 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1137 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1139 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1144 return pixmap_p
? Qt
: Qnil
;
1148 /* Load a bitmap according to NAME (which is either a file name or a
1149 pixmap spec) for use on frame F. Value is the bitmap_id (see
1150 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1151 bitmap cannot be loaded, display a message saying so, and return
1152 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1153 if these pointers are not null. */
1156 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1159 unsigned int *w_ptr
, *h_ptr
;
1167 tem
= Fbitmap_spec_p (name
);
1169 wrong_type_argument (Qbitmap_spec_p
, name
);
1174 /* Decode a bitmap spec into a bitmap. */
1179 w
= XINT (Fcar (name
));
1180 h
= XINT (Fcar (Fcdr (name
)));
1181 bits
= Fcar (Fcdr (Fcdr (name
)));
1183 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1188 /* It must be a string -- a file name. */
1189 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1195 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1206 ++npixmaps_allocated
;
1209 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1212 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1218 #endif /* HAVE_WINDOW_SYSTEM */
1222 /***********************************************************************
1224 ***********************************************************************/
1226 #ifdef HAVE_WINDOW_SYSTEM
1228 /* Load font of face FACE which is used on frame F to display
1229 character C. The name of the font to load is determined by lface
1230 and fontset of FACE. */
1233 load_face_font (f
, face
, c
)
1238 struct font_info
*font_info
= NULL
;
1240 int needs_overstrike
;
1242 face
->font_info_id
= -1;
1245 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
,
1251 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1256 face
->font_info_id
= font_info
->font_idx
;
1257 face
->font
= font_info
->font
;
1258 face
->font_name
= font_info
->full_name
;
1259 face
->overstrike
= needs_overstrike
;
1262 x_free_gc (f
, face
->gc
);
1267 add_to_log ("Unable to load font %s",
1268 build_string (font_name
), Qnil
);
1272 #endif /* HAVE_WINDOW_SYSTEM */
1276 /***********************************************************************
1278 ***********************************************************************/
1280 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1281 RGB_LIST should contain (at least) 3 lisp integers.
1282 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1285 parse_rgb_list (rgb_list
, color
)
1286 Lisp_Object rgb_list
;
1289 #define PARSE_RGB_LIST_FIELD(field) \
1290 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1292 color->field = XINT (XCAR (rgb_list)); \
1293 rgb_list = XCDR (rgb_list); \
1298 PARSE_RGB_LIST_FIELD (red
);
1299 PARSE_RGB_LIST_FIELD (green
);
1300 PARSE_RGB_LIST_FIELD (blue
);
1306 /* Lookup on frame F the color described by the lisp string COLOR.
1307 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1308 non-zero, then the `standard' definition of the same color is
1312 tty_lookup_color (f
, color
, tty_color
, std_color
)
1315 XColor
*tty_color
, *std_color
;
1317 Lisp_Object frame
, color_desc
;
1319 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1322 XSETFRAME (frame
, f
);
1324 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1325 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1329 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1332 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1334 rgb
= XCDR (XCDR (color_desc
));
1335 if (! parse_rgb_list (rgb
, tty_color
))
1338 /* Should we fill in STD_COLOR too? */
1341 /* Default STD_COLOR to the same as TTY_COLOR. */
1342 *std_color
= *tty_color
;
1344 /* Do a quick check to see if the returned descriptor is
1345 actually _exactly_ equal to COLOR, otherwise we have to
1346 lookup STD_COLOR separately. If it's impossible to lookup
1347 a standard color, we just give up and use TTY_COLOR. */
1348 if ((!STRINGP (XCAR (color_desc
))
1349 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1350 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1352 /* Look up STD_COLOR separately. */
1353 rgb
= call1 (Qtty_color_standard_values
, color
);
1354 if (! parse_rgb_list (rgb
, std_color
))
1361 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1362 /* We were called early during startup, and the colors are not
1363 yet set up in tty-defined-color-alist. Don't return a failure
1364 indication, since this produces the annoying "Unable to
1365 load color" messages in the *Messages* buffer. */
1368 /* tty-color-desc seems to have returned a bad value. */
1372 /* A version of defined_color for non-X frames. */
1375 tty_defined_color (f
, color_name
, color_def
, alloc
)
1384 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1386 color_def
->blue
= 0;
1387 color_def
->green
= 0;
1390 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, 0);
1392 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1394 if (strcmp (color_name
, "unspecified-fg") == 0)
1395 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1396 else if (strcmp (color_name
, "unspecified-bg") == 0)
1397 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1400 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1407 /* Decide if color named COLOR_NAME is valid for the display
1408 associated with the frame F; if so, return the rgb values in
1409 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1411 This does the right thing for any type of frame. */
1414 defined_color (f
, color_name
, color_def
, alloc
)
1420 if (!FRAME_WINDOW_P (f
))
1421 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1422 #ifdef HAVE_X_WINDOWS
1423 else if (FRAME_X_P (f
))
1424 return x_defined_color (f
, color_name
, color_def
, alloc
);
1427 else if (FRAME_W32_P (f
))
1428 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1431 else if (FRAME_MAC_P (f
))
1432 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1439 /* Given the index IDX of a tty color on frame F, return its name, a
1443 tty_color_name (f
, idx
)
1447 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1450 Lisp_Object coldesc
;
1452 XSETFRAME (frame
, f
);
1453 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1455 if (!NILP (coldesc
))
1456 return XCAR (coldesc
);
1459 /* We can have an MSDOG frame under -nw for a short window of
1460 opportunity before internal_terminal_init is called. DTRT. */
1461 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1462 return msdos_stdcolor_name (idx
);
1465 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1466 return build_string (unspecified_fg
);
1467 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1468 return build_string (unspecified_bg
);
1471 return vga_stdcolor_name (idx
);
1474 return Qunspecified
;
1478 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1479 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1482 face_color_gray_p (f
, color_name
)
1489 if (defined_color (f
, color_name
, &color
, 0))
1490 gray_p
= ((abs (color
.red
- color
.green
)
1491 < max (color
.red
, color
.green
) / 20)
1492 && (abs (color
.green
- color
.blue
)
1493 < max (color
.green
, color
.blue
) / 20)
1494 && (abs (color
.blue
- color
.red
)
1495 < max (color
.blue
, color
.red
) / 20));
1503 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1504 BACKGROUND_P non-zero means the color will be used as background
1508 face_color_supported_p (f
, color_name
, background_p
)
1516 XSETFRAME (frame
, f
);
1518 #ifdef HAVE_WINDOW_SYSTEM
1520 ? (!NILP (Fxw_display_color_p (frame
))
1521 || xstricmp (color_name
, "black") == 0
1522 || xstricmp (color_name
, "white") == 0
1524 && face_color_gray_p (f
, color_name
))
1525 || (!NILP (Fx_display_grayscale_p (frame
))
1526 && face_color_gray_p (f
, color_name
)))
1529 tty_defined_color (f
, color_name
, ¬_used
, 0);
1533 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1534 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1535 FRAME specifies the frame and thus the display for interpreting COLOR.
1536 If FRAME is nil or omitted, use the selected frame. */)
1538 Lisp_Object color
, frame
;
1542 CHECK_STRING (color
);
1544 frame
= selected_frame
;
1546 CHECK_FRAME (frame
);
1548 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1552 DEFUN ("color-supported-p", Fcolor_supported_p
,
1553 Scolor_supported_p
, 1, 3, 0,
1554 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1555 BACKGROUND-P non-nil means COLOR is used as a background.
1556 Otherwise, this function tells whether it can be used as a foreground.
1557 If FRAME is nil or omitted, use the selected frame.
1558 COLOR must be a valid color name. */)
1559 (color
, frame
, background_p
)
1560 Lisp_Object frame
, color
, background_p
;
1564 CHECK_STRING (color
);
1566 frame
= selected_frame
;
1568 CHECK_FRAME (frame
);
1570 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1576 /* Load color with name NAME for use by face FACE on frame F.
1577 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1578 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1579 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1580 pixel color. If color cannot be loaded, display a message, and
1581 return the foreground, background or underline color of F, but
1582 record that fact in flags of the face so that we don't try to free
1586 load_color (f
, face
, name
, target_index
)
1590 enum lface_attribute_index target_index
;
1594 xassert (STRINGP (name
));
1595 xassert (target_index
== LFACE_FOREGROUND_INDEX
1596 || target_index
== LFACE_BACKGROUND_INDEX
1597 || target_index
== LFACE_UNDERLINE_INDEX
1598 || target_index
== LFACE_OVERLINE_INDEX
1599 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1600 || target_index
== LFACE_BOX_INDEX
);
1602 /* if the color map is full, defined_color will return a best match
1603 to the values in an existing cell. */
1604 if (!defined_color (f
, SDATA (name
), &color
, 1))
1606 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1608 switch (target_index
)
1610 case LFACE_FOREGROUND_INDEX
:
1611 face
->foreground_defaulted_p
= 1;
1612 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1615 case LFACE_BACKGROUND_INDEX
:
1616 face
->background_defaulted_p
= 1;
1617 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1620 case LFACE_UNDERLINE_INDEX
:
1621 face
->underline_defaulted_p
= 1;
1622 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1625 case LFACE_OVERLINE_INDEX
:
1626 face
->overline_color_defaulted_p
= 1;
1627 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1630 case LFACE_STRIKE_THROUGH_INDEX
:
1631 face
->strike_through_color_defaulted_p
= 1;
1632 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1635 case LFACE_BOX_INDEX
:
1636 face
->box_color_defaulted_p
= 1;
1637 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1646 ++ncolors_allocated
;
1653 #ifdef HAVE_WINDOW_SYSTEM
1655 /* Load colors for face FACE which is used on frame F. Colors are
1656 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1657 of ATTRS. If the background color specified is not supported on F,
1658 try to emulate gray colors with a stipple from Vface_default_stipple. */
1661 load_face_colors (f
, face
, attrs
)
1668 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1669 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1671 /* Swap colors if face is inverse-video. */
1672 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1680 /* Check for support for foreground, not for background because
1681 face_color_supported_p is smart enough to know that grays are
1682 "supported" as background because we are supposed to use stipple
1684 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1685 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1687 x_destroy_bitmap (f
, face
->stipple
);
1688 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1689 &face
->pixmap_w
, &face
->pixmap_h
);
1692 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1693 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1697 /* Free color PIXEL on frame F. */
1700 unload_color (f
, pixel
)
1702 unsigned long pixel
;
1704 #ifdef HAVE_X_WINDOWS
1708 x_free_colors (f
, &pixel
, 1);
1715 /* Free colors allocated for FACE. */
1718 free_face_colors (f
, face
)
1722 #ifdef HAVE_X_WINDOWS
1723 if (face
->colors_copied_bitwise_p
)
1728 if (!face
->foreground_defaulted_p
)
1730 x_free_colors (f
, &face
->foreground
, 1);
1731 IF_DEBUG (--ncolors_allocated
);
1734 if (!face
->background_defaulted_p
)
1736 x_free_colors (f
, &face
->background
, 1);
1737 IF_DEBUG (--ncolors_allocated
);
1740 if (face
->underline_p
1741 && !face
->underline_defaulted_p
)
1743 x_free_colors (f
, &face
->underline_color
, 1);
1744 IF_DEBUG (--ncolors_allocated
);
1747 if (face
->overline_p
1748 && !face
->overline_color_defaulted_p
)
1750 x_free_colors (f
, &face
->overline_color
, 1);
1751 IF_DEBUG (--ncolors_allocated
);
1754 if (face
->strike_through_p
1755 && !face
->strike_through_color_defaulted_p
)
1757 x_free_colors (f
, &face
->strike_through_color
, 1);
1758 IF_DEBUG (--ncolors_allocated
);
1761 if (face
->box
!= FACE_NO_BOX
1762 && !face
->box_color_defaulted_p
)
1764 x_free_colors (f
, &face
->box_color
, 1);
1765 IF_DEBUG (--ncolors_allocated
);
1769 #endif /* HAVE_X_WINDOWS */
1772 #endif /* HAVE_WINDOW_SYSTEM */
1776 /***********************************************************************
1778 ***********************************************************************/
1780 /* An enumerator for each field of an XLFD font name. */
1801 /* An enumerator for each possible slant value of a font. Taken from
1802 the XLFD specification. */
1810 XLFD_SLANT_REVERSE_ITALIC
,
1811 XLFD_SLANT_REVERSE_OBLIQUE
,
1815 /* Relative font weight according to XLFD documentation. */
1819 XLFD_WEIGHT_UNKNOWN
,
1820 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1821 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1822 XLFD_WEIGHT_LIGHT
, /* 30 */
1823 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1824 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1825 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1826 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1827 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1828 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1831 /* Relative proportionate width. */
1835 XLFD_SWIDTH_UNKNOWN
,
1836 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1837 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1838 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1839 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1840 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1841 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1842 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1843 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1844 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1847 /* Structure used for tables mapping XLFD weight, slant, and width
1848 names to numeric and symbolic values. */
1854 Lisp_Object
*symbol
;
1857 /* Table of XLFD slant names and their numeric and symbolic
1858 representations. This table must be sorted by slant names in
1861 static struct table_entry slant_table
[] =
1863 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1864 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1865 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1866 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1867 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1868 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1871 /* Table of XLFD weight names. This table must be sorted by weight
1872 names in ascending order. */
1874 static struct table_entry weight_table
[] =
1876 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1877 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1878 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1879 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1880 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1881 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1882 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1883 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1884 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1885 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1886 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1887 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1888 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1889 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1890 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1891 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1894 /* Table of XLFD width names. This table must be sorted by width
1895 names in ascending order. */
1897 static struct table_entry swidth_table
[] =
1899 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1900 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1901 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1902 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1903 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1904 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1905 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1906 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1907 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1908 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1909 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1910 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1911 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1912 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1913 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1916 /* Structure used to hold the result of splitting font names in XLFD
1917 format into their fields. */
1921 /* The original name which is modified destructively by
1922 split_font_name. The pointer is kept here to be able to free it
1923 if it was allocated from the heap. */
1926 /* Font name fields. Each vector element points into `name' above.
1927 Fields are NUL-terminated. */
1928 char *fields
[XLFD_LAST
];
1930 /* Numeric values for those fields that interest us. See
1931 split_font_name for which these are. */
1932 int numeric
[XLFD_LAST
];
1934 /* If the original name matches one of Vface_font_rescale_alist,
1935 the value is the corresponding rescale ratio. Otherwise, the
1937 double rescale_ratio
;
1939 /* Lower value mean higher priority. */
1940 int registry_priority
;
1943 /* The frame in effect when sorting font names. Set temporarily in
1944 sort_fonts so that it is available in font comparison functions. */
1946 static struct frame
*font_frame
;
1948 /* Order by which font selection chooses fonts. The default values
1949 mean `first, find a best match for the font width, then for the
1950 font height, then for weight, then for slant.' This variable can be
1951 set via set-face-font-sort-order. */
1954 static int font_sort_order
[4] = {
1955 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1958 static int font_sort_order
[4];
1961 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1962 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1963 is a pointer to the matching table entry or null if no table entry
1966 static struct table_entry
*
1967 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1968 struct table_entry
*table
;
1970 struct font_name
*font
;
1973 /* Function split_font_name converts fields to lower-case, so there
1974 is no need to use xstrlwr or xstricmp here. */
1975 char *s
= font
->fields
[field_index
];
1976 int low
, mid
, high
, cmp
;
1983 mid
= (low
+ high
) / 2;
1984 cmp
= strcmp (table
[mid
].name
, s
);
1998 /* Return a numeric representation for font name field
1999 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2000 has DIM entries. Value is the numeric value found or DFLT if no
2001 table entry matches. This function is used to translate weight,
2002 slant, and swidth names of XLFD font names to numeric values. */
2005 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
2006 struct table_entry
*table
;
2008 struct font_name
*font
;
2012 struct table_entry
*p
;
2013 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2014 return p
? p
->numeric
: dflt
;
2018 /* Return a symbolic representation for font name field
2019 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2020 has DIM entries. Value is the symbolic value found or DFLT if no
2021 table entry matches. This function is used to translate weight,
2022 slant, and swidth names of XLFD font names to symbols. */
2024 static INLINE Lisp_Object
2025 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2026 struct table_entry
*table
;
2028 struct font_name
*font
;
2032 struct table_entry
*p
;
2033 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2034 return p
? *p
->symbol
: dflt
;
2038 /* Return a numeric value for the slant of the font given by FONT. */
2041 xlfd_numeric_slant (font
)
2042 struct font_name
*font
;
2044 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2045 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2049 /* Return a symbol representing the weight of the font given by FONT. */
2051 static INLINE Lisp_Object
2052 xlfd_symbolic_slant (font
)
2053 struct font_name
*font
;
2055 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2056 font
, XLFD_SLANT
, Qnormal
);
2060 /* Return a numeric value for the weight of the font given by FONT. */
2063 xlfd_numeric_weight (font
)
2064 struct font_name
*font
;
2066 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2067 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2071 /* Return a symbol representing the slant of the font given by FONT. */
2073 static INLINE Lisp_Object
2074 xlfd_symbolic_weight (font
)
2075 struct font_name
*font
;
2077 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2078 font
, XLFD_WEIGHT
, Qnormal
);
2082 /* Return a numeric value for the swidth of the font whose XLFD font
2083 name fields are found in FONT. */
2086 xlfd_numeric_swidth (font
)
2087 struct font_name
*font
;
2089 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2090 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2094 /* Return a symbolic value for the swidth of FONT. */
2096 static INLINE Lisp_Object
2097 xlfd_symbolic_swidth (font
)
2098 struct font_name
*font
;
2100 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2101 font
, XLFD_SWIDTH
, Qnormal
);
2105 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2106 entries. Value is a pointer to the matching table entry or null if
2107 no element of TABLE contains SYMBOL. */
2109 static struct table_entry
*
2110 face_value (table
, dim
, symbol
)
2111 struct table_entry
*table
;
2117 xassert (SYMBOLP (symbol
));
2119 for (i
= 0; i
< dim
; ++i
)
2120 if (EQ (*table
[i
].symbol
, symbol
))
2123 return i
< dim
? table
+ i
: NULL
;
2127 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2128 entries. Value is -1 if SYMBOL is not found in TABLE. */
2131 face_numeric_value (table
, dim
, symbol
)
2132 struct table_entry
*table
;
2136 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2137 return p
? p
->numeric
: -1;
2141 /* Return a numeric value representing the weight specified by Lisp
2142 symbol WEIGHT. Value is one of the enumerators of enum
2146 face_numeric_weight (weight
)
2149 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2153 /* Return a numeric value representing the slant specified by Lisp
2154 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2157 face_numeric_slant (slant
)
2160 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2164 /* Return a numeric value representing the swidth specified by Lisp
2165 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2168 face_numeric_swidth (width
)
2171 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2175 #ifdef HAVE_WINDOW_SYSTEM
2177 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2181 struct font_name
*font
;
2183 /* Function split_font_name converts fields to lower-case, so there
2184 is no need to use tolower here. */
2185 return *font
->fields
[XLFD_SPACING
] != 'p';
2189 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2191 The actual height of the font when displayed on F depends on the
2192 resolution of both the font and frame. For example, a 10pt font
2193 designed for a 100dpi display will display larger than 10pt on a
2194 75dpi display. (It's not unusual to use fonts not designed for the
2195 display one is using. For example, some intlfonts are available in
2196 72dpi versions, only.)
2198 Value is the real point size of FONT on frame F, or 0 if it cannot
2202 xlfd_point_size (f
, font
)
2204 struct font_name
*font
;
2206 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2207 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2211 if (*pixel_field
== '[')
2213 /* The pixel size field is `[A B C D]' which specifies
2214 a transformation matrix.
2220 by which all glyphs of the font are transformed. The spec
2221 says that s scalar value N for the pixel size is equivalent
2222 to A = N * resx/resy, B = C = 0, D = N. */
2223 char *start
= pixel_field
+ 1, *end
;
2227 for (i
= 0; i
< 4; ++i
)
2229 matrix
[i
] = strtod (start
, &end
);
2236 pixel
= atoi (pixel_field
);
2241 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2247 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2248 of frame F. This function is used to guess a point size of font
2249 when only the pixel height of the font is available. */
2252 pixel_point_size (f
, pixel
)
2256 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2260 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2261 point size of one dot. */
2262 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2263 int_pt
= real_pt
+ 0.5;
2269 /* Return a rescaling ratio of a font of NAME. */
2272 font_rescale_ratio (name
)
2275 Lisp_Object tail
, elt
;
2277 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2280 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2281 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2282 return XFLOAT_DATA (XCDR (elt
));
2288 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2289 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2290 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2291 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2292 zero if the font name doesn't have the format we expect. The
2293 expected format is a font name that starts with a `-' and has
2294 XLFD_LAST fields separated by `-'. */
2297 split_font_name (f
, font
, numeric_p
)
2299 struct font_name
*font
;
2304 double rescale_ratio
;
2307 /* This must be done before splitting the font name. */
2308 rescale_ratio
= font_rescale_ratio (font
->name
);
2310 if (*font
->name
== '-')
2312 char *p
= xstrlwr (font
->name
) + 1;
2314 while (i
< XLFD_LAST
)
2316 font
->fields
[i
] = p
;
2319 /* Pixel and point size may be of the form `[....]'. For
2320 BNF, see XLFD spec, chapter 4. Negative values are
2321 indicated by tilde characters which we replace with
2322 `-' characters, here. */
2324 && (i
- 1 == XLFD_PIXEL_SIZE
2325 || i
- 1 == XLFD_POINT_SIZE
))
2330 for (++p
; *p
&& *p
!= ']'; ++p
)
2334 /* Check that the matrix contains 4 floating point
2336 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2339 if (strtod (start
, &end
) == 0 && start
== end
)
2346 while (*p
&& *p
!= '-')
2356 success_p
= i
== XLFD_LAST
;
2358 /* If requested, and font name was in the expected format,
2359 compute numeric values for some fields. */
2360 if (numeric_p
&& success_p
)
2362 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2363 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2364 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2365 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2366 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2367 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2368 font
->rescale_ratio
= rescale_ratio
;
2371 /* Initialize it to zero. It will be overridden by font_list while
2372 trying alternate registries. */
2373 font
->registry_priority
= 0;
2379 /* Build an XLFD font name from font name fields in FONT. Value is a
2380 pointer to the font name, which is allocated via xmalloc. */
2383 build_font_name (font
)
2384 struct font_name
*font
;
2388 char *font_name
= (char *) xmalloc (size
);
2389 int total_length
= 0;
2391 for (i
= 0; i
< XLFD_LAST
; ++i
)
2393 /* Add 1 because of the leading `-'. */
2394 int len
= strlen (font
->fields
[i
]) + 1;
2396 /* Reallocate font_name if necessary. Add 1 for the final
2398 if (total_length
+ len
+ 1 >= size
)
2400 int new_size
= max (2 * size
, size
+ len
+ 1);
2401 int sz
= new_size
* sizeof *font_name
;
2402 font_name
= (char *) xrealloc (font_name
, sz
);
2406 font_name
[total_length
] = '-';
2407 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2408 total_length
+= len
;
2411 font_name
[total_length
] = 0;
2416 /* Free an array FONTS of N font_name structures. This frees FONTS
2417 itself and all `name' fields in its elements. */
2420 free_font_names (fonts
, n
)
2421 struct font_name
*fonts
;
2425 xfree (fonts
[--n
].name
);
2430 /* Sort vector FONTS of font_name structures which contains NFONTS
2431 elements using qsort and comparison function CMPFN. F is the frame
2432 on which the fonts will be used. The global variable font_frame
2433 is temporarily set to F to make it available in CMPFN. */
2436 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2438 struct font_name
*fonts
;
2440 int (*cmpfn
) P_ ((const void *, const void *));
2443 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2448 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2449 display in x_display_list. FONTS is a pointer to a vector of
2450 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2451 alternative patterns from Valternate_fontname_alist if no fonts are
2452 found matching PATTERN.
2454 For all fonts found, set FONTS[i].name to the name of the font,
2455 allocated via xmalloc, and split font names into fields. Ignore
2456 fonts that we can't parse. Value is the number of fonts found. */
2459 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2462 struct font_name
**pfonts
;
2463 int nfonts
, try_alternatives_p
;
2467 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2468 better to do it the other way around. */
2470 Lisp_Object lpattern
, tem
;
2471 struct font_name
*fonts
= 0;
2472 int num_fonts
= nfonts
;
2475 lpattern
= build_string (pattern
);
2477 /* Get the list of fonts matching PATTERN. */
2480 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2483 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2486 if (nfonts
< 0 && CONSP (lfonts
))
2487 num_fonts
= XFASTINT (Flength (lfonts
));
2489 /* Make a copy of the font names we got from X, and
2490 split them into fields. */
2492 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2494 Lisp_Object elt
, tail
;
2495 const char *name
= SDATA (XCAR (tem
));
2497 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2498 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2502 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2513 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2517 /* Make a copy of the font name. */
2518 fonts
[n
].name
= xstrdup (name
);
2520 if (split_font_name (f
, fonts
+ n
, 1))
2522 if (font_scalable_p (fonts
+ n
)
2523 && !may_use_scalable_font_p (name
))
2526 xfree (fonts
[n
].name
);
2532 xfree (fonts
[n
].name
);
2535 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2536 if (n
== 0 && try_alternatives_p
)
2538 Lisp_Object list
= Valternate_fontname_alist
;
2546 while (CONSP (list
))
2548 Lisp_Object entry
= XCAR (list
);
2550 && STRINGP (XCAR (entry
))
2551 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2558 Lisp_Object patterns
= XCAR (list
);
2561 while (CONSP (patterns
)
2562 /* If list is screwed up, give up. */
2563 && (name
= XCAR (patterns
),
2565 /* Ignore patterns equal to PATTERN because we tried that
2566 already with no success. */
2567 && (strcmp (SDATA (name
), pattern
) == 0
2568 || (n
= x_face_list_fonts (f
, SDATA (name
),
2571 patterns
= XCDR (patterns
);
2579 /* Check if a font matching pattern_offset_t on frame F is available
2580 or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
2581 a font name pattern is generated from FAMILY and REGISTRY. */
2584 face_font_available_p (f
, pattern
)
2586 Lisp_Object pattern
;
2590 if (! STRINGP (pattern
))
2592 Lisp_Object family
, registry
;
2593 char *family_str
, *registry_str
, *pattern_str
;
2595 CHECK_CONS (pattern
);
2596 family
= XCAR (pattern
);
2601 CHECK_STRING (family
);
2602 family_str
= (char *) SDATA (family
);
2604 registry
= XCDR (pattern
);
2605 if (NILP (registry
))
2609 CHECK_STRING (registry
);
2610 registry_str
= (char *) SDATA (registry
);
2613 pattern_str
= (char *) alloca (strlen (family_str
)
2614 + strlen (registry_str
)
2616 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2617 strcat (pattern_str
, family_str
);
2618 strcat (pattern_str
, "-*-");
2619 strcat (pattern_str
, registry_str
);
2620 if (!index (registry_str
, '-'))
2622 if (registry_str
[strlen (registry_str
) - 1] == '*')
2623 strcat (pattern_str
, "-*");
2625 strcat (pattern_str
, "*-*");
2627 pattern
= build_string (pattern_str
);
2630 /* Get the list of fonts matching PATTERN. */
2633 fonts
= w32_list_fonts (f
, pattern
, 0, 1);
2636 fonts
= x_list_fonts (f
, pattern
, -1, 1);
2638 return XINT (Flength (fonts
));
2642 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2643 using comparison function CMPFN. Value is the number of fonts
2644 found. If value is non-zero, *FONTS is set to a vector of
2645 font_name structures allocated from the heap containing matching
2646 fonts. Each element of *FONTS contains a name member that is also
2647 allocated from the heap. Font names in these structures are split
2648 into fields. Use free_font_names to free such an array. */
2651 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2654 int (*cmpfn
) P_ ((const void *, const void *));
2655 struct font_name
**fonts
;
2659 /* Get the list of fonts matching pattern. 100 should suffice. */
2660 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2661 if (INTEGERP (Vfont_list_limit
))
2662 nfonts
= XINT (Vfont_list_limit
);
2665 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2667 /* Sort the resulting array and return it in *FONTS. If no
2668 fonts were found, make sure to set *FONTS to null. */
2670 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2681 /* Compare two font_name structures *A and *B. Value is analogous to
2682 strcmp. Sort order is given by the global variable
2683 font_sort_order. Font names are sorted so that, everything else
2684 being equal, fonts with a resolution closer to that of the frame on
2685 which they are used are listed first. The global variable
2686 font_frame is the frame on which we operate. */
2689 cmp_font_names (a
, b
)
2692 struct font_name
*x
= (struct font_name
*) a
;
2693 struct font_name
*y
= (struct font_name
*) b
;
2696 /* All strings have been converted to lower-case by split_font_name,
2697 so we can use strcmp here. */
2698 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2703 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2705 int j
= font_sort_order
[i
];
2706 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2711 /* Everything else being equal, we prefer fonts with an
2712 y-resolution closer to that of the frame. */
2713 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2714 int x_resy
= x
->numeric
[XLFD_RESY
];
2715 int y_resy
= y
->numeric
[XLFD_RESY
];
2716 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2724 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2725 is non-nil list fonts matching that pattern. Otherwise, if
2726 REGISTRY is non-nil return only fonts with that registry, otherwise
2727 return fonts of any registry. Set *FONTS to a vector of font_name
2728 structures allocated from the heap containing the fonts found.
2729 Value is the number of fonts found. */
2732 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2734 Lisp_Object pattern
, family
, registry
;
2735 struct font_name
**fonts
;
2737 char *pattern_str
, *family_str
, *registry_str
;
2741 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2742 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2744 pattern_str
= (char *) alloca (strlen (family_str
)
2745 + strlen (registry_str
)
2747 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2748 strcat (pattern_str
, family_str
);
2749 strcat (pattern_str
, "-*-");
2750 strcat (pattern_str
, registry_str
);
2751 if (!index (registry_str
, '-'))
2753 if (registry_str
[strlen (registry_str
) - 1] == '*')
2754 strcat (pattern_str
, "-*");
2756 strcat (pattern_str
, "*-*");
2760 pattern_str
= (char *) SDATA (pattern
);
2762 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2766 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2767 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2768 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2771 static struct font_name
*
2772 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2773 struct font_name
*fonts1
, *fonts2
;
2774 int nfonts1
, nfonts2
;
2776 int new_nfonts
= nfonts1
+ nfonts2
;
2777 struct font_name
*new_fonts
;
2779 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2780 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2781 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2788 /* Get a sorted list of fonts of family FAMILY on frame F.
2790 If PATTERN is non-nil list fonts matching that pattern.
2792 If REGISTRY is non-nil, return fonts with that registry and the
2793 alternative registries from Vface_alternative_font_registry_alist.
2795 If REGISTRY is nil return fonts of any registry.
2797 Set *FONTS to a vector of font_name structures allocated from the
2798 heap containing the fonts found. Value is the number of fonts
2802 font_list (f
, pattern
, family
, registry
, fonts
)
2804 Lisp_Object pattern
, family
, registry
;
2805 struct font_name
**fonts
;
2807 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2809 if (!NILP (registry
)
2810 && CONSP (Vface_alternative_font_registry_alist
))
2814 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2819 for (alter
= XCDR (alter
), reg_prio
= 1;
2821 alter
= XCDR (alter
), reg_prio
++)
2822 if (STRINGP (XCAR (alter
)))
2825 struct font_name
*fonts2
;
2827 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2829 for (i
= 0; i
< nfonts2
; i
++)
2830 fonts2
[i
].registry_priority
= reg_prio
;
2831 *fonts
= (nfonts
> 0
2832 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2843 /* Remove elements from LIST whose cars are `equal'. Called from
2844 x-family-fonts and x-font-family-list to remove duplicate font
2848 remove_duplicates (list
)
2851 Lisp_Object tail
= list
;
2853 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2855 Lisp_Object next
= XCDR (tail
);
2856 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2857 XSETCDR (tail
, XCDR (next
));
2864 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2865 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2866 If FAMILY is omitted or nil, list all families.
2867 Otherwise, FAMILY must be a string, possibly containing wildcards
2869 If FRAME is omitted or nil, use the selected frame.
2870 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2871 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2872 FAMILY is the font family name. POINT-SIZE is the size of the
2873 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2874 width, weight and slant of the font. These symbols are the same as for
2875 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2876 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2877 giving the registry and encoding of the font.
2878 The result list is sorted according to the current setting of
2879 the face font sort order. */)
2881 Lisp_Object family
, frame
;
2883 struct frame
*f
= check_x_frame (frame
);
2884 struct font_name
*fonts
;
2887 struct gcpro gcpro1
;
2890 CHECK_STRING (family
);
2894 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2895 for (i
= nfonts
- 1; i
>= 0; --i
)
2897 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2900 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2901 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2902 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2903 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2904 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2905 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2906 tem
= build_font_name (fonts
+ i
);
2907 ASET (v
, 6, build_string (tem
));
2908 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2909 fonts
[i
].fields
[XLFD_ENCODING
]);
2910 ASET (v
, 7, build_string (tem
));
2913 result
= Fcons (v
, result
);
2916 remove_duplicates (result
);
2917 free_font_names (fonts
, nfonts
);
2923 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2925 doc
: /* Return a list of available font families on FRAME.
2926 If FRAME is omitted or nil, use the selected frame.
2927 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2928 is a font family, and FIXED-P is non-nil if fonts of that family
2929 are fixed-pitch. */)
2933 struct frame
*f
= check_x_frame (frame
);
2935 struct font_name
*fonts
;
2937 struct gcpro gcpro1
;
2938 int count
= SPECPDL_INDEX ();
2940 /* Let's consider all fonts. */
2941 specbind (intern ("font-list-limit"), make_number (-1));
2942 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2946 for (i
= nfonts
- 1; i
>= 0; --i
)
2947 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2948 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2951 remove_duplicates (result
);
2952 free_font_names (fonts
, nfonts
);
2954 return unbind_to (count
, result
);
2958 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2959 doc
: /* Return a list of the names of available fonts matching PATTERN.
2960 If optional arguments FACE and FRAME are specified, return only fonts
2961 the same size as FACE on FRAME.
2962 PATTERN is a string, perhaps with wildcard characters;
2963 the * character matches any substring, and
2964 the ? character matches any single character.
2965 PATTERN is case-insensitive.
2966 FACE is a face name--a symbol.
2968 The return value is a list of strings, suitable as arguments to
2971 Fonts Emacs can't use may or may not be excluded
2972 even if they match PATTERN and FACE.
2973 The optional fourth argument MAXIMUM sets a limit on how many
2974 fonts to match. The first MAXIMUM fonts are reported.
2975 The optional fifth argument WIDTH, if specified, is a number of columns
2976 occupied by a character of a font. In that case, return only fonts
2977 the WIDTH times as wide as FACE on FRAME. */)
2978 (pattern
, face
, frame
, maximum
, width
)
2979 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2986 CHECK_STRING (pattern
);
2992 CHECK_NATNUM (maximum
);
2993 maxnames
= XINT (maximum
);
2997 CHECK_NUMBER (width
);
2999 /* We can't simply call check_x_frame because this function may be
3000 called before any frame is created. */
3001 f
= frame_or_selected_frame (frame
, 2);
3002 if (!FRAME_WINDOW_P (f
))
3004 /* Perhaps we have not yet created any frame. */
3009 /* Determine the width standard for comparison with the fonts we find. */
3015 /* This is of limited utility since it works with character
3016 widths. Keep it for compatibility. --gerd. */
3017 int face_id
= lookup_named_face (f
, face
, 0, 0);
3018 struct face
*face
= (face_id
< 0
3020 : FACE_FROM_ID (f
, face_id
));
3023 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3024 not maximum as on X. Redefine here. */
3026 #define FONT_WIDTH FONT_MAX_WIDTH
3029 if (face
&& face
->font
)
3030 size
= FONT_WIDTH (face
->font
);
3032 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3035 size
*= XINT (width
);
3039 Lisp_Object args
[2];
3041 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3043 /* We don't have to check fontsets. */
3045 args
[1] = list_fontsets (f
, pattern
, size
);
3046 return Fnconc (2, args
);
3050 #endif /* HAVE_WINDOW_SYSTEM */
3054 /***********************************************************************
3056 ***********************************************************************/
3058 /* Access face attributes of face LFACE, a Lisp vector. */
3060 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3061 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3062 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3063 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3064 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3065 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3066 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3067 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3068 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3069 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3070 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3071 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3072 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3073 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3074 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3075 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3077 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3078 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3080 #define LFACEP(LFACE) \
3082 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3083 && EQ (AREF (LFACE, 0), Qface))
3088 /* Check consistency of Lisp face attribute vector ATTRS. */
3091 check_lface_attrs (attrs
)
3094 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3095 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3096 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3097 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3098 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3099 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3100 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3101 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3102 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3103 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3104 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3105 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3106 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3107 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3108 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3109 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3110 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3111 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3112 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3113 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3114 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3115 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3116 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3117 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3118 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3119 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3120 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3121 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3122 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3123 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3124 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3125 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3126 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3127 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3128 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3129 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3130 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3131 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3132 #ifdef HAVE_WINDOW_SYSTEM
3133 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3134 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3135 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3136 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3137 || NILP (attrs
[LFACE_FONT_INDEX
])
3138 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3143 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3151 xassert (LFACEP (lface
));
3152 check_lface_attrs (XVECTOR (lface
)->contents
);
3156 #else /* GLYPH_DEBUG == 0 */
3158 #define check_lface_attrs(attrs) (void) 0
3159 #define check_lface(lface) (void) 0
3161 #endif /* GLYPH_DEBUG == 0 */
3165 /* Face-merge cycle checking. */
3167 /* A `named merge point' is simply a point during face-merging where we
3168 look up a face by name. We keep a stack of which named lookups we're
3169 currently processing so that we can easily detect cycles, using a
3170 linked- list of struct named_merge_point structures, typically
3171 allocated on the stack frame of the named lookup functions which are
3172 active (so no consing is required). */
3173 struct named_merge_point
3175 Lisp_Object face_name
;
3176 struct named_merge_point
*prev
;
3180 /* If a face merging cycle is detected for FACE_NAME, return 0,
3181 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
3182 FACE_NAME, as the head of the linked list pointed to by
3183 NAMED_MERGE_POINTS, and return 1. */
3186 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
3187 Lisp_Object face_name
,
3188 struct named_merge_point
**named_merge_points
)
3190 struct named_merge_point
*prev
;
3192 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
3193 if (EQ (face_name
, prev
->face_name
))
3196 new_named_merge_point
->face_name
= face_name
;
3197 new_named_merge_point
->prev
= *named_merge_points
;
3199 *named_merge_points
= new_named_merge_point
;
3207 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3208 to make it a symbol. If FACE_NAME is an alias for another face,
3209 return that face's name.
3211 Return default face in case of errors. */
3214 resolve_face_name (face_name
, signal_p
)
3215 Lisp_Object face_name
;
3218 Lisp_Object orig_face
;
3219 Lisp_Object tortoise
, hare
;
3221 if (STRINGP (face_name
))
3222 face_name
= intern (SDATA (face_name
));
3224 if (NILP (face_name
) || !SYMBOLP (face_name
))
3227 orig_face
= face_name
;
3228 tortoise
= hare
= face_name
;
3233 hare
= Fget (hare
, Qface_alias
);
3234 if (NILP (hare
) || !SYMBOLP (hare
))
3238 hare
= Fget (hare
, Qface_alias
);
3239 if (NILP (hare
) || !SYMBOLP (hare
))
3242 tortoise
= Fget (tortoise
, Qface_alias
);
3243 if (EQ (hare
, tortoise
))
3246 Fsignal (Qcircular_list
, Fcons (orig_face
, Qnil
));
3255 /* Return the face definition of FACE_NAME on frame F. F null means
3256 return the definition for new frames. FACE_NAME may be a string or
3257 a symbol (apparently Emacs 20.2 allowed strings as face names in
3258 face text properties; Ediff uses that). If FACE_NAME is an alias
3259 for another face, return that face's definition. If SIGNAL_P is
3260 non-zero, signal an error if FACE_NAME is not a valid face name.
3261 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3264 static INLINE Lisp_Object
3265 lface_from_face_name (f
, face_name
, signal_p
)
3267 Lisp_Object face_name
;
3272 face_name
= resolve_face_name (face_name
, signal_p
);
3275 lface
= assq_no_quit (face_name
, f
->face_alist
);
3277 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3280 lface
= XCDR (lface
);
3282 signal_error ("Invalid face", face_name
);
3284 check_lface (lface
);
3289 /* Get face attributes of face FACE_NAME from frame-local faces on
3290 frame F. Store the resulting attributes in ATTRS which must point
3291 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3292 is non-zero, signal an error if FACE_NAME does not name a face.
3293 Otherwise, value is zero if FACE_NAME is not a face. */
3296 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3298 Lisp_Object face_name
;
3305 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3308 bcopy (XVECTOR (lface
)->contents
, attrs
,
3309 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3319 /* Non-zero if all attributes in face attribute vector ATTRS are
3320 specified, i.e. are non-nil. */
3323 lface_fully_specified_p (attrs
)
3328 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3329 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3330 && i
!= LFACE_AVGWIDTH_INDEX
)
3331 if (UNSPECIFIEDP (attrs
[i
])
3333 /* MAC_TODO: No stipple support on Mac OS yet, this index is
3334 always unspecified. */
3335 && i
!= LFACE_STIPPLE_INDEX
3340 return i
== LFACE_VECTOR_SIZE
;
3343 #ifdef HAVE_WINDOW_SYSTEM
3345 /* Set font-related attributes of Lisp face LFACE from the fullname of
3346 the font opened by FONTNAME. If FORCE_P is zero, set only
3347 unspecified attributes of LFACE. The exception is `font'
3348 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3350 If FONTNAME is not available on frame F,
3351 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3352 If the fullname is not in a valid XLFD format,
3353 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3354 in LFACE and return 1.
3355 Otherwise, return 1. */
3358 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3361 Lisp_Object fontname
;
3362 int force_p
, may_fail_p
;
3364 struct font_name font
;
3369 char *font_name
= SDATA (fontname
);
3370 struct font_info
*font_info
;
3372 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3373 fontset
= fs_query_fontset (fontname
, 0);
3375 font_name
= SDATA (fontset_ascii (fontset
));
3377 /* Check if FONT_NAME is surely available on the system. Usually
3378 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3379 returns quickly. But, even if FONT_NAME is not yet cached,
3380 caching it now is not futail because we anyway load the font
3383 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3393 font
.name
= STRDUPA (font_info
->full_name
);
3394 have_xlfd_p
= split_font_name (f
, &font
, 1);
3396 /* Set attributes only if unspecified, otherwise face defaults for
3397 new frames would never take effect. If we couldn't get a font
3398 name conforming to XLFD, set normal values. */
3400 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3405 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3406 + strlen (font
.fields
[XLFD_FOUNDRY
])
3408 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3409 font
.fields
[XLFD_FAMILY
]);
3410 val
= build_string (buffer
);
3413 val
= build_string ("*");
3414 LFACE_FAMILY (lface
) = val
;
3417 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3420 pt
= xlfd_point_size (f
, &font
);
3422 pt
= pixel_point_size (f
, font_info
->height
* 10);
3424 LFACE_HEIGHT (lface
) = make_number (pt
);
3427 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3428 LFACE_SWIDTH (lface
)
3429 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3431 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3432 LFACE_AVGWIDTH (lface
)
3434 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3437 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3438 LFACE_WEIGHT (lface
)
3439 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3441 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3443 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3445 LFACE_FONT (lface
) = fontname
;
3450 #endif /* HAVE_WINDOW_SYSTEM */
3453 /* Merges the face height FROM with the face height TO, and returns the
3454 merged height. If FROM is an invalid height, then INVALID is
3455 returned instead. FROM and TO may be either absolute face heights or
3456 `relative' heights; the returned value is always an absolute height
3457 unless both FROM and TO are relative. GCPRO is a lisp value that
3458 will be protected from garbage-collection if this function makes a
3462 merge_face_heights (from
, to
, invalid
)
3463 Lisp_Object from
, to
, invalid
;
3465 Lisp_Object result
= invalid
;
3467 if (INTEGERP (from
))
3468 /* FROM is absolute, just use it as is. */
3470 else if (FLOATP (from
))
3471 /* FROM is a scale, use it to adjust TO. */
3474 /* relative X absolute => absolute */
3475 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3476 else if (FLOATP (to
))
3477 /* relative X relative => relative */
3478 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3479 else if (UNSPECIFIEDP (to
))
3482 else if (FUNCTIONP (from
))
3483 /* FROM is a function, which use to adjust TO. */
3485 /* Call function with current height as argument.
3486 From is the new height. */
3487 Lisp_Object args
[2];
3491 result
= safe_call (2, args
);
3493 /* Ensure that if TO was absolute, so is the result. */
3494 if (INTEGERP (to
) && !INTEGERP (result
))
3502 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3503 store the resulting attributes in TO, which must be already be
3504 completely specified and contain only absolute attributes. Every
3505 specified attribute of FROM overrides the corresponding attribute of
3506 TO; relative attributes in FROM are merged with the absolute value in
3507 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
3508 loops in face inheritance; it should be 0 when called from other
3512 merge_face_vectors (f
, from
, to
, named_merge_points
)
3514 Lisp_Object
*from
, *to
;
3515 struct named_merge_point
*named_merge_points
;
3519 /* If FROM inherits from some other faces, merge their attributes into
3520 TO before merging FROM's direct attributes. Note that an :inherit
3521 attribute of `unspecified' is the same as one of nil; we never
3522 merge :inherit attributes, so nil is more correct, but lots of
3523 other code uses `unspecified' as a generic value for face attributes. */
3524 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3525 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3526 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
3528 /* If TO specifies a :font attribute, and FROM specifies some
3529 font-related attribute, we need to clear TO's :font attribute
3530 (because it will be inconsistent with whatever FROM specifies, and
3531 FROM takes precedence). */
3532 if (!NILP (to
[LFACE_FONT_INDEX
])
3533 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3534 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3535 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3536 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3537 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3538 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3539 to
[LFACE_FONT_INDEX
] = Qnil
;
3541 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3542 if (!UNSPECIFIEDP (from
[i
]))
3544 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3545 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
3550 /* TO is always an absolute face, which should inherit from nothing.
3551 We blindly copy the :inherit attribute above and fix it up here. */
3552 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3555 /* Merge the named face FACE_NAME on frame F, into the vector of face
3556 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
3557 inheritance. Returns true if FACE_NAME is a valid face name and
3558 merging succeeded. */
3561 merge_named_face (f
, face_name
, to
, named_merge_points
)
3563 Lisp_Object face_name
;
3565 struct named_merge_point
*named_merge_points
;
3567 struct named_merge_point named_merge_point
;
3569 if (push_named_merge_point (&named_merge_point
,
3570 face_name
, &named_merge_points
))
3572 struct gcpro gcpro1
;
3573 Lisp_Object from
[LFACE_VECTOR_SIZE
];
3574 int ok
= get_lface_attributes (f
, face_name
, from
, 0);
3578 GCPRO1 (named_merge_point
.face_name
);
3579 merge_face_vectors (f
, from
, to
, named_merge_points
);
3590 /* Merge face attributes from the lisp `face reference' FACE_REF on
3591 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
3592 problems with FACE_REF cause an error message to be shown. Return
3593 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
3594 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
3595 list structure; it may be 0 for most callers.
3597 FACE_REF may be a single face specification or a list of such
3598 specifications. Each face specification can be:
3600 1. A symbol or string naming a Lisp face.
3602 2. A property list of the form (KEYWORD VALUE ...) where each
3603 KEYWORD is a face attribute name, and value is an appropriate value
3606 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3607 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3608 for compatibility with 20.2.
3610 Face specifications earlier in lists take precedence over later
3614 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
3616 Lisp_Object face_ref
;
3619 struct named_merge_point
*named_merge_points
;
3621 int ok
= 1; /* Succeed without an error? */
3623 if (CONSP (face_ref
))
3625 Lisp_Object first
= XCAR (face_ref
);
3627 if (EQ (first
, Qforeground_color
)
3628 || EQ (first
, Qbackground_color
))
3630 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3631 . COLOR). COLOR must be a string. */
3632 Lisp_Object color_name
= XCDR (face_ref
);
3633 Lisp_Object color
= first
;
3635 if (STRINGP (color_name
))
3637 if (EQ (color
, Qforeground_color
))
3638 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3640 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3645 add_to_log ("Invalid face color", color_name
, Qnil
);
3649 else if (SYMBOLP (first
)
3650 && *SDATA (SYMBOL_NAME (first
)) == ':')
3652 /* Assume this is the property list form. */
3653 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
3655 Lisp_Object keyword
= XCAR (face_ref
);
3656 Lisp_Object value
= XCAR (XCDR (face_ref
));
3659 /* Specifying `unspecified' is a no-op. */
3660 if (EQ (value
, Qunspecified
))
3662 else if (EQ (keyword
, QCfamily
))
3664 if (STRINGP (value
))
3665 to
[LFACE_FAMILY_INDEX
] = value
;
3669 else if (EQ (keyword
, QCheight
))
3671 Lisp_Object new_height
=
3672 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
3674 if (! NILP (new_height
))
3675 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3679 else if (EQ (keyword
, QCweight
))
3682 && face_numeric_weight (value
) >= 0)
3683 to
[LFACE_WEIGHT_INDEX
] = value
;
3687 else if (EQ (keyword
, QCslant
))
3690 && face_numeric_slant (value
) >= 0)
3691 to
[LFACE_SLANT_INDEX
] = value
;
3695 else if (EQ (keyword
, QCunderline
))
3700 to
[LFACE_UNDERLINE_INDEX
] = value
;
3704 else if (EQ (keyword
, QCoverline
))
3709 to
[LFACE_OVERLINE_INDEX
] = value
;
3713 else if (EQ (keyword
, QCstrike_through
))
3718 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3722 else if (EQ (keyword
, QCbox
))
3725 value
= make_number (1);
3726 if (INTEGERP (value
)
3730 to
[LFACE_BOX_INDEX
] = value
;
3734 else if (EQ (keyword
, QCinverse_video
)
3735 || EQ (keyword
, QCreverse_video
))
3737 if (EQ (value
, Qt
) || NILP (value
))
3738 to
[LFACE_INVERSE_INDEX
] = value
;
3742 else if (EQ (keyword
, QCforeground
))
3744 if (STRINGP (value
))
3745 to
[LFACE_FOREGROUND_INDEX
] = value
;
3749 else if (EQ (keyword
, QCbackground
))
3751 if (STRINGP (value
))
3752 to
[LFACE_BACKGROUND_INDEX
] = value
;
3756 else if (EQ (keyword
, QCstipple
))
3758 #ifdef HAVE_X_WINDOWS
3759 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3760 if (!NILP (pixmap_p
))
3761 to
[LFACE_STIPPLE_INDEX
] = value
;
3766 else if (EQ (keyword
, QCwidth
))
3769 && face_numeric_swidth (value
) >= 0)
3770 to
[LFACE_SWIDTH_INDEX
] = value
;
3774 else if (EQ (keyword
, QCinherit
))
3776 /* This is not really very useful; it's just like a
3777 normal face reference. */
3778 if (! merge_face_ref (f
, value
, to
,
3779 err_msgs
, named_merge_points
))
3787 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
3791 face_ref
= XCDR (XCDR (face_ref
));
3796 /* This is a list of face refs. Those at the beginning of the
3797 list take precedence over what follows, so we have to merge
3798 from the end backwards. */
3799 Lisp_Object next
= XCDR (face_ref
);
3802 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
3804 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
3810 /* FACE_REF ought to be a face name. */
3811 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
3812 if (!ok
&& err_msgs
)
3813 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
3820 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3821 Sinternal_make_lisp_face
, 1, 2, 0,
3822 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3823 If FACE was not known as a face before, create a new one.
3824 If optional argument FRAME is specified, make a frame-local face
3825 for that frame. Otherwise operate on the global face definition.
3826 Value is a vector of face attributes. */)
3828 Lisp_Object face
, frame
;
3830 Lisp_Object global_lface
, lface
;
3834 CHECK_SYMBOL (face
);
3835 global_lface
= lface_from_face_name (NULL
, face
, 0);
3839 CHECK_LIVE_FRAME (frame
);
3841 lface
= lface_from_face_name (f
, face
, 0);
3844 f
= NULL
, lface
= Qnil
;
3846 /* Add a global definition if there is none. */
3847 if (NILP (global_lface
))
3849 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3851 AREF (global_lface
, 0) = Qface
;
3852 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3853 Vface_new_frame_defaults
);
3855 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3856 face id to Lisp face is given by the vector lface_id_to_name.
3857 The mapping from Lisp face to Lisp face id is given by the
3858 property `face' of the Lisp face name. */
3859 if (next_lface_id
== lface_id_to_name_size
)
3861 int new_size
= max (50, 2 * lface_id_to_name_size
);
3862 int sz
= new_size
* sizeof *lface_id_to_name
;
3863 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3864 lface_id_to_name_size
= new_size
;
3867 lface_id_to_name
[next_lface_id
] = face
;
3868 Fput (face
, Qface
, make_number (next_lface_id
));
3872 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3873 AREF (global_lface
, i
) = Qunspecified
;
3875 /* Add a frame-local definition. */
3880 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3882 AREF (lface
, 0) = Qface
;
3883 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3886 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3887 AREF (lface
, i
) = Qunspecified
;
3890 lface
= global_lface
;
3892 /* Changing a named face means that all realized faces depending on
3893 that face are invalid. Since we cannot tell which realized faces
3894 depend on the face, make sure they are all removed. This is done
3895 by incrementing face_change_count. The next call to
3896 init_iterator will then free realized faces. */
3897 if (NILP (Fget (face
, Qface_no_inherit
)))
3899 ++face_change_count
;
3900 ++windows_or_buffers_changed
;
3903 xassert (LFACEP (lface
));
3904 check_lface (lface
);
3909 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3910 Sinternal_lisp_face_p
, 1, 2, 0,
3911 doc
: /* Return non-nil if FACE names a face.
3912 If optional second parameter FRAME is non-nil, check for the
3913 existence of a frame-local face with name FACE on that frame.
3914 Otherwise check for the existence of a global face. */)
3916 Lisp_Object face
, frame
;
3922 CHECK_LIVE_FRAME (frame
);
3923 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3926 lface
= lface_from_face_name (NULL
, face
, 0);
3932 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3933 Sinternal_copy_lisp_face
, 4, 4, 0,
3934 doc
: /* Copy face FROM to TO.
3935 If FRAME is t, copy the global face definition of FROM.
3936 Otherwise, copy the frame-local definition of FROM on FRAME.
3937 If NEW-FRAME is a frame, copy that data into the frame-local
3938 definition of TO on NEW-FRAME. If NEW-FRAME is nil.
3939 FRAME controls where the data is copied to.
3941 The value is TO. */)
3942 (from
, to
, frame
, new_frame
)
3943 Lisp_Object from
, to
, frame
, new_frame
;
3945 Lisp_Object lface
, copy
;
3947 CHECK_SYMBOL (from
);
3952 /* Copy global definition of FROM. We don't make copies of
3953 strings etc. because 20.2 didn't do it either. */
3954 lface
= lface_from_face_name (NULL
, from
, 1);
3955 copy
= Finternal_make_lisp_face (to
, Qnil
);
3959 /* Copy frame-local definition of FROM. */
3960 if (NILP (new_frame
))
3962 CHECK_LIVE_FRAME (frame
);
3963 CHECK_LIVE_FRAME (new_frame
);
3964 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3965 copy
= Finternal_make_lisp_face (to
, new_frame
);
3968 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3969 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3971 /* Changing a named face means that all realized faces depending on
3972 that face are invalid. Since we cannot tell which realized faces
3973 depend on the face, make sure they are all removed. This is done
3974 by incrementing face_change_count. The next call to
3975 init_iterator will then free realized faces. */
3976 if (NILP (Fget (to
, Qface_no_inherit
)))
3978 ++face_change_count
;
3979 ++windows_or_buffers_changed
;
3986 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3987 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3988 doc
: /* Set attribute ATTR of FACE to VALUE.
3989 FRAME being a frame means change the face on that frame.
3990 FRAME nil means change the face of the selected frame.
3991 FRAME t means change the default for new frames.
3992 FRAME 0 means change the face on all frames, and change the default
3994 (face
, attr
, value
, frame
)
3995 Lisp_Object face
, attr
, value
, frame
;
3998 Lisp_Object old_value
= Qnil
;
3999 /* Set 1 if ATTR is QCfont. */
4000 int font_attr_p
= 0;
4001 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
4002 int font_related_attr_p
= 0;
4004 CHECK_SYMBOL (face
);
4005 CHECK_SYMBOL (attr
);
4007 face
= resolve_face_name (face
, 1);
4009 /* If FRAME is 0, change face on all frames, and change the
4010 default for new frames. */
4011 if (INTEGERP (frame
) && XINT (frame
) == 0)
4014 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
4015 FOR_EACH_FRAME (tail
, frame
)
4016 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4020 /* Set lface to the Lisp attribute vector of FACE. */
4022 lface
= lface_from_face_name (NULL
, face
, 1);
4026 frame
= selected_frame
;
4028 CHECK_LIVE_FRAME (frame
);
4029 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4031 /* If a frame-local face doesn't exist yet, create one. */
4033 lface
= Finternal_make_lisp_face (face
, frame
);
4036 if (EQ (attr
, QCfamily
))
4038 if (!UNSPECIFIEDP (value
))
4040 CHECK_STRING (value
);
4041 if (SCHARS (value
) == 0)
4042 signal_error ("Invalid face family", value
);
4044 old_value
= LFACE_FAMILY (lface
);
4045 LFACE_FAMILY (lface
) = value
;
4046 font_related_attr_p
= 1;
4048 else if (EQ (attr
, QCheight
))
4050 if (!UNSPECIFIEDP (value
))
4054 test
= (EQ (face
, Qdefault
)
4056 /* The default face must have an absolute size,
4057 otherwise, we do a test merge with a random
4058 height to see if VALUE's ok. */
4059 : merge_face_heights (value
, make_number (10), Qnil
));
4061 if (!INTEGERP (test
) || XINT (test
) <= 0)
4062 signal_error ("Invalid face height", value
);
4065 old_value
= LFACE_HEIGHT (lface
);
4066 LFACE_HEIGHT (lface
) = value
;
4067 font_related_attr_p
= 1;
4069 else if (EQ (attr
, QCweight
))
4071 if (!UNSPECIFIEDP (value
))
4073 CHECK_SYMBOL (value
);
4074 if (face_numeric_weight (value
) < 0)
4075 signal_error ("Invalid face weight", value
);
4077 old_value
= LFACE_WEIGHT (lface
);
4078 LFACE_WEIGHT (lface
) = value
;
4079 font_related_attr_p
= 1;
4081 else if (EQ (attr
, QCslant
))
4083 if (!UNSPECIFIEDP (value
))
4085 CHECK_SYMBOL (value
);
4086 if (face_numeric_slant (value
) < 0)
4087 signal_error ("Invalid face slant", value
);
4089 old_value
= LFACE_SLANT (lface
);
4090 LFACE_SLANT (lface
) = value
;
4091 font_related_attr_p
= 1;
4093 else if (EQ (attr
, QCunderline
))
4095 if (!UNSPECIFIEDP (value
))
4096 if ((SYMBOLP (value
)
4098 && !EQ (value
, Qnil
))
4099 /* Underline color. */
4101 && SCHARS (value
) == 0))
4102 signal_error ("Invalid face underline", value
);
4104 old_value
= LFACE_UNDERLINE (lface
);
4105 LFACE_UNDERLINE (lface
) = value
;
4107 else if (EQ (attr
, QCoverline
))
4109 if (!UNSPECIFIEDP (value
))
4110 if ((SYMBOLP (value
)
4112 && !EQ (value
, Qnil
))
4113 /* Overline color. */
4115 && SCHARS (value
) == 0))
4116 signal_error ("Invalid face overline", value
);
4118 old_value
= LFACE_OVERLINE (lface
);
4119 LFACE_OVERLINE (lface
) = value
;
4121 else if (EQ (attr
, QCstrike_through
))
4123 if (!UNSPECIFIEDP (value
))
4124 if ((SYMBOLP (value
)
4126 && !EQ (value
, Qnil
))
4127 /* Strike-through color. */
4129 && SCHARS (value
) == 0))
4130 signal_error ("Invalid face strike-through", value
);
4132 old_value
= LFACE_STRIKE_THROUGH (lface
);
4133 LFACE_STRIKE_THROUGH (lface
) = value
;
4135 else if (EQ (attr
, QCbox
))
4139 /* Allow t meaning a simple box of width 1 in foreground color
4142 value
= make_number (1);
4144 if (UNSPECIFIEDP (value
))
4146 else if (NILP (value
))
4148 else if (INTEGERP (value
))
4149 valid_p
= XINT (value
) != 0;
4150 else if (STRINGP (value
))
4151 valid_p
= SCHARS (value
) > 0;
4152 else if (CONSP (value
))
4168 if (EQ (k
, QCline_width
))
4170 if (!INTEGERP (v
) || XINT (v
) == 0)
4173 else if (EQ (k
, QCcolor
))
4175 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
4178 else if (EQ (k
, QCstyle
))
4180 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4187 valid_p
= NILP (tem
);
4193 signal_error ("Invalid face box", value
);
4195 old_value
= LFACE_BOX (lface
);
4196 LFACE_BOX (lface
) = value
;
4198 else if (EQ (attr
, QCinverse_video
)
4199 || EQ (attr
, QCreverse_video
))
4201 if (!UNSPECIFIEDP (value
))
4203 CHECK_SYMBOL (value
);
4204 if (!EQ (value
, Qt
) && !NILP (value
))
4205 signal_error ("Invalid inverse-video face attribute value", value
);
4207 old_value
= LFACE_INVERSE (lface
);
4208 LFACE_INVERSE (lface
) = value
;
4210 else if (EQ (attr
, QCforeground
))
4212 if (!UNSPECIFIEDP (value
))
4214 /* Don't check for valid color names here because it depends
4215 on the frame (display) whether the color will be valid
4216 when the face is realized. */
4217 CHECK_STRING (value
);
4218 if (SCHARS (value
) == 0)
4219 signal_error ("Empty foreground color value", value
);
4221 old_value
= LFACE_FOREGROUND (lface
);
4222 LFACE_FOREGROUND (lface
) = value
;
4224 else if (EQ (attr
, QCbackground
))
4226 if (!UNSPECIFIEDP (value
))
4228 /* Don't check for valid color names here because it depends
4229 on the frame (display) whether the color will be valid
4230 when the face is realized. */
4231 CHECK_STRING (value
);
4232 if (SCHARS (value
) == 0)
4233 signal_error ("Empty background color value", value
);
4235 old_value
= LFACE_BACKGROUND (lface
);
4236 LFACE_BACKGROUND (lface
) = value
;
4238 else if (EQ (attr
, QCstipple
))
4240 #ifdef HAVE_X_WINDOWS
4241 if (!UNSPECIFIEDP (value
)
4243 && NILP (Fbitmap_spec_p (value
)))
4244 signal_error ("Invalid stipple attribute", value
);
4245 old_value
= LFACE_STIPPLE (lface
);
4246 LFACE_STIPPLE (lface
) = value
;
4247 #endif /* HAVE_X_WINDOWS */
4249 else if (EQ (attr
, QCwidth
))
4251 if (!UNSPECIFIEDP (value
))
4253 CHECK_SYMBOL (value
);
4254 if (face_numeric_swidth (value
) < 0)
4255 signal_error ("Invalid face width", value
);
4257 old_value
= LFACE_SWIDTH (lface
);
4258 LFACE_SWIDTH (lface
) = value
;
4259 font_related_attr_p
= 1;
4261 else if (EQ (attr
, QCfont
))
4263 #ifdef HAVE_WINDOW_SYSTEM
4264 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4266 /* Set font-related attributes of the Lisp face from an XLFD
4272 f
= SELECTED_FRAME ();
4274 f
= check_x_frame (frame
);
4276 if (!UNSPECIFIEDP (value
))
4278 CHECK_STRING (value
);
4280 /* VALUE may be a fontset name or an alias of fontset. In
4281 such a case, use the base fontset name. */
4282 tmp
= Fquery_fontset (value
, Qnil
);
4286 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4287 signal_error ("Invalid font or fontset name", value
);
4292 #endif /* HAVE_WINDOW_SYSTEM */
4294 else if (EQ (attr
, QCinherit
))
4297 if (SYMBOLP (value
))
4300 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4301 if (!SYMBOLP (XCAR (tail
)))
4304 LFACE_INHERIT (lface
) = value
;
4306 signal_error ("Invalid face inheritance", value
);
4308 else if (EQ (attr
, QCbold
))
4310 old_value
= LFACE_WEIGHT (lface
);
4311 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4312 font_related_attr_p
= 1;
4314 else if (EQ (attr
, QCitalic
))
4316 old_value
= LFACE_SLANT (lface
);
4317 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4318 font_related_attr_p
= 1;
4321 signal_error ("Invalid face attribute name", attr
);
4323 if (font_related_attr_p
4324 && !UNSPECIFIEDP (value
))
4325 /* If a font-related attribute other than QCfont is specified, the
4326 original `font' attribute nor that of default face is useless
4327 to determine a new font. Thus, we set it to nil so that font
4328 selection mechanism doesn't use it. */
4329 LFACE_FONT (lface
) = Qnil
;
4331 /* Changing a named face means that all realized faces depending on
4332 that face are invalid. Since we cannot tell which realized faces
4333 depend on the face, make sure they are all removed. This is done
4334 by incrementing face_change_count. The next call to
4335 init_iterator will then free realized faces. */
4337 && NILP (Fget (face
, Qface_no_inherit
))
4338 && (EQ (attr
, QCfont
)
4339 || NILP (Fequal (old_value
, value
))))
4341 ++face_change_count
;
4342 ++windows_or_buffers_changed
;
4345 if (!UNSPECIFIEDP (value
)
4346 && NILP (Fequal (old_value
, value
)))
4352 if (EQ (face
, Qdefault
))
4354 #ifdef HAVE_WINDOW_SYSTEM
4355 /* Changed font-related attributes of the `default' face are
4356 reflected in changed `font' frame parameters. */
4358 && (font_related_attr_p
|| font_attr_p
)
4359 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4360 set_font_frame_param (frame
, lface
);
4362 #endif /* HAVE_WINDOW_SYSTEM */
4364 if (EQ (attr
, QCforeground
))
4365 param
= Qforeground_color
;
4366 else if (EQ (attr
, QCbackground
))
4367 param
= Qbackground_color
;
4369 #ifdef HAVE_WINDOW_SYSTEM
4371 else if (EQ (face
, Qscroll_bar
))
4373 /* Changing the colors of `scroll-bar' sets frame parameters
4374 `scroll-bar-foreground' and `scroll-bar-background'. */
4375 if (EQ (attr
, QCforeground
))
4376 param
= Qscroll_bar_foreground
;
4377 else if (EQ (attr
, QCbackground
))
4378 param
= Qscroll_bar_background
;
4380 #endif /* not WINDOWSNT */
4381 else if (EQ (face
, Qborder
))
4383 /* Changing background color of `border' sets frame parameter
4385 if (EQ (attr
, QCbackground
))
4386 param
= Qborder_color
;
4388 else if (EQ (face
, Qcursor
))
4390 /* Changing background color of `cursor' sets frame parameter
4392 if (EQ (attr
, QCbackground
))
4393 param
= Qcursor_color
;
4395 else if (EQ (face
, Qmouse
))
4397 /* Changing background color of `mouse' sets frame parameter
4399 if (EQ (attr
, QCbackground
))
4400 param
= Qmouse_color
;
4402 #endif /* HAVE_WINDOW_SYSTEM */
4403 else if (EQ (face
, Qmenu
))
4405 /* Indicate that we have to update the menu bar when
4406 realizing faces on FRAME. FRAME t change the
4407 default for new frames. We do this by setting
4408 setting the flag in new face caches */
4411 struct frame
*f
= XFRAME (frame
);
4412 if (FRAME_FACE_CACHE (f
) == NULL
)
4413 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4414 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4417 menu_face_changed_default
= 1;
4423 /* Update `default-frame-alist', which is used for new frames. */
4425 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4428 /* Update the current frame's parameters. */
4431 cons
= XCAR (Vparam_value_alist
);
4432 XSETCAR (cons
, param
);
4433 XSETCDR (cons
, value
);
4434 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4443 #ifdef HAVE_WINDOW_SYSTEM
4445 /* Set the `font' frame parameter of FRAME determined from `default'
4446 face attributes LFACE. If a face or fontset name is explicitely
4447 specfied in LFACE, use it as is. Otherwise, determine a font name
4448 from the other font-related atrributes of LFACE. In that case, if
4449 there's no matching font, signals an error. */
4452 set_font_frame_param (frame
, lface
)
4453 Lisp_Object frame
, lface
;
4455 struct frame
*f
= XFRAME (frame
);
4457 if (FRAME_WINDOW_P (f
))
4459 Lisp_Object font_name
;
4462 if (STRINGP (LFACE_FONT (lface
)))
4463 font_name
= LFACE_FONT (lface
);
4466 /* Choose a font name that reflects LFACE's attributes and has
4467 the registry and encoding pattern specified in the default
4468 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4469 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0, 0);
4471 error ("No font matches the specified attribute");
4472 font_name
= build_string (font
);
4476 f
->default_face_done_p
= 0;
4477 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4482 /* Update the corresponding face when frame parameter PARAM on frame F
4483 has been assigned the value NEW_VALUE. */
4486 update_face_from_frame_parameter (f
, param
, new_value
)
4488 Lisp_Object param
, new_value
;
4490 Lisp_Object face
= Qnil
;
4493 /* If there are no faces yet, give up. This is the case when called
4494 from Fx_create_frame, and we do the necessary things later in
4495 face-set-after-frame-defaults. */
4496 if (NILP (f
->face_alist
))
4499 if (EQ (param
, Qforeground_color
))
4502 lface
= lface_from_face_name (f
, face
, 1);
4503 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4504 ? new_value
: Qunspecified
);
4505 realize_basic_faces (f
);
4507 else if (EQ (param
, Qbackground_color
))
4511 /* Changing the background color might change the background
4512 mode, so that we have to load new defface specs.
4513 Call frame-set-background-mode to do that. */
4514 XSETFRAME (frame
, f
);
4515 call1 (Qframe_set_background_mode
, frame
);
4518 lface
= lface_from_face_name (f
, face
, 1);
4519 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4520 ? new_value
: Qunspecified
);
4521 realize_basic_faces (f
);
4523 else if (EQ (param
, Qborder_color
))
4526 lface
= lface_from_face_name (f
, face
, 1);
4527 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4528 ? new_value
: Qunspecified
);
4530 else if (EQ (param
, Qcursor_color
))
4533 lface
= lface_from_face_name (f
, face
, 1);
4534 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4535 ? new_value
: Qunspecified
);
4537 else if (EQ (param
, Qmouse_color
))
4540 lface
= lface_from_face_name (f
, face
, 1);
4541 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4542 ? new_value
: Qunspecified
);
4545 /* Changing a named face means that all realized faces depending on
4546 that face are invalid. Since we cannot tell which realized faces
4547 depend on the face, make sure they are all removed. This is done
4548 by incrementing face_change_count. The next call to
4549 init_iterator will then free realized faces. */
4551 && NILP (Fget (face
, Qface_no_inherit
)))
4553 ++face_change_count
;
4554 ++windows_or_buffers_changed
;
4559 /* Get the value of X resource RESOURCE, class CLASS for the display
4560 of frame FRAME. This is here because ordinary `x-get-resource'
4561 doesn't take a frame argument. */
4563 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4564 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4565 (resource
, class, frame
)
4566 Lisp_Object resource
, class, frame
;
4568 Lisp_Object value
= Qnil
;
4569 CHECK_STRING (resource
);
4570 CHECK_STRING (class);
4571 CHECK_LIVE_FRAME (frame
);
4573 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4574 resource
, class, Qnil
, Qnil
);
4580 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4581 If VALUE is "on" or "true", return t. If VALUE is "off" or
4582 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4583 error; if SIGNAL_P is zero, return 0. */
4586 face_boolean_x_resource_value (value
, signal_p
)
4590 Lisp_Object result
= make_number (0);
4592 xassert (STRINGP (value
));
4594 if (xstricmp (SDATA (value
), "on") == 0
4595 || xstricmp (SDATA (value
), "true") == 0)
4597 else if (xstricmp (SDATA (value
), "off") == 0
4598 || xstricmp (SDATA (value
), "false") == 0)
4600 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4601 result
= Qunspecified
;
4603 signal_error ("Invalid face attribute value from X resource", value
);
4609 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4610 Finternal_set_lisp_face_attribute_from_resource
,
4611 Sinternal_set_lisp_face_attribute_from_resource
,
4612 3, 4, 0, doc
: /* */)
4613 (face
, attr
, value
, frame
)
4614 Lisp_Object face
, attr
, value
, frame
;
4616 CHECK_SYMBOL (face
);
4617 CHECK_SYMBOL (attr
);
4618 CHECK_STRING (value
);
4620 if (xstricmp (SDATA (value
), "unspecified") == 0)
4621 value
= Qunspecified
;
4622 else if (EQ (attr
, QCheight
))
4624 value
= Fstring_to_number (value
, make_number (10));
4625 if (XINT (value
) <= 0)
4626 signal_error ("Invalid face height from X resource", value
);
4628 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4629 value
= face_boolean_x_resource_value (value
, 1);
4630 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4631 value
= intern (SDATA (value
));
4632 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4633 value
= face_boolean_x_resource_value (value
, 1);
4634 else if (EQ (attr
, QCunderline
)
4635 || EQ (attr
, QCoverline
)
4636 || EQ (attr
, QCstrike_through
))
4638 Lisp_Object boolean_value
;
4640 /* If the result of face_boolean_x_resource_value is t or nil,
4641 VALUE does NOT specify a color. */
4642 boolean_value
= face_boolean_x_resource_value (value
, 0);
4643 if (SYMBOLP (boolean_value
))
4644 value
= boolean_value
;
4646 else if (EQ (attr
, QCbox
))
4647 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4649 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4652 #endif /* HAVE_WINDOW_SYSTEM */
4655 /***********************************************************************
4657 ***********************************************************************/
4659 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4661 /* Make menus on frame F appear as specified by the `menu' face. */
4664 x_update_menu_appearance (f
)
4667 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4671 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4675 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4676 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4677 const char *myname
= SDATA (Vx_resource_name
);
4680 const char *popup_path
= "popup_menu";
4682 const char *popup_path
= "menu.popup";
4685 if (STRINGP (LFACE_FOREGROUND (lface
)))
4687 sprintf (line
, "%s.%s*foreground: %s",
4689 SDATA (LFACE_FOREGROUND (lface
)));
4690 XrmPutLineResource (&rdb
, line
);
4691 sprintf (line
, "%s.pane.menubar*foreground: %s",
4692 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4693 XrmPutLineResource (&rdb
, line
);
4697 if (STRINGP (LFACE_BACKGROUND (lface
)))
4699 sprintf (line
, "%s.%s*background: %s",
4701 SDATA (LFACE_BACKGROUND (lface
)));
4702 XrmPutLineResource (&rdb
, line
);
4703 sprintf (line
, "%s.pane.menubar*background: %s",
4704 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4705 XrmPutLineResource (&rdb
, line
);
4710 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4711 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4712 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4713 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4714 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4715 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4718 const char *suffix
= "List";
4721 #if defined HAVE_X_I18N
4723 const char *suffix
= "Set";
4725 const char *suffix
= "";
4729 #if defined HAVE_X_I18N
4730 extern char *xic_create_fontsetname
4731 P_ ((char *base_fontname
, Bool motif
));
4732 char *fontsetname
= xic_create_fontsetname (face
->font_name
, motif
);
4734 char *fontsetname
= face
->font_name
;
4736 sprintf (line
, "%s.pane.menubar*font%s: %s",
4737 myname
, suffix
, fontsetname
);
4738 XrmPutLineResource (&rdb
, line
);
4739 sprintf (line
, "%s.%s*font%s: %s",
4740 myname
, popup_path
, suffix
, fontsetname
);
4741 XrmPutLineResource (&rdb
, line
);
4743 if (fontsetname
!= face
->font_name
)
4744 xfree (fontsetname
);
4747 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4748 free_frame_menubar (f
);
4752 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4755 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4756 Sface_attribute_relative_p
,
4758 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4760 Lisp_Object attribute
, value
;
4762 if (EQ (value
, Qunspecified
))
4764 else if (EQ (attribute
, QCheight
))
4765 return INTEGERP (value
) ? Qnil
: Qt
;
4770 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4772 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4773 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4774 the result will be absolute, otherwise it will be relative. */)
4775 (attribute
, value1
, value2
)
4776 Lisp_Object attribute
, value1
, value2
;
4778 if (EQ (value1
, Qunspecified
))
4780 else if (EQ (attribute
, QCheight
))
4781 return merge_face_heights (value1
, value2
, value1
);
4787 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4788 Sinternal_get_lisp_face_attribute
,
4790 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4791 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4792 face attribute name, signal an error.
4793 If the optional argument FRAME is given, report on face SYMBOL in that
4794 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
4795 frames). If FRAME is omitted or nil, use the selected frame. */)
4796 (symbol
, keyword
, frame
)
4797 Lisp_Object symbol
, keyword
, frame
;
4799 Lisp_Object lface
, value
= Qnil
;
4801 CHECK_SYMBOL (symbol
);
4802 CHECK_SYMBOL (keyword
);
4805 lface
= lface_from_face_name (NULL
, symbol
, 1);
4809 frame
= selected_frame
;
4810 CHECK_LIVE_FRAME (frame
);
4811 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4814 if (EQ (keyword
, QCfamily
))
4815 value
= LFACE_FAMILY (lface
);
4816 else if (EQ (keyword
, QCheight
))
4817 value
= LFACE_HEIGHT (lface
);
4818 else if (EQ (keyword
, QCweight
))
4819 value
= LFACE_WEIGHT (lface
);
4820 else if (EQ (keyword
, QCslant
))
4821 value
= LFACE_SLANT (lface
);
4822 else if (EQ (keyword
, QCunderline
))
4823 value
= LFACE_UNDERLINE (lface
);
4824 else if (EQ (keyword
, QCoverline
))
4825 value
= LFACE_OVERLINE (lface
);
4826 else if (EQ (keyword
, QCstrike_through
))
4827 value
= LFACE_STRIKE_THROUGH (lface
);
4828 else if (EQ (keyword
, QCbox
))
4829 value
= LFACE_BOX (lface
);
4830 else if (EQ (keyword
, QCinverse_video
)
4831 || EQ (keyword
, QCreverse_video
))
4832 value
= LFACE_INVERSE (lface
);
4833 else if (EQ (keyword
, QCforeground
))
4834 value
= LFACE_FOREGROUND (lface
);
4835 else if (EQ (keyword
, QCbackground
))
4836 value
= LFACE_BACKGROUND (lface
);
4837 else if (EQ (keyword
, QCstipple
))
4838 value
= LFACE_STIPPLE (lface
);
4839 else if (EQ (keyword
, QCwidth
))
4840 value
= LFACE_SWIDTH (lface
);
4841 else if (EQ (keyword
, QCinherit
))
4842 value
= LFACE_INHERIT (lface
);
4843 else if (EQ (keyword
, QCfont
))
4844 value
= LFACE_FONT (lface
);
4846 signal_error ("Invalid face attribute name", keyword
);
4852 DEFUN ("internal-lisp-face-attribute-values",
4853 Finternal_lisp_face_attribute_values
,
4854 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4855 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4856 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4860 Lisp_Object result
= Qnil
;
4862 CHECK_SYMBOL (attr
);
4864 if (EQ (attr
, QCweight
)
4865 || EQ (attr
, QCslant
)
4866 || EQ (attr
, QCwidth
))
4868 /* Extract permissible symbols from tables. */
4869 struct table_entry
*table
;
4872 if (EQ (attr
, QCweight
))
4873 table
= weight_table
, dim
= DIM (weight_table
);
4874 else if (EQ (attr
, QCslant
))
4875 table
= slant_table
, dim
= DIM (slant_table
);
4877 table
= swidth_table
, dim
= DIM (swidth_table
);
4879 for (i
= 0; i
< dim
; ++i
)
4881 Lisp_Object symbol
= *table
[i
].symbol
;
4882 Lisp_Object tail
= result
;
4885 && !EQ (XCAR (tail
), symbol
))
4889 result
= Fcons (symbol
, result
);
4892 else if (EQ (attr
, QCunderline
))
4893 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4894 else if (EQ (attr
, QCoverline
))
4895 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4896 else if (EQ (attr
, QCstrike_through
))
4897 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4898 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4899 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4905 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4906 Sinternal_merge_in_global_face
, 2, 2, 0,
4907 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4908 Default face attributes override any local face attributes. */)
4910 Lisp_Object face
, frame
;
4913 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4915 CHECK_LIVE_FRAME (frame
);
4916 global_lface
= lface_from_face_name (NULL
, face
, 1);
4917 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4918 if (NILP (local_lface
))
4919 local_lface
= Finternal_make_lisp_face (face
, frame
);
4921 /* Make every specified global attribute override the local one.
4922 BEWARE!! This is only used from `face-set-after-frame-default' where
4923 the local frame is defined from default specs in `face-defface-spec'
4924 and those should be overridden by global settings. Hence the strange
4925 "global before local" priority. */
4926 lvec
= XVECTOR (local_lface
)->contents
;
4927 gvec
= XVECTOR (global_lface
)->contents
;
4928 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4929 if (! UNSPECIFIEDP (gvec
[i
]))
4936 /* The following function is implemented for compatibility with 20.2.
4937 The function is used in x-resolve-fonts when it is asked to
4938 return fonts with the same size as the font of a face. This is
4939 done in fontset.el. */
4941 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4942 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4943 If the optional argument FRAME is given, report on face FACE in that frame.
4944 If FRAME is t, report on the defaults for face FACE (for new frames).
4945 The font default for a face is either nil, or a list
4946 of the form (bold), (italic) or (bold italic).
4947 If FRAME is omitted or nil, use the selected frame. */)
4949 Lisp_Object face
, frame
;
4953 Lisp_Object result
= Qnil
;
4954 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4956 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4957 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4958 result
= Fcons (Qbold
, result
);
4960 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4961 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4962 result
= Fcons (Qitalic
, result
);
4968 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4969 int face_id
= lookup_named_face (f
, face
, 0, 1);
4970 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4971 return face
? build_string (face
->font_name
) : Qnil
;
4976 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
4977 all attributes are `equal'. Tries to be fast because this function
4978 is called quite often. */
4981 face_attr_equal_p (v1
, v2
)
4984 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4985 and the other is specified. */
4986 if (XTYPE (v1
) != XTYPE (v2
))
4995 if (SBYTES (v1
) != SBYTES (v2
))
4998 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
5005 return !NILP (Fequal (v1
, v2
));
5010 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
5011 all attributes are `equal'. Tries to be fast because this function
5012 is called quite often. */
5015 lface_equal_p (v1
, v2
)
5016 Lisp_Object
*v1
, *v2
;
5020 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
5021 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
5027 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
5028 Sinternal_lisp_face_equal_p
, 2, 3, 0,
5029 doc
: /* True if FACE1 and FACE2 are equal.
5030 If the optional argument FRAME is given, report on FACE1 and FACE2 in that frame.
5031 If FRAME is t, report on the defaults for FACE1 and FACE2 (for new frames).
5032 If FRAME is omitted or nil, use the selected frame. */)
5033 (face1
, face2
, frame
)
5034 Lisp_Object face1
, face2
, frame
;
5038 Lisp_Object lface1
, lface2
;
5043 /* Don't use check_x_frame here because this function is called
5044 before X frames exist. At that time, if FRAME is nil,
5045 selected_frame will be used which is the frame dumped with
5046 Emacs. That frame is not an X frame. */
5047 f
= frame_or_selected_frame (frame
, 2);
5049 lface1
= lface_from_face_name (f
, face1
, 1);
5050 lface2
= lface_from_face_name (f
, face2
, 1);
5051 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
5052 XVECTOR (lface2
)->contents
);
5053 return equal_p
? Qt
: Qnil
;
5057 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
5058 Sinternal_lisp_face_empty_p
, 1, 2, 0,
5059 doc
: /* True if FACE has no attribute specified.
5060 If the optional argument FRAME is given, report on face FACE in that frame.
5061 If FRAME is t, report on the defaults for face FACE (for new frames).
5062 If FRAME is omitted or nil, use the selected frame. */)
5064 Lisp_Object face
, frame
;
5071 frame
= selected_frame
;
5072 CHECK_LIVE_FRAME (frame
);
5076 lface
= lface_from_face_name (NULL
, face
, 1);
5078 lface
= lface_from_face_name (f
, face
, 1);
5080 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5081 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5084 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5088 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5090 doc
: /* Return an alist of frame-local faces defined on FRAME.
5091 For internal use only. */)
5095 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5096 return f
->face_alist
;
5100 /* Return a hash code for Lisp string STRING with case ignored. Used
5101 below in computing a hash value for a Lisp face. */
5103 static INLINE
unsigned
5104 hash_string_case_insensitive (string
)
5107 const unsigned char *s
;
5109 xassert (STRINGP (string
));
5110 for (s
= SDATA (string
); *s
; ++s
)
5111 hash
= (hash
<< 1) ^ tolower (*s
);
5116 /* Return a hash code for face attribute vector V. */
5118 static INLINE
unsigned
5122 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5123 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5124 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5125 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5126 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5127 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5128 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5132 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5133 considering charsets/registries). They do if they specify the same
5134 family, point size, weight, width, slant, and fontset. Both LFACE1
5135 and LFACE2 must be fully-specified. */
5138 lface_same_font_attributes_p (lface1
, lface2
)
5139 Lisp_Object
*lface1
, *lface2
;
5141 xassert (lface_fully_specified_p (lface1
)
5142 && lface_fully_specified_p (lface2
));
5143 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5144 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5145 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5146 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5147 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5148 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5149 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5150 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5151 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5152 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5153 && xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5154 SDATA (lface2
[LFACE_FONT_INDEX
])))));
5159 /***********************************************************************
5161 ***********************************************************************/
5163 /* Allocate and return a new realized face for Lisp face attribute
5166 static struct face
*
5167 make_realized_face (attr
)
5170 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5171 bzero (face
, sizeof *face
);
5172 face
->ascii_face
= face
;
5173 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5178 /* Free realized face FACE, including its X resources. FACE may
5182 free_realized_face (f
, face
)
5188 #ifdef HAVE_WINDOW_SYSTEM
5189 if (FRAME_WINDOW_P (f
))
5191 /* Free fontset of FACE if it is ASCII face. */
5192 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5193 free_face_fontset (f
, face
);
5196 x_free_gc (f
, face
->gc
);
5200 free_face_colors (f
, face
);
5201 x_destroy_bitmap (f
, face
->stipple
);
5203 #endif /* HAVE_WINDOW_SYSTEM */
5210 /* Prepare face FACE for subsequent display on frame F. This
5211 allocated GCs if they haven't been allocated yet or have been freed
5212 by clearing the face cache. */
5215 prepare_face_for_display (f
, face
)
5219 #ifdef HAVE_WINDOW_SYSTEM
5220 xassert (FRAME_WINDOW_P (f
));
5225 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5227 xgcv
.foreground
= face
->foreground
;
5228 xgcv
.background
= face
->background
;
5229 #ifdef HAVE_X_WINDOWS
5230 xgcv
.graphics_exposures
= False
;
5232 /* The font of FACE may be null if we couldn't load it. */
5235 #ifdef HAVE_X_WINDOWS
5236 xgcv
.font
= face
->font
->fid
;
5239 xgcv
.font
= face
->font
;
5242 xgcv
.font
= face
->font
;
5248 #ifdef HAVE_X_WINDOWS
5251 xgcv
.fill_style
= FillOpaqueStippled
;
5252 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5253 mask
|= GCFillStyle
| GCStipple
;
5256 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5259 #endif /* HAVE_WINDOW_SYSTEM */
5263 /* Returns the `distance' between the colors X and Y. */
5266 color_distance (x
, y
)
5269 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5270 Quoting from that paper:
5272 This formula has results that are very close to L*u*v* (with the
5273 modified lightness curve) and, more importantly, it is a more even
5274 algorithm: it does not have a range of colours where it suddenly
5275 gives far from optimal results.
5277 See <http://www.compuphase.com/cmetric.htm> for more info. */
5279 long r
= (x
->red
- y
->red
) >> 8;
5280 long g
= (x
->green
- y
->green
) >> 8;
5281 long b
= (x
->blue
- y
->blue
) >> 8;
5282 long r_mean
= (x
->red
+ y
->red
) >> 9;
5285 (((512 + r_mean
) * r
* r
) >> 8)
5287 + (((767 - r_mean
) * b
* b
) >> 8);
5291 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5292 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5293 COLOR1 and COLOR2 may be either strings containing the color name,
5294 or lists of the form (RED GREEN BLUE).
5295 If FRAME is unspecified or nil, the current frame is used. */)
5296 (color1
, color2
, frame
)
5297 Lisp_Object color1
, color2
, frame
;
5300 XColor cdef1
, cdef2
;
5303 frame
= selected_frame
;
5304 CHECK_LIVE_FRAME (frame
);
5307 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5308 || !STRINGP (color1
)
5309 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5310 signal_error ("Invalid color", color1
);
5311 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5312 || !STRINGP (color2
)
5313 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5314 signal_error ("Invalid color", color2
);
5316 return make_number (color_distance (&cdef1
, &cdef2
));
5320 /***********************************************************************
5322 ***********************************************************************/
5324 /* Return a new face cache for frame F. */
5326 static struct face_cache
*
5330 struct face_cache
*c
;
5333 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5334 bzero (c
, sizeof *c
);
5335 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5336 c
->buckets
= (struct face
**) xmalloc (size
);
5337 bzero (c
->buckets
, size
);
5339 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5341 c
->menu_face_changed_p
= menu_face_changed_default
;
5346 /* Clear out all graphics contexts for all realized faces, except for
5347 the basic faces. This should be done from time to time just to avoid
5348 keeping too many graphics contexts that are no longer needed. */
5352 struct face_cache
*c
;
5354 if (c
&& FRAME_WINDOW_P (c
->f
))
5356 #ifdef HAVE_WINDOW_SYSTEM
5358 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5360 struct face
*face
= c
->faces_by_id
[i
];
5361 if (face
&& face
->gc
)
5363 x_free_gc (c
->f
, face
->gc
);
5367 #endif /* HAVE_WINDOW_SYSTEM */
5372 /* Free all realized faces in face cache C, including basic faces.
5373 C may be null. If faces are freed, make sure the frame's current
5374 matrix is marked invalid, so that a display caused by an expose
5375 event doesn't try to use faces we destroyed. */
5378 free_realized_faces (c
)
5379 struct face_cache
*c
;
5384 struct frame
*f
= c
->f
;
5386 /* We must block input here because we can't process X events
5387 safely while only some faces are freed, or when the frame's
5388 current matrix still references freed faces. */
5391 for (i
= 0; i
< c
->used
; ++i
)
5393 free_realized_face (f
, c
->faces_by_id
[i
]);
5394 c
->faces_by_id
[i
] = NULL
;
5398 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5399 bzero (c
->buckets
, size
);
5401 /* Must do a thorough redisplay the next time. Mark current
5402 matrices as invalid because they will reference faces freed
5403 above. This function is also called when a frame is
5404 destroyed. In this case, the root window of F is nil. */
5405 if (WINDOWP (f
->root_window
))
5407 clear_current_matrices (f
);
5408 ++windows_or_buffers_changed
;
5416 /* Free all faces realized for multibyte characters on frame F that
5420 free_realized_multibyte_face (f
, fontset
)
5424 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5428 /* We must block input here because we can't process X events safely
5429 while only some faces are freed, or when the frame's current
5430 matrix still references freed faces. */
5433 for (i
= 0; i
< cache
->used
; i
++)
5435 face
= cache
->faces_by_id
[i
];
5437 && face
!= face
->ascii_face
5438 && face
->fontset
== fontset
)
5440 uncache_face (cache
, face
);
5441 free_realized_face (f
, face
);
5445 /* Must do a thorough redisplay the next time. Mark current
5446 matrices as invalid because they will reference faces freed
5447 above. This function is also called when a frame is destroyed.
5448 In this case, the root window of F is nil. */
5449 if (WINDOWP (f
->root_window
))
5451 clear_current_matrices (f
);
5452 ++windows_or_buffers_changed
;
5459 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5460 This is done after attributes of a named face have been changed,
5461 because we can't tell which realized faces depend on that face. */
5464 free_all_realized_faces (frame
)
5470 FOR_EACH_FRAME (rest
, frame
)
5471 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5474 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5478 /* Free face cache C and faces in it, including their X resources. */
5482 struct face_cache
*c
;
5486 free_realized_faces (c
);
5488 xfree (c
->faces_by_id
);
5494 /* Cache realized face FACE in face cache C. HASH is the hash value
5495 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5496 collision list of the face hash table of C. This is done because
5497 otherwise lookup_face would find FACE for every character, even if
5498 faces with the same attributes but for specific characters exist. */
5501 cache_face (c
, face
, hash
)
5502 struct face_cache
*c
;
5506 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5510 if (face
->fontset
>= 0)
5512 struct face
*last
= c
->buckets
[i
];
5523 c
->buckets
[i
] = face
;
5524 face
->prev
= face
->next
= NULL
;
5530 face
->next
= c
->buckets
[i
];
5532 face
->next
->prev
= face
;
5533 c
->buckets
[i
] = face
;
5536 /* Find a free slot in C->faces_by_id and use the index of the free
5537 slot as FACE->id. */
5538 for (i
= 0; i
< c
->used
; ++i
)
5539 if (c
->faces_by_id
[i
] == NULL
)
5543 /* Maybe enlarge C->faces_by_id. */
5546 if (c
->used
== c
->size
)
5549 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
5550 if (new_size
== c
->size
)
5551 abort (); /* Alternatives? ++kfs */
5552 sz
= new_size
* sizeof *c
->faces_by_id
;
5553 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5560 /* Check that FACE got a unique id. */
5565 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5566 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5572 #endif /* GLYPH_DEBUG */
5574 c
->faces_by_id
[i
] = face
;
5578 /* Remove face FACE from cache C. */
5581 uncache_face (c
, face
)
5582 struct face_cache
*c
;
5585 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5588 face
->prev
->next
= face
->next
;
5590 c
->buckets
[i
] = face
->next
;
5593 face
->next
->prev
= face
->prev
;
5595 c
->faces_by_id
[face
->id
] = NULL
;
5596 if (face
->id
== c
->used
)
5601 /* Look up a realized face with face attributes ATTR in the face cache
5602 of frame F. The face will be used to display character C. Value
5603 is the ID of the face found. If no suitable face is found, realize
5604 a new one. In that case, if C is a multibyte character, BASE_FACE
5605 is a face that has the same attributes. */
5608 lookup_face (f
, attr
, c
, base_face
)
5612 struct face
*base_face
;
5614 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5619 xassert (cache
!= NULL
);
5620 check_lface_attrs (attr
);
5622 /* Look up ATTR in the face cache. */
5623 hash
= lface_hash (attr
);
5624 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5626 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5627 if (face
->hash
== hash
5628 && (!FRAME_WINDOW_P (f
)
5629 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5630 && lface_equal_p (face
->lface
, attr
))
5633 /* If not found, realize a new face. */
5635 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5638 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5640 /* When this function is called from face_for_char (in this case, C is
5641 a multibyte character), a fontset of a face returned by
5642 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5643 C) is not sutisfied. The fontset is set for this face by
5644 face_for_char later. */
5646 if (FRAME_WINDOW_P (f
))
5647 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5649 #endif /* GLYPH_DEBUG */
5655 /* Return the face id of the realized face for named face SYMBOL on
5656 frame F suitable for displaying character C. Value is -1 if the
5657 face couldn't be determined, which might happen if the default face
5658 isn't realized and cannot be realized. */
5661 lookup_named_face (f
, symbol
, c
, signal_p
)
5667 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5668 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5669 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5671 if (default_face
== NULL
)
5673 if (!realize_basic_faces (f
))
5675 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5678 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
))
5681 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5682 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5684 return lookup_face (f
, attrs
, c
, NULL
);
5688 /* Return the ID of the realized ASCII face of Lisp face with ID
5689 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5692 ascii_face_of_lisp_face (f
, lface_id
)
5698 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5700 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5701 face_id
= lookup_named_face (f
, face_name
, 0, 1);
5710 /* Return a face for charset ASCII that is like the face with id
5711 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5712 STEPS < 0 means larger. Value is the id of the face. */
5715 smaller_face (f
, face_id
, steps
)
5719 #ifdef HAVE_WINDOW_SYSTEM
5721 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5722 int pt
, last_pt
, last_height
;
5725 struct face
*new_face
;
5727 /* If not called for an X frame, just return the original face. */
5728 if (FRAME_TERMCAP_P (f
))
5731 /* Try in increments of 1/2 pt. */
5732 delta
= steps
< 0 ? 5 : -5;
5733 steps
= abs (steps
);
5735 face
= FACE_FROM_ID (f
, face_id
);
5736 bcopy (face
->lface
, attrs
, sizeof attrs
);
5737 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5738 new_face_id
= face_id
;
5739 last_height
= FONT_HEIGHT (face
->font
);
5743 /* Give up if we cannot find a font within 10pt. */
5744 && abs (last_pt
- pt
) < 100)
5746 /* Look up a face for a slightly smaller/larger font. */
5748 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5749 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5750 new_face
= FACE_FROM_ID (f
, new_face_id
);
5752 /* If height changes, count that as one step. */
5753 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5754 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5757 last_height
= FONT_HEIGHT (new_face
->font
);
5764 #else /* not HAVE_WINDOW_SYSTEM */
5768 #endif /* not HAVE_WINDOW_SYSTEM */
5772 /* Return a face for charset ASCII that is like the face with id
5773 FACE_ID on frame F, but has height HEIGHT. */
5776 face_with_height (f
, face_id
, height
)
5781 #ifdef HAVE_WINDOW_SYSTEM
5783 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5785 if (FRAME_TERMCAP_P (f
)
5789 face
= FACE_FROM_ID (f
, face_id
);
5790 bcopy (face
->lface
, attrs
, sizeof attrs
);
5791 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5792 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5793 #endif /* HAVE_WINDOW_SYSTEM */
5799 /* Return the face id of the realized face for named face SYMBOL on
5800 frame F suitable for displaying character C, and use attributes of
5801 the face FACE_ID for attributes that aren't completely specified by
5802 SYMBOL. This is like lookup_named_face, except that the default
5803 attributes come from FACE_ID, not from the default face. FACE_ID
5804 is assumed to be already realized. */
5807 lookup_derived_face (f
, symbol
, c
, face_id
, signal_p
)
5813 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5814 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5815 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5820 get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
);
5821 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5822 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5823 return lookup_face (f
, attrs
, c
, default_face
);
5826 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5827 Sface_attributes_as_vector
, 1, 1, 0,
5828 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5833 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5835 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
5842 /***********************************************************************
5843 Face capability testing
5844 ***********************************************************************/
5847 /* If the distance (as returned by color_distance) between two colors is
5848 less than this, then they are considered the same, for determining
5849 whether a color is supported or not. The range of values is 0-65535. */
5851 #define TTY_SAME_COLOR_THRESHOLD 10000
5853 #ifdef HAVE_WINDOW_SYSTEM
5855 /* Return non-zero if all the face attributes in ATTRS are supported
5856 on the window-system frame F.
5858 The definition of `supported' is somewhat heuristic, but basically means
5859 that a face containing all the attributes in ATTRS, when merged with the
5860 default face for display, can be represented in a way that's
5862 \(1) different in appearance than the default face, and
5863 \(2) `close in spirit' to what the attributes specify, if not exact. */
5866 x_supports_face_attributes_p (f
, attrs
, def_face
)
5869 struct face
*def_face
;
5871 Lisp_Object
*def_attrs
= def_face
->lface
;
5873 /* Check that other specified attributes are different that the default
5875 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
5876 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
5877 def_attrs
[LFACE_UNDERLINE_INDEX
]))
5878 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
5879 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
5880 def_attrs
[LFACE_INVERSE_INDEX
]))
5881 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
5882 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
5883 def_attrs
[LFACE_FOREGROUND_INDEX
]))
5884 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
5885 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
5886 def_attrs
[LFACE_BACKGROUND_INDEX
]))
5887 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5888 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
5889 def_attrs
[LFACE_STIPPLE_INDEX
]))
5890 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5891 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
5892 def_attrs
[LFACE_OVERLINE_INDEX
]))
5893 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5894 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
5895 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
5896 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5897 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
5898 def_attrs
[LFACE_BOX_INDEX
])))
5901 /* Check font-related attributes, as those are the most commonly
5902 "unsupported" on a window-system (because of missing fonts). */
5903 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5904 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5905 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
5906 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
5907 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
5908 || !UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
]))
5911 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
5913 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
5915 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
5917 face
= FACE_FROM_ID (f
, lookup_face (f
, merged_attrs
, 0, 0));
5920 error ("Cannot make face");
5922 /* If the font is the same, then not supported. */
5923 if (face
->font
== def_face
->font
)
5927 /* Everything checks out, this face is supported. */
5931 #endif /* HAVE_WINDOW_SYSTEM */
5933 /* Return non-zero if all the face attributes in ATTRS are supported
5936 The definition of `supported' is somewhat heuristic, but basically means
5937 that a face containing all the attributes in ATTRS, when merged
5938 with the default face for display, can be represented in a way that's
5940 \(1) different in appearance than the default face, and
5941 \(2) `close in spirit' to what the attributes specify, if not exact.
5943 Point (2) implies that a `:weight black' attribute will be satisfied
5944 by any terminal that can display bold, and a `:foreground "yellow"' as
5945 long as the terminal can display a yellowish color, but `:slant italic'
5946 will _not_ be satisfied by the tty display code's automatic
5947 substitution of a `dim' face for italic. */
5950 tty_supports_face_attributes_p (f
, attrs
, def_face
)
5953 struct face
*def_face
;
5956 Lisp_Object val
, fg
, bg
;
5957 XColor fg_tty_color
, fg_std_color
;
5958 XColor bg_tty_color
, bg_std_color
;
5959 unsigned test_caps
= 0;
5960 Lisp_Object
*def_attrs
= def_face
->lface
;
5963 /* First check some easy-to-check stuff; ttys support none of the
5964 following attributes, so we can just return false if any are requested
5965 (even if `nominal' values are specified, we should still return false,
5966 as that will be the same value that the default face uses). We
5967 consider :slant unsupportable on ttys, even though the face code
5968 actually `fakes' them using a dim attribute if possible. This is
5969 because the faked result is too different from what the face
5971 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
5972 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5973 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
5974 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
5975 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5976 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
5977 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
5978 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
5982 /* Test for terminal `capabilities' (non-color character attributes). */
5984 /* font weight (bold/dim) */
5985 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5988 int def_weight
= face_numeric_weight (def_attrs
[LFACE_WEIGHT_INDEX
]);
5990 if (weight
> XLFD_WEIGHT_MEDIUM
)
5992 if (def_weight
> XLFD_WEIGHT_MEDIUM
)
5993 return 0; /* same as default */
5994 test_caps
= TTY_CAP_BOLD
;
5996 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5998 if (def_weight
< XLFD_WEIGHT_MEDIUM
)
5999 return 0; /* same as default */
6000 test_caps
= TTY_CAP_DIM
;
6002 else if (def_weight
== XLFD_WEIGHT_MEDIUM
)
6003 return 0; /* same as default */
6007 val
= attrs
[LFACE_UNDERLINE_INDEX
];
6008 if (!UNSPECIFIEDP (val
))
6011 return 0; /* ttys can't use colored underlines */
6012 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6013 return 0; /* same as default */
6015 test_caps
|= TTY_CAP_UNDERLINE
;
6019 val
= attrs
[LFACE_INVERSE_INDEX
];
6020 if (!UNSPECIFIEDP (val
))
6022 if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6023 return 0; /* same as default */
6025 test_caps
|= TTY_CAP_INVERSE
;
6029 /* Color testing. */
6031 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
6032 we use them when calling `tty_capable_p' below, even if the face
6033 specifies no colors. */
6034 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6035 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6037 /* Check if foreground color is close enough. */
6038 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
6041 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6043 if (face_attr_equal_p (fg
, def_fg
))
6044 return 0; /* same as default */
6045 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
6046 return 0; /* not a valid color */
6047 else if (color_distance (&fg_tty_color
, &fg_std_color
)
6048 > TTY_SAME_COLOR_THRESHOLD
)
6049 return 0; /* displayed color is too different */
6051 /* Make sure the color is really different than the default. */
6053 XColor def_fg_color
;
6054 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
6055 && (color_distance (&fg_tty_color
, &def_fg_color
)
6056 <= TTY_SAME_COLOR_THRESHOLD
))
6061 /* Check if background color is close enough. */
6062 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
6065 Lisp_Object def_bg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6067 if (face_attr_equal_p (bg
, def_bg
))
6068 return 0; /* same as default */
6069 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
6070 return 0; /* not a valid color */
6071 else if (color_distance (&bg_tty_color
, &bg_std_color
)
6072 > TTY_SAME_COLOR_THRESHOLD
)
6073 return 0; /* displayed color is too different */
6075 /* Make sure the color is really different than the default. */
6077 XColor def_bg_color
;
6078 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
6079 && (color_distance (&bg_tty_color
, &def_bg_color
)
6080 <= TTY_SAME_COLOR_THRESHOLD
))
6085 /* If both foreground and background are requested, see if the
6086 distance between them is OK. We just check to see if the distance
6087 between the tty's foreground and background is close enough to the
6088 distance between the standard foreground and background. */
6089 if (STRINGP (fg
) && STRINGP (bg
))
6092 = (color_distance (&fg_std_color
, &bg_std_color
)
6093 - color_distance (&fg_tty_color
, &bg_tty_color
));
6094 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
6095 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
6100 /* See if the capabilities we selected above are supported, with the
6102 if (test_caps
!= 0 &&
6103 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
6107 /* Hmmm, everything checks out, this terminal must support this face. */
6112 DEFUN ("display-supports-face-attributes-p",
6113 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
6115 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6116 The optional argument DISPLAY can be a display name, a frame, or
6117 nil (meaning the selected frame's display).
6119 The definition of `supported' is somewhat heuristic, but basically means
6120 that a face containing all the attributes in ATTRIBUTES, when merged
6121 with the default face for display, can be represented in a way that's
6123 \(1) different in appearance than the default face, and
6124 \(2) `close in spirit' to what the attributes specify, if not exact.
6126 Point (2) implies that a `:weight black' attribute will be satisfied by
6127 any display that can display bold, and a `:foreground \"yellow\"' as long
6128 as it can display a yellowish color, but `:slant italic' will _not_ be
6129 satisfied by the tty display code's automatic substitution of a `dim'
6130 face for italic. */)
6131 (attributes
, display
)
6132 Lisp_Object attributes
, display
;
6137 struct face
*def_face
;
6138 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6140 if (noninteractive
|| !initialized
)
6141 /* We may not be able to access low-level face information in batch
6142 mode, or before being dumped, and this function is not going to
6143 be very useful in those cases anyway, so just give up. */
6147 frame
= selected_frame
;
6148 else if (FRAMEP (display
))
6152 /* Find any frame on DISPLAY. */
6153 Lisp_Object fl_tail
;
6156 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
6158 frame
= XCAR (fl_tail
);
6159 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
6160 XFRAME (frame
)->param_alist
)),
6166 CHECK_LIVE_FRAME (frame
);
6169 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
6170 attrs
[i
] = Qunspecified
;
6171 merge_face_ref (f
, attributes
, attrs
, 1, 0);
6173 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6174 if (def_face
== NULL
)
6176 if (! realize_basic_faces (f
))
6177 error ("Cannot realize default face");
6178 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6181 /* Dispatch to the appropriate handler. */
6182 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6183 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
6184 #ifdef HAVE_WINDOW_SYSTEM
6186 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
6189 return supports
? Qt
: Qnil
;
6193 /***********************************************************************
6195 ***********************************************************************/
6197 DEFUN ("internal-set-font-selection-order",
6198 Finternal_set_font_selection_order
,
6199 Sinternal_set_font_selection_order
, 1, 1, 0,
6200 doc
: /* Set font selection order for face font selection to ORDER.
6201 ORDER must be a list of length 4 containing the symbols `:width',
6202 `:height', `:weight', and `:slant'. Face attributes appearing
6203 first in ORDER are matched first, e.g. if `:height' appears before
6204 `:weight' in ORDER, font selection first tries to find a font with
6205 a suitable height, and then tries to match the font weight.
6212 int indices
[DIM (font_sort_order
)];
6215 bzero (indices
, sizeof indices
);
6219 CONSP (list
) && i
< DIM (indices
);
6220 list
= XCDR (list
), ++i
)
6222 Lisp_Object attr
= XCAR (list
);
6225 if (EQ (attr
, QCwidth
))
6227 else if (EQ (attr
, QCheight
))
6228 xlfd
= XLFD_POINT_SIZE
;
6229 else if (EQ (attr
, QCweight
))
6231 else if (EQ (attr
, QCslant
))
6236 if (indices
[i
] != 0)
6241 if (!NILP (list
) || i
!= DIM (indices
))
6242 signal_error ("Invalid font sort order", order
);
6243 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6244 if (indices
[i
] == 0)
6245 signal_error ("Invalid font sort order", order
);
6247 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6249 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6250 free_all_realized_faces (Qnil
);
6257 DEFUN ("internal-set-alternative-font-family-alist",
6258 Finternal_set_alternative_font_family_alist
,
6259 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6260 doc
: /* Define alternative font families to try in face font selection.
6261 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6262 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6263 be found. Value is ALIST. */)
6268 Vface_alternative_font_family_alist
= alist
;
6269 free_all_realized_faces (Qnil
);
6274 DEFUN ("internal-set-alternative-font-registry-alist",
6275 Finternal_set_alternative_font_registry_alist
,
6276 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6277 doc
: /* Define alternative font registries to try in face font selection.
6278 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6279 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6280 be found. Value is ALIST. */)
6285 Vface_alternative_font_registry_alist
= alist
;
6286 free_all_realized_faces (Qnil
);
6291 #ifdef HAVE_WINDOW_SYSTEM
6293 /* Value is non-zero if FONT is the name of a scalable font. The
6294 X11R6 XLFD spec says that point size, pixel size, and average width
6295 are zero for scalable fonts. Intlfonts contain at least one
6296 scalable font ("*-muleindian-1") for which this isn't true, so we
6297 just test average width. */
6300 font_scalable_p (font
)
6301 struct font_name
*font
;
6303 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6304 return (*s
== '0' && *(s
+ 1) == '\0')
6306 /* Windows implementation of XLFD is slightly broken for backward
6307 compatibility with previous broken versions, so test for
6308 wildcards as well as 0. */
6315 /* Ignore the difference of font point size less than this value. */
6317 #define FONT_POINT_SIZE_QUANTUM 5
6319 /* Value is non-zero if FONT1 is a better match for font attributes
6320 VALUES than FONT2. VALUES is an array of face attribute values in
6321 font sort order. COMPARE_PT_P zero means don't compare point
6322 sizes. AVGWIDTH, if not zero, is a specified font average width
6326 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6328 struct font_name
*font1
, *font2
;
6329 int compare_pt_p
, avgwidth
;
6333 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6335 int xlfd_idx
= font_sort_order
[i
];
6337 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6341 if (xlfd_idx
== XLFD_POINT_SIZE
)
6343 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6344 / font1
->rescale_ratio
));
6345 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6346 / font2
->rescale_ratio
));
6347 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6352 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6353 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6356 if (delta1
> delta2
)
6358 else if (delta1
< delta2
)
6362 /* The difference may be equal because, e.g., the face
6363 specifies `italic' but we have only `regular' and
6364 `oblique'. Prefer `oblique' in this case. */
6365 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6366 && font1
->numeric
[xlfd_idx
] > values
[i
]
6367 && font2
->numeric
[xlfd_idx
] < values
[i
])
6375 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6376 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6377 if (delta1
> delta2
)
6379 else if (delta1
< delta2
)
6385 /* We prefer a real scalable font; i.e. not what autoscaled. */
6386 int auto_scaled_1
= (font1
->numeric
[XLFD_POINT_SIZE
] == 0
6387 && font1
->numeric
[XLFD_RESY
] > 0);
6388 int auto_scaled_2
= (font2
->numeric
[XLFD_POINT_SIZE
] == 0
6389 && font2
->numeric
[XLFD_RESY
] > 0);
6391 if (auto_scaled_1
!= auto_scaled_2
)
6392 return auto_scaled_2
;
6395 return font1
->registry_priority
< font2
->registry_priority
;
6399 /* Value is non-zero if FONT is an exact match for face attributes in
6400 SPECIFIED. SPECIFIED is an array of face attribute values in font
6401 sort order. AVGWIDTH, if non-zero, is an average width to compare
6405 exact_face_match_p (specified
, font
, avgwidth
)
6407 struct font_name
*font
;
6412 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6413 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6416 return (i
== DIM (font_sort_order
)
6418 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6422 /* Value is the name of a scaled font, generated from scalable font
6423 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6424 Value is allocated from heap. */
6427 build_scalable_font_name (f
, font
, specified_pt
)
6429 struct font_name
*font
;
6432 char pixel_size
[20];
6434 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6437 /* If scalable font is for a specific resolution, compute
6438 the point size we must specify from the resolution of
6439 the display and the specified resolution of the font. */
6440 if (font
->numeric
[XLFD_RESY
] != 0)
6442 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6443 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6448 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
+ 0.5;
6450 /* We may need a font of the different size. */
6451 pixel_value
*= font
->rescale_ratio
;
6453 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6454 font of the specified PIXEL_SIZE. */
6456 { /* Set point size of the font. */
6457 char point_size
[20];
6458 sprintf (point_size
, "%d", (int) pt
);
6459 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6460 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6464 /* Set pixel size. */
6465 sprintf (pixel_size
, "%d", pixel_value
);
6466 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6467 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6469 /* If font doesn't specify its resolution, use the
6470 resolution of the display. */
6471 if (font
->numeric
[XLFD_RESY
] == 0)
6474 sprintf (buffer
, "%d", (int) resy
);
6475 font
->fields
[XLFD_RESY
] = buffer
;
6476 font
->numeric
[XLFD_RESY
] = resy
;
6479 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6482 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6483 sprintf (buffer
, "%d", resx
);
6484 font
->fields
[XLFD_RESX
] = buffer
;
6485 font
->numeric
[XLFD_RESX
] = resx
;
6488 return build_font_name (font
);
6492 /* Value is non-zero if we are allowed to use scalable font FONT. We
6493 can't run a Lisp function here since this function may be called
6494 with input blocked. */
6497 may_use_scalable_font_p (font
)
6500 if (EQ (Vscalable_fonts_allowed
, Qt
))
6502 else if (CONSP (Vscalable_fonts_allowed
))
6504 Lisp_Object tail
, regexp
;
6506 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6508 regexp
= XCAR (tail
);
6509 if (STRINGP (regexp
)
6510 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6520 /* Return the name of the best matching font for face attributes ATTRS
6521 in the array of font_name structures FONTS which contains NFONTS
6522 elements. WIDTH_RATIO is a factor with which to multiply average
6523 widths if ATTRS specifies such a width.
6525 Value is a font name which is allocated from the heap. FONTS is
6526 freed by this function.
6528 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6529 indicate whether the resulting font should be drawn using overstrike
6530 to simulate bold-face. */
6533 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6536 struct font_name
*fonts
;
6539 int *needs_overstrike
;
6542 struct font_name
*best
;
6545 int exact_p
, avgwidth
;
6550 /* Make specified font attributes available in `specified',
6551 indexed by sort order. */
6552 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6554 int xlfd_idx
= font_sort_order
[i
];
6556 if (xlfd_idx
== XLFD_SWIDTH
)
6557 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6558 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6559 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6560 else if (xlfd_idx
== XLFD_WEIGHT
)
6561 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6562 else if (xlfd_idx
== XLFD_SLANT
)
6563 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6568 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6570 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6574 if (needs_overstrike
)
6575 *needs_overstrike
= 0;
6577 /* Start with the first non-scalable font in the list. */
6578 for (i
= 0; i
< nfonts
; ++i
)
6579 if (!font_scalable_p (fonts
+ i
))
6582 /* Find the best match among the non-scalable fonts. */
6587 for (i
= 1; i
< nfonts
; ++i
)
6588 if (!font_scalable_p (fonts
+ i
)
6589 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6593 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6601 /* Unless we found an exact match among non-scalable fonts, see if
6602 we can find a better match among scalable fonts. */
6605 /* A scalable font is better if
6607 1. its weight, slant, swidth attributes are better, or.
6609 2. the best non-scalable font doesn't have the required
6610 point size, and the scalable fonts weight, slant, swidth
6613 int non_scalable_has_exact_height_p
;
6615 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6616 non_scalable_has_exact_height_p
= 1;
6618 non_scalable_has_exact_height_p
= 0;
6620 for (i
= 0; i
< nfonts
; ++i
)
6621 if (font_scalable_p (fonts
+ i
))
6624 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6625 || (!non_scalable_has_exact_height_p
6626 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6628 non_scalable_has_exact_height_p
= 1;
6633 if (needs_overstrike
)
6635 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6636 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6638 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6640 /* We want a bold font, but didn't get one; try to use
6641 overstriking instead to simulate bold-face. However,
6642 don't overstrike an already-bold fontn unless the
6643 desired weight grossly exceeds the available weight. */
6644 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6645 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6647 *needs_overstrike
= 1;
6652 if (font_scalable_p (best
))
6653 font_name
= build_scalable_font_name (f
, best
, pt
);
6655 font_name
= build_font_name (best
);
6657 /* Free font_name structures. */
6658 free_font_names (fonts
, nfonts
);
6664 /* Get a list of matching fonts on frame F, considering FAMILY
6665 and alternative font families from Vface_alternative_font_registry_alist.
6667 FAMILY is the font family whose alternatives are considered.
6669 REGISTRY, if a string, specifies a font registry and encoding to
6670 match. A value of nil means include fonts of any registry and
6673 Return in *FONTS a pointer to a vector of font_name structures for
6674 the fonts matched. Value is the number of fonts found. */
6677 try_alternative_families (f
, family
, registry
, fonts
)
6679 Lisp_Object family
, registry
;
6680 struct font_name
**fonts
;
6685 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6688 /* Try alternative font families. */
6689 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6692 for (alter
= XCDR (alter
);
6693 CONSP (alter
) && nfonts
== 0;
6694 alter
= XCDR (alter
))
6696 if (STRINGP (XCAR (alter
)))
6697 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6701 /* Try all scalable fonts before giving up. */
6702 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6704 int count
= SPECPDL_INDEX ();
6705 specbind (Qscalable_fonts_allowed
, Qt
);
6706 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6707 unbind_to (count
, Qnil
);
6714 /* Get a list of matching fonts on frame F.
6716 FAMILY, if a string, specifies a font family derived from the fontset.
6717 It is only used if the face does not specify any family in ATTRS or
6718 if we cannot find any font of the face's family.
6720 REGISTRY, if a string, specifies a font registry and encoding to
6721 match. A value of nil means include fonts of any registry and
6724 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6725 Otherwise, prefer FAMILY.
6727 Return in *FONTS a pointer to a vector of font_name structures for
6728 the fonts matched. Value is the number of fonts found. */
6731 try_font_list (f
, attrs
, family
, registry
, fonts
, prefer_face_family
)
6734 Lisp_Object family
, registry
;
6735 struct font_name
**fonts
;
6736 int prefer_face_family
;
6739 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6740 Lisp_Object try_family
;
6742 try_family
= (prefer_face_family
|| NILP (family
)) ? face_family
: family
;
6744 if (STRINGP (try_family
))
6745 nfonts
= try_alternative_families (f
, try_family
, registry
, fonts
);
6748 if (nfonts
== 0 && STRINGP (try_family
) && STRINGP (registry
))
6749 if (xstricmp (SDATA (registry
), "mac-roman") == 0)
6750 /* When realizing the default face and a font spec does not
6751 matched exactly, Emacs looks for ones with the same registry
6752 as the default font. On the Mac, this is mac-roman, which
6753 does not work if the family is -etl-fixed, e.g. The
6754 following widens the choices and fixes that problem. */
6755 nfonts
= try_alternative_families (f
, try_family
, Qnil
, fonts
);
6756 else if (SBYTES (try_family
) > 0
6757 && SREF (try_family
, SBYTES (try_family
) - 1) != '*')
6758 /* Some Central European/Cyrillic font family names have the
6759 Roman counterpart name as their prefix. */
6760 nfonts
= try_alternative_families (f
, concat2 (try_family
,
6761 build_string ("*")),
6765 if (EQ (try_family
, family
))
6766 family
= face_family
;
6768 if (nfonts
== 0 && STRINGP (family
))
6769 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6771 /* Try font family of the default face or "fixed". */
6774 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6776 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6778 family
= build_string ("fixed");
6779 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6782 /* Try any family with the given registry. */
6784 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6790 /* Return the fontset id of the base fontset name or alias name given
6791 by the fontset attribute of ATTRS. Value is -1 if the fontset
6792 attribute of ATTRS doesn't name a fontset. */
6795 face_fontset (attrs
)
6800 name
= attrs
[LFACE_FONT_INDEX
];
6801 if (!STRINGP (name
))
6803 return fs_query_fontset (name
, 0);
6807 /* Choose a name of font to use on frame F to display character C with
6808 Lisp face attributes specified by ATTRS. The font name is
6809 determined by the font-related attributes in ATTRS and the name
6810 pattern for C in FONTSET. Value is the font name which is
6811 allocated from the heap and must be freed by the caller, or NULL if
6812 we can get no information about the font name of C. It is assured
6813 that we always get some information for a single byte
6816 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6817 indicate whether the resulting font should be drawn using overstrike
6818 to simulate bold-face. */
6821 choose_face_font (f
, attrs
, fontset
, c
, needs_overstrike
)
6825 int *needs_overstrike
;
6827 Lisp_Object pattern
;
6828 char *font_name
= NULL
;
6829 struct font_name
*fonts
;
6830 int nfonts
, width_ratio
;
6832 if (needs_overstrike
)
6833 *needs_overstrike
= 0;
6835 /* Get (foundry and) family name and registry (and encoding) name of
6837 pattern
= fontset_font_pattern (f
, fontset
, c
);
6840 xassert (!SINGLE_BYTE_CHAR_P (c
));
6844 /* If what we got is a name pattern, return it. */
6845 if (STRINGP (pattern
))
6846 return xstrdup (SDATA (pattern
));
6848 /* Get a list of fonts matching that pattern and choose the
6849 best match for the specified face attributes from it. */
6850 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
,
6851 (SINGLE_BYTE_CHAR_P (c
)
6852 || CHAR_CHARSET (c
) == charset_latin_iso8859_1
));
6853 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6855 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6856 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
,
6861 #endif /* HAVE_WINDOW_SYSTEM */
6865 /***********************************************************************
6867 ***********************************************************************/
6869 /* Realize basic faces on frame F. Value is zero if frame parameters
6870 of F don't contain enough information needed to realize the default
6874 realize_basic_faces (f
)
6878 int count
= SPECPDL_INDEX ();
6880 /* Block input here so that we won't be surprised by an X expose
6881 event, for instance, without having the faces set up. */
6883 specbind (Qscalable_fonts_allowed
, Qt
);
6885 if (realize_default_face (f
))
6887 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6888 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6889 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6890 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6891 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6892 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6893 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6894 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6895 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6896 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6897 realize_named_face (f
, Qvertical_border
, VERTICAL_BORDER_FACE_ID
);
6899 /* Reflect changes in the `menu' face in menu bars. */
6900 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6902 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6903 #ifdef USE_X_TOOLKIT
6904 x_update_menu_appearance (f
);
6911 unbind_to (count
, Qnil
);
6917 /* Realize the default face on frame F. If the face is not fully
6918 specified, make it fully-specified. Attributes of the default face
6919 that are not explicitly specified are taken from frame parameters. */
6922 realize_default_face (f
)
6925 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6927 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6928 Lisp_Object frame_font
;
6931 /* If the `default' face is not yet known, create it. */
6932 lface
= lface_from_face_name (f
, Qdefault
, 0);
6936 XSETFRAME (frame
, f
);
6937 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6941 #ifdef HAVE_WINDOW_SYSTEM
6942 if (FRAME_WINDOW_P (f
))
6944 /* Set frame_font to the value of the `font' frame parameter. */
6945 frame_font
= Fassq (Qfont
, f
->param_alist
);
6946 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6947 frame_font
= XCDR (frame_font
);
6948 set_lface_from_font_name (f
, lface
, frame_font
,
6949 f
->default_face_done_p
, 1);
6950 f
->default_face_done_p
= 1;
6952 #endif /* HAVE_WINDOW_SYSTEM */
6954 if (!FRAME_WINDOW_P (f
))
6956 LFACE_FAMILY (lface
) = build_string ("default");
6957 LFACE_SWIDTH (lface
) = Qnormal
;
6958 LFACE_HEIGHT (lface
) = make_number (1);
6959 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6960 LFACE_WEIGHT (lface
) = Qnormal
;
6961 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6962 LFACE_SLANT (lface
) = Qnormal
;
6963 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6966 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6967 LFACE_UNDERLINE (lface
) = Qnil
;
6969 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6970 LFACE_OVERLINE (lface
) = Qnil
;
6972 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6973 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6975 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6976 LFACE_BOX (lface
) = Qnil
;
6978 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6979 LFACE_INVERSE (lface
) = Qnil
;
6981 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6983 /* This function is called so early that colors are not yet
6984 set in the frame parameter list. */
6985 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6987 if (CONSP (color
) && STRINGP (XCDR (color
)))
6988 LFACE_FOREGROUND (lface
) = XCDR (color
);
6989 else if (FRAME_WINDOW_P (f
))
6991 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6992 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6997 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6999 /* This function is called so early that colors are not yet
7000 set in the frame parameter list. */
7001 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
7002 if (CONSP (color
) && STRINGP (XCDR (color
)))
7003 LFACE_BACKGROUND (lface
) = XCDR (color
);
7004 else if (FRAME_WINDOW_P (f
))
7006 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7007 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
7012 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
7013 LFACE_STIPPLE (lface
) = Qnil
;
7015 /* Realize the face; it must be fully-specified now. */
7016 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
7017 check_lface (lface
);
7018 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
7019 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
7024 /* Realize basic faces other than the default face in face cache C.
7025 SYMBOL is the face name, ID is the face id the realized face must
7026 have. The default face must have been realized already. */
7029 realize_named_face (f
, symbol
, id
)
7034 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7035 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
7036 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7037 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
7038 struct face
*new_face
;
7040 /* The default face must exist and be fully specified. */
7041 get_lface_attributes (f
, Qdefault
, attrs
, 1);
7042 check_lface_attrs (attrs
);
7043 xassert (lface_fully_specified_p (attrs
));
7045 /* If SYMBOL isn't know as a face, create it. */
7049 XSETFRAME (frame
, f
);
7050 lface
= Finternal_make_lisp_face (symbol
, frame
);
7053 /* Merge SYMBOL's face with the default face. */
7054 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
7055 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
7057 /* Realize the face. */
7058 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
7062 /* Realize the fully-specified face with attributes ATTRS in face
7063 cache CACHE for character C. If C is a multibyte character,
7064 BASE_FACE is a face that has the same attributes. Otherwise,
7065 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
7066 ID of face to remove before caching the new face. Value is a
7067 pointer to the newly created realized face. */
7069 static struct face
*
7070 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
7071 struct face_cache
*cache
;
7074 struct face
*base_face
;
7079 /* LFACE must be fully specified. */
7080 xassert (cache
!= NULL
);
7081 check_lface_attrs (attrs
);
7083 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
7085 /* Remove the former face. */
7086 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
7087 uncache_face (cache
, former_face
);
7088 free_realized_face (cache
->f
, former_face
);
7091 if (FRAME_WINDOW_P (cache
->f
))
7092 face
= realize_x_face (cache
, attrs
, c
, base_face
);
7093 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
7094 face
= realize_tty_face (cache
, attrs
, c
);
7098 /* Insert the new face. */
7099 cache_face (cache
, face
, lface_hash (attrs
));
7100 #ifdef HAVE_WINDOW_SYSTEM
7101 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
7102 load_face_font (cache
->f
, face
, c
);
7103 #endif /* HAVE_WINDOW_SYSTEM */
7108 /* Realize the fully-specified face with attributes ATTRS in face
7109 cache CACHE for character C. Do it for X frame CACHE->f. If C is
7110 a multibyte character, BASE_FACE is a face that has the same
7111 attributes. Otherwise, BASE_FACE is ignored. If the new face
7112 doesn't share font with the default face, a fontname is allocated
7113 from the heap and set in `font_name' of the new face, but it is not
7114 yet loaded here. Value is a pointer to the newly created realized
7117 static struct face
*
7118 realize_x_face (cache
, attrs
, c
, base_face
)
7119 struct face_cache
*cache
;
7122 struct face
*base_face
;
7124 struct face
*face
= NULL
;
7125 #ifdef HAVE_WINDOW_SYSTEM
7126 struct face
*default_face
;
7128 Lisp_Object stipple
, overline
, strike_through
, box
;
7130 xassert (FRAME_WINDOW_P (cache
->f
));
7131 xassert (SINGLE_BYTE_CHAR_P (c
)
7134 /* Allocate a new realized face. */
7135 face
= make_realized_face (attrs
);
7139 /* If C is a multibyte character, we share all face attirbutes with
7140 BASE_FACE including the realized fontset. But, we must load a
7142 if (!SINGLE_BYTE_CHAR_P (c
))
7144 bcopy (base_face
, face
, sizeof *face
);
7147 /* Don't try to free the colors copied bitwise from BASE_FACE. */
7148 face
->colors_copied_bitwise_p
= 1;
7150 /* to force realize_face to load font */
7155 /* Now we are realizing a face for ASCII (and unibyte) characters. */
7157 /* Determine the font to use. Most of the time, the font will be
7158 the same as the font of the default face, so try that first. */
7159 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7161 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
7162 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
7164 face
->font
= default_face
->font
;
7165 face
->fontset
= default_face
->fontset
;
7166 face
->font_info_id
= default_face
->font_info_id
;
7167 face
->font_name
= default_face
->font_name
;
7168 face
->ascii_face
= face
;
7170 /* But, as we can't share the fontset, make a new realized
7171 fontset that has the same base fontset as of the default
7174 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
7178 /* If the face attribute ATTRS specifies a fontset, use it as
7179 the base of a new realized fontset. Otherwise, use the same
7180 base fontset as of the default face. The base determines
7181 registry and encoding of a font. It may also determine
7182 foundry and family. The other fields of font name pattern
7183 are constructed from ATTRS. */
7184 int fontset
= face_fontset (attrs
);
7186 if ((fontset
== -1) && default_face
)
7187 fontset
= default_face
->fontset
;
7188 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
7189 face
->font
= NULL
; /* to force realize_face to load font */
7192 /* Load colors, and set remaining attributes. */
7194 load_face_colors (f
, face
, attrs
);
7197 box
= attrs
[LFACE_BOX_INDEX
];
7200 /* A simple box of line width 1 drawn in color given by
7202 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7204 face
->box
= FACE_SIMPLE_BOX
;
7205 face
->box_line_width
= 1;
7207 else if (INTEGERP (box
))
7209 /* Simple box of specified line width in foreground color of the
7211 xassert (XINT (box
) != 0);
7212 face
->box
= FACE_SIMPLE_BOX
;
7213 face
->box_line_width
= XINT (box
);
7214 face
->box_color
= face
->foreground
;
7215 face
->box_color_defaulted_p
= 1;
7217 else if (CONSP (box
))
7219 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7220 being one of `raised' or `sunken'. */
7221 face
->box
= FACE_SIMPLE_BOX
;
7222 face
->box_color
= face
->foreground
;
7223 face
->box_color_defaulted_p
= 1;
7224 face
->box_line_width
= 1;
7228 Lisp_Object keyword
, value
;
7230 keyword
= XCAR (box
);
7238 if (EQ (keyword
, QCline_width
))
7240 if (INTEGERP (value
) && XINT (value
) != 0)
7241 face
->box_line_width
= XINT (value
);
7243 else if (EQ (keyword
, QCcolor
))
7245 if (STRINGP (value
))
7247 face
->box_color
= load_color (f
, face
, value
,
7249 face
->use_box_color_for_shadows_p
= 1;
7252 else if (EQ (keyword
, QCstyle
))
7254 if (EQ (value
, Qreleased_button
))
7255 face
->box
= FACE_RAISED_BOX
;
7256 else if (EQ (value
, Qpressed_button
))
7257 face
->box
= FACE_SUNKEN_BOX
;
7262 /* Text underline, overline, strike-through. */
7264 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7266 /* Use default color (same as foreground color). */
7267 face
->underline_p
= 1;
7268 face
->underline_defaulted_p
= 1;
7269 face
->underline_color
= 0;
7271 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7273 /* Use specified color. */
7274 face
->underline_p
= 1;
7275 face
->underline_defaulted_p
= 0;
7276 face
->underline_color
7277 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7278 LFACE_UNDERLINE_INDEX
);
7280 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7282 face
->underline_p
= 0;
7283 face
->underline_defaulted_p
= 0;
7284 face
->underline_color
= 0;
7287 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7288 if (STRINGP (overline
))
7290 face
->overline_color
7291 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7292 LFACE_OVERLINE_INDEX
);
7293 face
->overline_p
= 1;
7295 else if (EQ (overline
, Qt
))
7297 face
->overline_color
= face
->foreground
;
7298 face
->overline_color_defaulted_p
= 1;
7299 face
->overline_p
= 1;
7302 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7303 if (STRINGP (strike_through
))
7305 face
->strike_through_color
7306 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7307 LFACE_STRIKE_THROUGH_INDEX
);
7308 face
->strike_through_p
= 1;
7310 else if (EQ (strike_through
, Qt
))
7312 face
->strike_through_color
= face
->foreground
;
7313 face
->strike_through_color_defaulted_p
= 1;
7314 face
->strike_through_p
= 1;
7317 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7318 if (!NILP (stipple
))
7319 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7321 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
7322 #endif /* HAVE_WINDOW_SYSTEM */
7327 /* Map a specified color of face FACE on frame F to a tty color index.
7328 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7329 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7330 default foreground/background colors. */
7333 map_tty_color (f
, face
, idx
, defaulted
)
7336 enum lface_attribute_index idx
;
7339 Lisp_Object frame
, color
, def
;
7340 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7341 unsigned long default_pixel
, default_other_pixel
, pixel
;
7343 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7347 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7348 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7352 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7353 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7356 XSETFRAME (frame
, f
);
7357 color
= face
->lface
[idx
];
7361 && CONSP (Vtty_defined_color_alist
)
7362 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7365 /* Associations in tty-defined-color-alist are of the form
7366 (NAME INDEX R G B). We need the INDEX part. */
7367 pixel
= XINT (XCAR (XCDR (def
)));
7370 if (pixel
== default_pixel
&& STRINGP (color
))
7372 pixel
= load_color (f
, face
, color
, idx
);
7374 #if defined (MSDOS) || defined (WINDOWSNT)
7375 /* If the foreground of the default face is the default color,
7376 use the foreground color defined by the frame. */
7378 if (FRAME_MSDOS_P (f
))
7381 if (pixel
== default_pixel
7382 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7385 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7387 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7388 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7391 else if (pixel
== default_other_pixel
)
7394 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7396 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7397 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7403 #endif /* MSDOS or WINDOWSNT */
7407 face
->foreground
= pixel
;
7409 face
->background
= pixel
;
7413 /* Realize the fully-specified face with attributes ATTRS in face
7414 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7415 pointer to the newly created realized face. */
7417 static struct face
*
7418 realize_tty_face (cache
, attrs
, c
)
7419 struct face_cache
*cache
;
7425 int face_colors_defaulted
= 0;
7426 struct frame
*f
= cache
->f
;
7428 /* Frame must be a termcap frame. */
7429 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7431 /* Allocate a new realized face. */
7432 face
= make_realized_face (attrs
);
7433 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7435 /* Map face attributes to TTY appearances. We map slant to
7436 dimmed text because we want italic text to appear differently
7437 and because dimmed text is probably used infrequently. */
7438 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7439 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7441 if (weight
> XLFD_WEIGHT_MEDIUM
)
7442 face
->tty_bold_p
= 1;
7443 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7444 face
->tty_dim_p
= 1;
7445 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7446 face
->tty_underline_p
= 1;
7447 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7448 face
->tty_reverse_p
= 1;
7450 /* Map color names to color indices. */
7451 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7452 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7454 /* Swap colors if face is inverse-video. If the colors are taken
7455 from the frame colors, they are already inverted, since the
7456 frame-creation function calls x-handle-reverse-video. */
7457 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7459 unsigned long tem
= face
->foreground
;
7460 face
->foreground
= face
->background
;
7461 face
->background
= tem
;
7464 if (tty_suppress_bold_inverse_default_colors_p
7466 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7467 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7468 face
->tty_bold_p
= 0;
7474 DEFUN ("tty-suppress-bold-inverse-default-colors",
7475 Ftty_suppress_bold_inverse_default_colors
,
7476 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7477 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7478 SUPPRESS non-nil means suppress it.
7479 This affects bold faces on TTYs whose foreground is the default background
7480 color of the display and whose background is the default foreground color.
7481 For such faces, the bold face attribute is ignored if this variable
7484 Lisp_Object suppress
;
7486 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7487 ++face_change_count
;
7493 /***********************************************************************
7495 ***********************************************************************/
7497 /* Return the ID of the face to use to display character CH with face
7498 property PROP on frame F in current_buffer. */
7501 compute_char_face (f
, ch
, prop
)
7508 if (NILP (current_buffer
->enable_multibyte_characters
))
7513 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7514 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7518 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7519 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7520 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7521 merge_face_ref (f
, prop
, attrs
, 1, 0);
7522 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
7528 /* Return the face ID associated with buffer position POS for
7529 displaying ASCII characters. Return in *ENDPTR the position at
7530 which a different face is needed, as far as text properties and
7531 overlays are concerned. W is a window displaying current_buffer.
7533 REGION_BEG, REGION_END delimit the region, so it can be
7536 LIMIT is a position not to scan beyond. That is to limit the time
7537 this function can take.
7539 If MOUSE is non-zero, use the character's mouse-face, not its face.
7541 The face returned is suitable for displaying ASCII characters. */
7544 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7545 endptr
, limit
, mouse
)
7548 int region_beg
, region_end
;
7553 struct frame
*f
= XFRAME (w
->frame
);
7554 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7555 Lisp_Object prop
, position
;
7557 Lisp_Object
*overlay_vec
;
7560 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7561 Lisp_Object limit1
, end
;
7562 struct face
*default_face
;
7564 /* W must display the current buffer. We could write this function
7565 to use the frame and buffer of W, but right now it doesn't. */
7566 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7568 XSETFRAME (frame
, f
);
7569 XSETFASTINT (position
, pos
);
7572 if (pos
< region_beg
&& region_beg
< endpos
)
7573 endpos
= region_beg
;
7575 /* Get the `face' or `mouse_face' text property at POS, and
7576 determine the next position at which the property changes. */
7577 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7578 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7579 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7581 endpos
= XINT (end
);
7583 /* Look at properties from overlays. */
7587 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
7588 if (next_overlay
< endpos
)
7589 endpos
= next_overlay
;
7594 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7596 /* Optimize common cases where we can use the default face. */
7599 && !(pos
>= region_beg
&& pos
< region_end
))
7600 return DEFAULT_FACE_ID
;
7602 /* Begin with attributes from the default face. */
7603 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7605 /* Merge in attributes specified via text properties. */
7607 merge_face_ref (f
, prop
, attrs
, 1, 0);
7609 /* Now merge the overlay data. */
7610 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7611 for (i
= 0; i
< noverlays
; i
++)
7616 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7618 merge_face_ref (f
, prop
, attrs
, 1, 0);
7620 oend
= OVERLAY_END (overlay_vec
[i
]);
7621 oendpos
= OVERLAY_POSITION (oend
);
7622 if (oendpos
< endpos
)
7626 /* If in the region, merge in the region face. */
7627 if (pos
>= region_beg
&& pos
< region_end
)
7629 merge_named_face (f
, Qregion
, attrs
, 0);
7631 if (region_end
< endpos
)
7632 endpos
= region_end
;
7637 /* Look up a realized face with the given face attributes,
7638 or realize a new one for ASCII characters. */
7639 return lookup_face (f
, attrs
, 0, NULL
);
7643 /* Compute the face at character position POS in Lisp string STRING on
7644 window W, for ASCII characters.
7646 If STRING is an overlay string, it comes from position BUFPOS in
7647 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7648 not an overlay string. W must display the current buffer.
7649 REGION_BEG and REGION_END give the start and end positions of the
7650 region; both are -1 if no region is visible.
7652 BASE_FACE_ID is the id of a face to merge with. For strings coming
7653 from overlays or the `display' property it is the face at BUFPOS.
7655 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7657 Set *ENDPTR to the next position where to check for faces in
7658 STRING; -1 if the face is constant from POS to the end of the
7661 Value is the id of the face to use. The face returned is suitable
7662 for displaying ASCII characters. */
7665 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7666 region_end
, endptr
, base_face_id
, mouse_p
)
7670 int region_beg
, region_end
;
7672 enum face_id base_face_id
;
7675 Lisp_Object prop
, position
, end
, limit
;
7676 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7677 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7678 struct face
*base_face
;
7679 int multibyte_p
= STRING_MULTIBYTE (string
);
7680 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7682 /* Get the value of the face property at the current position within
7683 STRING. Value is nil if there is no face property. */
7684 XSETFASTINT (position
, pos
);
7685 prop
= Fget_text_property (position
, prop_name
, string
);
7687 /* Get the next position at which to check for faces. Value of end
7688 is nil if face is constant all the way to the end of the string.
7689 Otherwise it is a string position where to check faces next.
7690 Limit is the maximum position up to which to check for property
7691 changes in Fnext_single_property_change. Strings are usually
7692 short, so set the limit to the end of the string. */
7693 XSETFASTINT (limit
, SCHARS (string
));
7694 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7696 *endptr
= XFASTINT (end
);
7700 base_face
= FACE_FROM_ID (f
, base_face_id
);
7701 xassert (base_face
);
7703 /* Optimize the default case that there is no face property and we
7704 are not in the region. */
7706 && (base_face_id
!= DEFAULT_FACE_ID
7707 /* BUFPOS <= 0 means STRING is not an overlay string, so
7708 that the region doesn't have to be taken into account. */
7710 || bufpos
< region_beg
7711 || bufpos
>= region_end
)
7713 /* We can't realize faces for different charsets differently
7714 if we don't have fonts, so we can stop here if not working
7715 on a window-system frame. */
7716 || !FRAME_WINDOW_P (f
)
7717 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7718 return base_face
->id
;
7720 /* Begin with attributes from the base face. */
7721 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7723 /* Merge in attributes specified via text properties. */
7725 merge_face_ref (f
, prop
, attrs
, 1, 0);
7727 /* If in the region, merge in the region face. */
7729 && bufpos
>= region_beg
7730 && bufpos
< region_end
)
7731 merge_named_face (f
, Qregion
, attrs
, 0);
7733 /* Look up a realized face with the given face attributes,
7734 or realize a new one for ASCII characters. */
7735 return lookup_face (f
, attrs
, 0, NULL
);
7739 /* Merge a face into a realized face.
7741 F is frame where faces are (to be) realized.
7743 FACE_NAME is named face to merge.
7745 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
7747 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
7749 BASE_FACE_ID is realized face to merge into.
7755 merge_faces (f
, face_name
, face_id
, base_face_id
)
7757 Lisp_Object face_name
;
7758 int face_id
, base_face_id
;
7760 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7761 struct face
*base_face
;
7763 base_face
= FACE_FROM_ID (f
, base_face_id
);
7765 return base_face_id
;
7767 if (EQ (face_name
, Qt
))
7769 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
7770 return base_face_id
;
7771 face_name
= lface_id_to_name
[face_id
];
7772 face_id
= lookup_derived_face (f
, face_name
, 0, base_face_id
, 1);
7775 return base_face_id
;
7778 /* Begin with attributes from the base face. */
7779 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7781 if (!NILP (face_name
))
7783 if (!merge_named_face (f
, face_name
, attrs
, 0))
7784 return base_face_id
;
7790 return base_face_id
;
7791 face
= FACE_FROM_ID (f
, face_id
);
7793 return base_face_id
;
7794 merge_face_vectors (f
, face
->lface
, attrs
, 0);
7797 /* Look up a realized face with the given face attributes,
7798 or realize a new one for ASCII characters. */
7799 return lookup_face (f
, attrs
, 0, NULL
);
7803 /***********************************************************************
7805 ***********************************************************************/
7809 /* Print the contents of the realized face FACE to stderr. */
7812 dump_realized_face (face
)
7815 fprintf (stderr
, "ID: %d\n", face
->id
);
7816 #ifdef HAVE_X_WINDOWS
7817 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
7819 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7821 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7822 fprintf (stderr
, "background: 0x%lx (%s)\n",
7824 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7825 fprintf (stderr
, "font_name: %s (%s)\n",
7827 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7828 #ifdef HAVE_X_WINDOWS
7829 fprintf (stderr
, "font = %p\n", face
->font
);
7831 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7832 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7833 fprintf (stderr
, "underline: %d (%s)\n",
7835 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7836 fprintf (stderr
, "hash: %d\n", face
->hash
);
7837 fprintf (stderr
, "charset: %d\n", face
->charset
);
7841 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7849 fprintf (stderr
, "font selection order: ");
7850 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7851 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7852 fprintf (stderr
, "\n");
7854 fprintf (stderr
, "alternative fonts: ");
7855 debug_print (Vface_alternative_font_family_alist
);
7856 fprintf (stderr
, "\n");
7858 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7859 Fdump_face (make_number (i
));
7865 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7867 error ("Not a valid face");
7868 dump_realized_face (face
);
7875 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7876 0, 0, 0, doc
: /* */)
7879 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7880 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7881 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7885 #endif /* GLYPH_DEBUG != 0 */
7889 /***********************************************************************
7891 ***********************************************************************/
7896 Qface
= intern ("face");
7898 Qface_no_inherit
= intern ("face-no-inherit");
7899 staticpro (&Qface_no_inherit
);
7900 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7901 staticpro (&Qbitmap_spec_p
);
7902 Qframe_set_background_mode
= intern ("frame-set-background-mode");
7903 staticpro (&Qframe_set_background_mode
);
7905 /* Lisp face attribute keywords. */
7906 QCfamily
= intern (":family");
7907 staticpro (&QCfamily
);
7908 QCheight
= intern (":height");
7909 staticpro (&QCheight
);
7910 QCweight
= intern (":weight");
7911 staticpro (&QCweight
);
7912 QCslant
= intern (":slant");
7913 staticpro (&QCslant
);
7914 QCunderline
= intern (":underline");
7915 staticpro (&QCunderline
);
7916 QCinverse_video
= intern (":inverse-video");
7917 staticpro (&QCinverse_video
);
7918 QCreverse_video
= intern (":reverse-video");
7919 staticpro (&QCreverse_video
);
7920 QCforeground
= intern (":foreground");
7921 staticpro (&QCforeground
);
7922 QCbackground
= intern (":background");
7923 staticpro (&QCbackground
);
7924 QCstipple
= intern (":stipple");;
7925 staticpro (&QCstipple
);
7926 QCwidth
= intern (":width");
7927 staticpro (&QCwidth
);
7928 QCfont
= intern (":font");
7929 staticpro (&QCfont
);
7930 QCbold
= intern (":bold");
7931 staticpro (&QCbold
);
7932 QCitalic
= intern (":italic");
7933 staticpro (&QCitalic
);
7934 QCoverline
= intern (":overline");
7935 staticpro (&QCoverline
);
7936 QCstrike_through
= intern (":strike-through");
7937 staticpro (&QCstrike_through
);
7938 QCbox
= intern (":box");
7940 QCinherit
= intern (":inherit");
7941 staticpro (&QCinherit
);
7943 /* Symbols used for Lisp face attribute values. */
7944 QCcolor
= intern (":color");
7945 staticpro (&QCcolor
);
7946 QCline_width
= intern (":line-width");
7947 staticpro (&QCline_width
);
7948 QCstyle
= intern (":style");
7949 staticpro (&QCstyle
);
7950 Qreleased_button
= intern ("released-button");
7951 staticpro (&Qreleased_button
);
7952 Qpressed_button
= intern ("pressed-button");
7953 staticpro (&Qpressed_button
);
7954 Qnormal
= intern ("normal");
7955 staticpro (&Qnormal
);
7956 Qultra_light
= intern ("ultra-light");
7957 staticpro (&Qultra_light
);
7958 Qextra_light
= intern ("extra-light");
7959 staticpro (&Qextra_light
);
7960 Qlight
= intern ("light");
7961 staticpro (&Qlight
);
7962 Qsemi_light
= intern ("semi-light");
7963 staticpro (&Qsemi_light
);
7964 Qsemi_bold
= intern ("semi-bold");
7965 staticpro (&Qsemi_bold
);
7966 Qbold
= intern ("bold");
7968 Qextra_bold
= intern ("extra-bold");
7969 staticpro (&Qextra_bold
);
7970 Qultra_bold
= intern ("ultra-bold");
7971 staticpro (&Qultra_bold
);
7972 Qoblique
= intern ("oblique");
7973 staticpro (&Qoblique
);
7974 Qitalic
= intern ("italic");
7975 staticpro (&Qitalic
);
7976 Qreverse_oblique
= intern ("reverse-oblique");
7977 staticpro (&Qreverse_oblique
);
7978 Qreverse_italic
= intern ("reverse-italic");
7979 staticpro (&Qreverse_italic
);
7980 Qultra_condensed
= intern ("ultra-condensed");
7981 staticpro (&Qultra_condensed
);
7982 Qextra_condensed
= intern ("extra-condensed");
7983 staticpro (&Qextra_condensed
);
7984 Qcondensed
= intern ("condensed");
7985 staticpro (&Qcondensed
);
7986 Qsemi_condensed
= intern ("semi-condensed");
7987 staticpro (&Qsemi_condensed
);
7988 Qsemi_expanded
= intern ("semi-expanded");
7989 staticpro (&Qsemi_expanded
);
7990 Qexpanded
= intern ("expanded");
7991 staticpro (&Qexpanded
);
7992 Qextra_expanded
= intern ("extra-expanded");
7993 staticpro (&Qextra_expanded
);
7994 Qultra_expanded
= intern ("ultra-expanded");
7995 staticpro (&Qultra_expanded
);
7996 Qbackground_color
= intern ("background-color");
7997 staticpro (&Qbackground_color
);
7998 Qforeground_color
= intern ("foreground-color");
7999 staticpro (&Qforeground_color
);
8000 Qunspecified
= intern ("unspecified");
8001 staticpro (&Qunspecified
);
8003 Qface_alias
= intern ("face-alias");
8004 staticpro (&Qface_alias
);
8005 Qdefault
= intern ("default");
8006 staticpro (&Qdefault
);
8007 Qtool_bar
= intern ("tool-bar");
8008 staticpro (&Qtool_bar
);
8009 Qregion
= intern ("region");
8010 staticpro (&Qregion
);
8011 Qfringe
= intern ("fringe");
8012 staticpro (&Qfringe
);
8013 Qheader_line
= intern ("header-line");
8014 staticpro (&Qheader_line
);
8015 Qscroll_bar
= intern ("scroll-bar");
8016 staticpro (&Qscroll_bar
);
8017 Qmenu
= intern ("menu");
8019 Qcursor
= intern ("cursor");
8020 staticpro (&Qcursor
);
8021 Qborder
= intern ("border");
8022 staticpro (&Qborder
);
8023 Qmouse
= intern ("mouse");
8024 staticpro (&Qmouse
);
8025 Qmode_line_inactive
= intern ("mode-line-inactive");
8026 staticpro (&Qmode_line_inactive
);
8027 Qvertical_border
= intern ("vertical-border");
8028 staticpro (&Qvertical_border
);
8029 Qtty_color_desc
= intern ("tty-color-desc");
8030 staticpro (&Qtty_color_desc
);
8031 Qtty_color_standard_values
= intern ("tty-color-standard-values");
8032 staticpro (&Qtty_color_standard_values
);
8033 Qtty_color_by_index
= intern ("tty-color-by-index");
8034 staticpro (&Qtty_color_by_index
);
8035 Qtty_color_alist
= intern ("tty-color-alist");
8036 staticpro (&Qtty_color_alist
);
8037 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
8038 staticpro (&Qscalable_fonts_allowed
);
8040 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
8041 staticpro (&Vparam_value_alist
);
8042 Vface_alternative_font_family_alist
= Qnil
;
8043 staticpro (&Vface_alternative_font_family_alist
);
8044 Vface_alternative_font_registry_alist
= Qnil
;
8045 staticpro (&Vface_alternative_font_registry_alist
);
8047 defsubr (&Sinternal_make_lisp_face
);
8048 defsubr (&Sinternal_lisp_face_p
);
8049 defsubr (&Sinternal_set_lisp_face_attribute
);
8050 #ifdef HAVE_WINDOW_SYSTEM
8051 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
8053 defsubr (&Scolor_gray_p
);
8054 defsubr (&Scolor_supported_p
);
8055 defsubr (&Sface_attribute_relative_p
);
8056 defsubr (&Smerge_face_attribute
);
8057 defsubr (&Sinternal_get_lisp_face_attribute
);
8058 defsubr (&Sinternal_lisp_face_attribute_values
);
8059 defsubr (&Sinternal_lisp_face_equal_p
);
8060 defsubr (&Sinternal_lisp_face_empty_p
);
8061 defsubr (&Sinternal_copy_lisp_face
);
8062 defsubr (&Sinternal_merge_in_global_face
);
8063 defsubr (&Sface_font
);
8064 defsubr (&Sframe_face_alist
);
8065 defsubr (&Sdisplay_supports_face_attributes_p
);
8066 defsubr (&Scolor_distance
);
8067 defsubr (&Sinternal_set_font_selection_order
);
8068 defsubr (&Sinternal_set_alternative_font_family_alist
);
8069 defsubr (&Sinternal_set_alternative_font_registry_alist
);
8070 defsubr (&Sface_attributes_as_vector
);
8072 defsubr (&Sdump_face
);
8073 defsubr (&Sshow_face_resources
);
8074 #endif /* GLYPH_DEBUG */
8075 defsubr (&Sclear_face_cache
);
8076 defsubr (&Stty_suppress_bold_inverse_default_colors
);
8078 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
8079 defsubr (&Sdump_colors
);
8082 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
8083 doc
: /* *Limit for font matching.
8084 If an integer > 0, font matching functions won't load more than
8085 that number of fonts when searching for a matching font. */);
8086 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
8088 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
8089 doc
: /* List of global face definitions (for internal use only.) */);
8090 Vface_new_frame_defaults
= Qnil
;
8092 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
8093 doc
: /* *Default stipple pattern used on monochrome displays.
8094 This stipple pattern is used on monochrome displays
8095 instead of shades of gray for a face background color.
8096 See `set-face-stipple' for possible values for this variable. */);
8097 Vface_default_stipple
= build_string ("gray3");
8099 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
8100 doc
: /* An alist of defined terminal colors and their RGB values. */);
8101 Vtty_defined_color_alist
= Qnil
;
8103 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
8104 doc
: /* Allowed scalable fonts.
8105 A value of nil means don't allow any scalable fonts.
8106 A value of t means allow any scalable font.
8107 Otherwise, value must be a list of regular expressions. A font may be
8108 scaled if its name matches a regular expression in the list.
8109 Note that if value is nil, a scalable font might still be used, if no
8110 other font of the appropriate family and registry is available. */);
8111 Vscalable_fonts_allowed
= Qnil
;
8113 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
8114 doc
: /* List of ignored fonts.
8115 Each element is a regular expression that matches names of fonts to
8117 Vface_ignored_fonts
= Qnil
;
8119 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
8120 doc
: /* Alist of fonts vs the rescaling factors.
8121 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
8122 FONT-NAME-PATTERN is a regular expression matching a font name, and
8123 RESCALE-RATIO is a floating point number to specify how much larger
8124 \(or smaller) font we should use. For instance, if a face requests
8125 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
8126 Vface_font_rescale_alist
= Qnil
;
8128 #ifdef HAVE_WINDOW_SYSTEM
8129 defsubr (&Sbitmap_spec_p
);
8130 defsubr (&Sx_list_fonts
);
8131 defsubr (&Sinternal_face_x_get_resource
);
8132 defsubr (&Sx_family_fonts
);
8133 defsubr (&Sx_font_family_list
);
8134 #endif /* HAVE_WINDOW_SYSTEM */
8137 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
8138 (do not change this comment) */