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., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
77 Faces are frame-local by nature because Emacs allows to define the
78 same named face (face names are symbols) differently for different
79 frames. Each frame has an alist of face definitions for all named
80 faces. The value of a named face in such an alist is a Lisp vector
81 with the symbol `face' in slot 0, and a slot for each of the face
82 attributes mentioned above.
84 There is also a global face alist `Vface_new_frame_defaults'. Face
85 definitions from this list are used to initialize faces of newly
88 A face doesn't have to specify all attributes. Those not specified
89 have a value of `unspecified'. Faces specifying all attributes but
90 the 14th are called `fully-specified'.
95 The display style of a given character in the text is determined by
96 combining several faces. This process is called `face merging'.
97 Any aspect of the display style that isn't specified by overlays or
98 text properties is taken from the `default' face. Since it is made
99 sure that the default face is always fully-specified, face merging
100 always results in a fully-specified face.
105 After all face attributes for a character have been determined by
106 merging faces of that character, that face is `realized'. The
107 realization process maps face attributes to what is physically
108 available on the system where Emacs runs. The result is a
109 `realized face' in form of a struct face which is stored in the
110 face cache of the frame on which it was realized.
112 Face realization is done in the context of the character to display
113 because different fonts may be used for different characters. In
114 other words, for characters that have different font
115 specifications, different realized faces are needed to display
118 Font specification is done by fontsets. See the comment in
119 fontset.c for the details. In the current implementation, all ASCII
120 characters share the same font in a fontset.
122 Faces are at first realized for ASCII characters, and, at that
123 time, assigned a specific realized fontset. Hereafter, we call
124 such a face as `ASCII face'. When a face for a multibyte character
125 is realized, it inherits (thus shares) a fontset of an ASCII face
126 that has the same attributes other than font-related ones.
128 Thus, all realized faces have a realized fontset.
133 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
134 font as ASCII characters. That is because it is expected that
135 unibyte text users specify a font that is suitable both for ASCII
136 and raw 8-bit characters.
141 Font selection tries to find the best available matching font for a
142 given (character, face) combination.
144 If the face specifies a fontset name, that fontset determines a
145 pattern for fonts of the given character. If the face specifies a
146 font name or the other font-related attributes, a fontset is
147 realized from the default fontset. In that case, that
148 specification determines a pattern for ASCII characters and the
149 default fontset determines a pattern for multibyte characters.
151 Available fonts on the system on which Emacs runs are then matched
152 against the font pattern. The result of font selection is the best
153 match for the given face attributes in this font list.
155 Font selection can be influenced by the user.
157 1. The user can specify the relative importance he gives the face
158 attributes width, height, weight, and slant by setting
159 face-font-selection-order (faces.el) to a list of face attribute
160 names. The default is '(:width :height :weight :slant), and means
161 that font selection first tries to find a good match for the font
162 width specified by a face, then---within fonts with that
163 width---tries to find a best match for the specified font height,
166 2. Setting face-font-family-alternatives allows the user to
167 specify alternative font families to try if a family specified by a
170 3. Setting face-font-registry-alternatives allows the user to
171 specify all alternative font registries to try for a face
172 specifying a registry.
174 4. Setting face-ignored-fonts allows the user to ignore specific
178 Character composition.
180 Usually, the realization process is already finished when Emacs
181 actually reflects the desired glyph matrix on the screen. However,
182 on displaying a composition (sequence of characters to be composed
183 on the screen), a suitable font for the components of the
184 composition is selected and realized while drawing them on the
185 screen, i.e. the realization process is delayed but in principle
189 Initialization of basic faces.
191 The faces `default', `modeline' are considered `basic faces'.
192 When redisplay happens the first time for a newly created frame,
193 basic faces are realized for CHARSET_ASCII. Frame parameters are
194 used to fill in unspecified attributes of the default face. */
198 #include <sys/types.h>
199 #include <sys/stat.h>
202 #include "character.h"
204 #include "keyboard.h"
207 #ifdef HAVE_WINDOW_SYSTEM
209 #endif /* HAVE_WINDOW_SYSTEM */
211 #ifdef HAVE_X_WINDOWS
215 #include <Xm/XmStrDefs.h>
216 #endif /* USE_MOTIF */
217 #endif /* HAVE_X_WINDOWS */
226 /* Redefine X specifics to W32 equivalents to avoid cluttering the
227 code with #ifdef blocks. */
228 #undef FRAME_X_DISPLAY_INFO
229 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
230 #define x_display_info w32_display_info
231 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
232 #define check_x check_w32
233 #define x_list_fonts w32_list_fonts
234 #define GCGraphicsExposures 0
235 #endif /* WINDOWSNT */
239 #define x_display_info mac_display_info
240 #define check_x check_mac
244 #include "dispextern.h"
245 #include "blockinput.h"
247 #include "intervals.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
256 #ifdef XOS_NEEDS_TIME_H
262 #else /* not XOS_NEEDS_TIME_H */
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
270 #define abs(X) ((X) < 0 ? -(X) : (X))
272 /* Number of pt per inch (from the TeXbook). */
274 #define PT_PER_INCH 72.27
276 /* Non-zero if face attribute ATTR is unspecified. */
278 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
280 /* Value is the number of elements of VECTOR. */
282 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
284 /* Make a copy of string S on the stack using alloca. Value is a pointer
287 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
289 /* Make a copy of the contents of Lisp string S on the stack using
290 alloca. Value is a pointer to the copy. */
292 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
294 /* Size of hash table of realized faces in face caches (should be a
297 #define FACE_CACHE_BUCKETS_SIZE 1001
299 /* Keyword symbols used for face attribute names. */
301 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
302 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
303 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
304 Lisp_Object QCreverse_video
;
305 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
306 Lisp_Object QCfontset
;
308 /* Symbols used for attribute values. */
310 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
311 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
312 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
313 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
314 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
315 Lisp_Object Qultra_expanded
;
316 Lisp_Object Qreleased_button
, Qpressed_button
;
317 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
318 Lisp_Object Qunspecified
;
320 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
322 /* The name of the function to call when the background of the frame
323 has changed, frame_update_face_colors. */
325 Lisp_Object Qframe_update_face_colors
;
327 /* Names of basic faces. */
329 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
330 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
331 Lisp_Object Qmode_line_inactive
;
332 extern Lisp_Object Qmode_line
;
334 /* The symbol `face-alias'. A symbols having that property is an
335 alias for another face. Value of the property is the name of
338 Lisp_Object Qface_alias
;
340 /* Default stipple pattern used on monochrome displays. This stipple
341 pattern is used on monochrome displays instead of shades of gray
342 for a face background color. See `set-face-stipple' for possible
343 values for this variable. */
345 Lisp_Object Vface_default_stipple
;
347 /* Alist of alternative font families. Each element is of the form
348 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
349 try FAMILY1, then FAMILY2, ... */
351 Lisp_Object Vface_alternative_font_family_alist
;
353 /* Alist of alternative font registries. Each element is of the form
354 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
355 loaded, try REGISTRY1, then REGISTRY2, ... */
357 Lisp_Object Vface_alternative_font_registry_alist
;
359 /* Allowed scalable fonts. A value of nil means don't allow any
360 scalable fonts. A value of t means allow the use of any scalable
361 font. Otherwise, value must be a list of regular expressions. A
362 font may be scaled if its name matches a regular expression in the
365 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
367 /* List of regular expressions that matches names of fonts to ignore. */
369 Lisp_Object Vface_ignored_fonts
;
371 /* Alist of font name patterns vs the rescaling factor. */
373 Lisp_Object Vface_font_rescale_alist
;
375 /* Maximum number of fonts to consider in font_list. If not an
376 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
378 Lisp_Object Vfont_list_limit
;
379 #define DEFAULT_FONT_LIST_LIMIT 100
381 /* The symbols `foreground-color' and `background-color' which can be
382 used as part of a `face' property. This is for compatibility with
385 Lisp_Object Qforeground_color
, Qbackground_color
;
387 /* The symbols `face' and `mouse-face' used as text properties. */
390 extern Lisp_Object Qmouse_face
;
392 /* Property for basic faces which other faces cannot inherit. */
394 Lisp_Object Qface_no_inherit
;
396 /* Error symbol for wrong_type_argument in load_pixmap. */
398 Lisp_Object Qbitmap_spec_p
;
400 /* Alist of global face definitions. Each element is of the form
401 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
402 is a Lisp vector of face attributes. These faces are used
403 to initialize faces for new frames. */
405 Lisp_Object Vface_new_frame_defaults
;
407 /* The next ID to assign to Lisp faces. */
409 static int next_lface_id
;
411 /* A vector mapping Lisp face Id's to face names. */
413 static Lisp_Object
*lface_id_to_name
;
414 static int lface_id_to_name_size
;
416 /* TTY color-related functions (defined in tty-colors.el). */
418 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
420 /* The name of the function used to compute colors on TTYs. */
422 Lisp_Object Qtty_color_alist
;
424 /* An alist of defined terminal colors and their RGB values. */
426 Lisp_Object Vtty_defined_color_alist
;
428 /* Counter for calls to clear_face_cache. If this counter reaches
429 CLEAR_FONT_TABLE_COUNT, and a frame has more than
430 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
432 static int clear_font_table_count
;
433 #define CLEAR_FONT_TABLE_COUNT 100
434 #define CLEAR_FONT_TABLE_NFONTS 10
436 /* Non-zero means face attributes have been changed since the last
437 redisplay. Used in redisplay_internal. */
439 int face_change_count
;
441 /* Non-zero means don't display bold text if a face's foreground
442 and background colors are the inverse of the default colors of the
443 display. This is a kluge to suppress `bold black' foreground text
444 which is hard to read on an LCD monitor. */
446 int tty_suppress_bold_inverse_default_colors_p
;
448 /* A list of the form `((x . y))' used to avoid consing in
449 Finternal_set_lisp_face_attribute. */
451 static Lisp_Object Vparam_value_alist
;
453 /* The total number of colors currently allocated. */
456 static int ncolors_allocated
;
457 static int npixmaps_allocated
;
461 /* Non-zero means the definition of the `menu' face for new frames has
464 int menu_face_changed_default
;
467 /* Function prototypes. */
471 struct named_merge_point
;
473 static void map_tty_color
P_ ((struct frame
*, struct face
*,
474 enum lface_attribute_index
, int *));
475 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
476 static int may_use_scalable_font_p
P_ ((const char *));
477 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
478 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
480 static int x_face_list_fonts
P_ ((struct frame
*, char *,
481 struct font_name
**, int, int));
482 static int font_scalable_p
P_ ((struct font_name
*));
483 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
484 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
485 static unsigned char *xstrlwr
P_ ((unsigned char *));
486 static void signal_error
P_ ((char *, Lisp_Object
));
487 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
488 static void load_face_font
P_ ((struct frame
*, struct face
*));
489 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
490 static void free_face_colors
P_ ((struct frame
*, struct face
*));
491 static int face_color_gray_p
P_ ((struct frame
*, char *));
492 static char *build_font_name
P_ ((struct font_name
*));
493 static void free_font_names
P_ ((struct font_name
*, int));
494 static int sorted_font_list
P_ ((struct frame
*, char *,
495 int (*cmpfn
) P_ ((const void *, const void *)),
496 struct font_name
**));
497 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
498 Lisp_Object
, struct font_name
**));
499 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
500 Lisp_Object
, struct font_name
**));
501 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
502 Lisp_Object
, Lisp_Object
, struct font_name
**));
503 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
504 Lisp_Object
, struct font_name
**));
505 static int cmp_font_names
P_ ((const void *, const void *));
506 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
508 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
510 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
511 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
512 static int realize_basic_faces
P_ ((struct frame
*));
513 static int realize_default_face
P_ ((struct frame
*));
514 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
515 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
516 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
517 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
518 static unsigned lface_hash
P_ ((Lisp_Object
*));
519 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
520 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
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 void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*,
528 struct named_merge_point
*));
529 static int merge_face_ref
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*,
530 int, struct named_merge_point
*));
531 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
532 Lisp_Object
, int, int));
533 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
534 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
535 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
536 struct font_name
*, int, int, int *));
537 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
538 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
539 static int xlfd_numeric_slant
P_ ((struct font_name
*));
540 static int xlfd_numeric_weight
P_ ((struct font_name
*));
541 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
542 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
543 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
544 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
545 static int xlfd_fixed_p
P_ ((struct font_name
*));
546 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
548 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
549 struct font_name
*, int,
551 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
552 struct font_name
*, int));
554 #ifdef HAVE_WINDOW_SYSTEM
556 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
557 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
558 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
559 int (*cmpfn
) P_ ((const void *, const void *))));
560 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
561 static void x_free_gc
P_ ((struct frame
*, GC
));
562 static void clear_font_table
P_ ((struct x_display_info
*));
565 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
566 #endif /* WINDOWSNT */
569 static void x_update_menu_appearance
P_ ((struct frame
*));
571 extern void free_frame_menubar
P_ ((struct frame
*));
572 #endif /* USE_X_TOOLKIT */
574 #endif /* HAVE_WINDOW_SYSTEM */
577 /***********************************************************************
579 ***********************************************************************/
581 #ifdef HAVE_X_WINDOWS
583 #ifdef DEBUG_X_COLORS
585 /* The following is a poor mans infrastructure for debugging X color
586 allocation problems on displays with PseudoColor-8. Some X servers
587 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
588 color reference counts completely so that they don't signal an
589 error when a color is freed whose reference count is already 0.
590 Other X servers do. To help me debug this, the following code
591 implements a simple reference counting schema of its own, for a
592 single display/screen. --gerd. */
594 /* Reference counts for pixel colors. */
596 int color_count
[256];
598 /* Register color PIXEL as allocated. */
601 register_color (pixel
)
604 xassert (pixel
< 256);
605 ++color_count
[pixel
];
609 /* Register color PIXEL as deallocated. */
612 unregister_color (pixel
)
615 xassert (pixel
< 256);
616 if (color_count
[pixel
] > 0)
617 --color_count
[pixel
];
623 /* Register N colors from PIXELS as deallocated. */
626 unregister_colors (pixels
, n
)
627 unsigned long *pixels
;
631 for (i
= 0; i
< n
; ++i
)
632 unregister_color (pixels
[i
]);
636 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
637 doc
: /* Dump currently allocated colors to stderr. */)
642 fputc ('\n', stderr
);
644 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
647 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
650 fputc ('\n', stderr
);
652 fputc ('\t', stderr
);
656 fputc ('\n', stderr
);
660 #endif /* DEBUG_X_COLORS */
663 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
664 color values. Interrupt input must be blocked when this function
668 x_free_colors (f
, pixels
, npixels
)
670 unsigned long *pixels
;
673 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
675 /* If display has an immutable color map, freeing colors is not
676 necessary and some servers don't allow it. So don't do it. */
677 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
679 #ifdef DEBUG_X_COLORS
680 unregister_colors (pixels
, npixels
);
682 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
688 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
689 color values. Interrupt input must be blocked when this function
693 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
697 unsigned long *pixels
;
700 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
701 int class = dpyinfo
->visual
->class;
703 /* If display has an immutable color map, freeing colors is not
704 necessary and some servers don't allow it. So don't do it. */
705 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
707 #ifdef DEBUG_X_COLORS
708 unregister_colors (pixels
, npixels
);
710 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
715 /* Create and return a GC for use on frame F. GC values and mask
716 are given by XGCV and MASK. */
719 x_create_gc (f
, mask
, xgcv
)
726 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
733 /* Free GC which was used on frame F. */
741 IF_DEBUG (xassert (--ngcs
>= 0));
742 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
746 #endif /* HAVE_X_WINDOWS */
749 /* W32 emulation of GCs */
752 x_create_gc (f
, mask
, xgcv
)
759 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
766 /* Free GC which was used on frame F. */
774 IF_DEBUG (xassert (--ngcs
>= 0));
779 #endif /* WINDOWSNT */
782 /* Mac OS emulation of GCs */
784 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
787 x_create_gc (f
, mask
, xgcv
)
793 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
802 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
807 /* Like stricmp. Used to compare parts of font names which are in
812 const unsigned char *s1
, *s2
;
816 unsigned char c1
= tolower (*s1
);
817 unsigned char c2
= tolower (*s2
);
819 return c1
< c2
? -1 : 1;
824 return *s2
== 0 ? 0 : -1;
829 /* Like strlwr, which might not always be available. */
831 static unsigned char *
835 unsigned char *p
= s
;
844 /* Signal `error' with message S, and additional argument ARG. */
847 signal_error (s
, arg
)
851 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
855 /* If FRAME is nil, return a pointer to the selected frame.
856 Otherwise, check that FRAME is a live frame, and return a pointer
857 to it. NPARAM is the parameter number of FRAME, for
858 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
859 Lisp function definitions. */
861 static INLINE
struct frame
*
862 frame_or_selected_frame (frame
, nparam
)
867 frame
= selected_frame
;
869 CHECK_LIVE_FRAME (frame
);
870 return XFRAME (frame
);
874 /***********************************************************************
876 ***********************************************************************/
878 /* Initialize face cache and basic faces for frame F. */
884 /* Make a face cache, if F doesn't have one. */
885 if (FRAME_FACE_CACHE (f
) == NULL
)
886 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
888 #ifdef HAVE_WINDOW_SYSTEM
889 /* Make the image cache. */
890 if (FRAME_WINDOW_P (f
))
892 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
893 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
894 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
896 #endif /* HAVE_WINDOW_SYSTEM */
898 /* Realize basic faces. Must have enough information in frame
899 parameters to realize basic faces at this point. */
900 #ifdef HAVE_X_WINDOWS
901 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
904 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
907 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
909 if (!realize_basic_faces (f
))
914 /* Free face cache of frame F. Called from Fdelete_frame. */
920 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
924 free_face_cache (face_cache
);
925 FRAME_FACE_CACHE (f
) = NULL
;
928 #ifdef HAVE_WINDOW_SYSTEM
929 if (FRAME_WINDOW_P (f
))
931 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
934 --image_cache
->refcount
;
935 if (image_cache
->refcount
== 0)
936 free_image_cache (f
);
939 #endif /* HAVE_WINDOW_SYSTEM */
943 /* Clear face caches, and recompute basic faces for frame F. Call
944 this after changing frame parameters on which those faces depend,
945 or when realized faces have been freed due to changing attributes
949 recompute_basic_faces (f
)
952 if (FRAME_FACE_CACHE (f
))
954 clear_face_cache (0);
955 if (!realize_basic_faces (f
))
961 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
962 try to free unused fonts, too. */
965 clear_face_cache (clear_fonts_p
)
968 #ifdef HAVE_WINDOW_SYSTEM
969 Lisp_Object tail
, frame
;
973 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
975 struct x_display_info
*dpyinfo
;
977 /* Fonts are common for frames on one display, i.e. on
979 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
980 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
981 clear_font_table (dpyinfo
);
983 /* From time to time see if we can unload some fonts. This also
984 frees all realized faces on all frames. Fonts needed by
985 faces will be loaded again when faces are realized again. */
986 clear_font_table_count
= 0;
988 FOR_EACH_FRAME (tail
, frame
)
990 struct frame
*f
= XFRAME (frame
);
991 if (FRAME_WINDOW_P (f
)
992 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
993 free_all_realized_faces (frame
);
998 /* Clear GCs of realized faces. */
999 FOR_EACH_FRAME (tail
, frame
)
1002 if (FRAME_WINDOW_P (f
))
1004 clear_face_gcs (FRAME_FACE_CACHE (f
));
1005 clear_image_cache (f
, 0);
1009 #endif /* HAVE_WINDOW_SYSTEM */
1013 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1014 doc
: /* Clear face caches on all frames.
1015 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1017 Lisp_Object thoroughly
;
1019 clear_face_cache (!NILP (thoroughly
));
1020 ++face_change_count
;
1021 ++windows_or_buffers_changed
;
1027 #ifdef HAVE_WINDOW_SYSTEM
1030 /* Remove fonts from the font table of DPYINFO except for the default
1031 ASCII fonts of frames on that display. Called from clear_face_cache
1032 from time to time. */
1035 clear_font_table (dpyinfo
)
1036 struct x_display_info
*dpyinfo
;
1040 /* Free those fonts that are not used by frames on DPYINFO. */
1041 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1043 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1044 Lisp_Object tail
, frame
;
1046 /* Check if slot is already free. */
1047 if (font_info
->name
== NULL
)
1050 /* Don't free a default font of some frame. */
1051 FOR_EACH_FRAME (tail
, frame
)
1053 struct frame
*f
= XFRAME (frame
);
1054 if (FRAME_WINDOW_P (f
)
1055 && font_info
->font
== FRAME_FONT (f
))
1063 if (font_info
->full_name
!= font_info
->name
)
1064 xfree (font_info
->full_name
);
1065 xfree (font_info
->name
);
1067 /* Free the font. */
1069 #ifdef HAVE_X_WINDOWS
1070 XFreeFont (dpyinfo
->display
, font_info
->font
);
1073 w32_unload_font (dpyinfo
, font_info
->font
);
1076 mac_unload_font (dpyinfo
, font_info
->font
);
1080 /* Mark font table slot free. */
1081 font_info
->font
= NULL
;
1082 font_info
->name
= font_info
->full_name
= NULL
;
1086 #endif /* HAVE_WINDOW_SYSTEM */
1090 /***********************************************************************
1092 ***********************************************************************/
1094 #ifdef HAVE_WINDOW_SYSTEM
1096 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1097 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1098 A bitmap specification is either a string, a file name, or a list
1099 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1100 HEIGHT is its height, and DATA is a string containing the bits of
1101 the pixmap. Bits are stored row by row, each row occupies
1102 \(WIDTH + 7)/8 bytes. */)
1108 if (STRINGP (object
))
1109 /* If OBJECT is a string, it's a file name. */
1111 else if (CONSP (object
))
1113 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1114 HEIGHT must be integers > 0, and DATA must be string large
1115 enough to hold a bitmap of the specified size. */
1116 Lisp_Object width
, height
, data
;
1118 height
= width
= data
= Qnil
;
1122 width
= XCAR (object
);
1123 object
= XCDR (object
);
1126 height
= XCAR (object
);
1127 object
= XCDR (object
);
1129 data
= XCAR (object
);
1133 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1135 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1137 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1142 return pixmap_p
? Qt
: Qnil
;
1146 /* Load a bitmap according to NAME (which is either a file name or a
1147 pixmap spec) for use on frame F. Value is the bitmap_id (see
1148 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1149 bitmap cannot be loaded, display a message saying so, and return
1150 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1151 if these pointers are not null. */
1154 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1157 unsigned int *w_ptr
, *h_ptr
;
1165 tem
= Fbitmap_spec_p (name
);
1167 wrong_type_argument (Qbitmap_spec_p
, name
);
1172 /* Decode a bitmap spec into a bitmap. */
1177 w
= XINT (Fcar (name
));
1178 h
= XINT (Fcar (Fcdr (name
)));
1179 bits
= Fcar (Fcdr (Fcdr (name
)));
1181 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1186 /* It must be a string -- a file name. */
1187 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1193 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1204 ++npixmaps_allocated
;
1207 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1210 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1216 #endif /* HAVE_WINDOW_SYSTEM */
1220 /***********************************************************************
1222 ***********************************************************************/
1224 #ifdef HAVE_WINDOW_SYSTEM
1226 /* Load font of face FACE which is used on frame F to display ASCII
1227 characters. The name of the font to load is determined by lface. */
1230 load_face_font (f
, face
)
1234 struct font_info
*font_info
= NULL
;
1236 int needs_overstrike
;
1238 face
->font_info_id
= -1;
1240 face
->font_name
= NULL
;
1242 font_name
= choose_face_font (f
, face
->lface
, Qnil
, &needs_overstrike
);
1247 font_info
= FS_LOAD_FONT (f
, font_name
);
1252 face
->font_info_id
= font_info
->font_idx
;
1253 face
->font
= font_info
->font
;
1254 face
->font_name
= font_info
->full_name
;
1255 face
->overstrike
= needs_overstrike
;
1258 x_free_gc (f
, face
->gc
);
1263 add_to_log ("Unable to load font %s",
1264 build_string (font_name
), Qnil
);
1268 #endif /* HAVE_WINDOW_SYSTEM */
1272 /***********************************************************************
1274 ***********************************************************************/
1276 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1277 RGB_LIST should contain (at least) 3 lisp integers.
1278 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1281 parse_rgb_list (rgb_list
, color
)
1282 Lisp_Object rgb_list
;
1285 #define PARSE_RGB_LIST_FIELD(field) \
1286 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1288 color->field = XINT (XCAR (rgb_list)); \
1289 rgb_list = XCDR (rgb_list); \
1294 PARSE_RGB_LIST_FIELD (red
);
1295 PARSE_RGB_LIST_FIELD (green
);
1296 PARSE_RGB_LIST_FIELD (blue
);
1302 /* Lookup on frame F the color described by the lisp string COLOR.
1303 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1304 non-zero, then the `standard' definition of the same color is
1308 tty_lookup_color (f
, color
, tty_color
, std_color
)
1311 XColor
*tty_color
, *std_color
;
1313 Lisp_Object frame
, color_desc
;
1315 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1318 XSETFRAME (frame
, f
);
1320 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1321 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1325 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1328 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1330 rgb
= XCDR (XCDR (color_desc
));
1331 if (! parse_rgb_list (rgb
, tty_color
))
1334 /* Should we fill in STD_COLOR too? */
1337 /* Default STD_COLOR to the same as TTY_COLOR. */
1338 *std_color
= *tty_color
;
1340 /* Do a quick check to see if the returned descriptor is
1341 actually _exactly_ equal to COLOR, otherwise we have to
1342 lookup STD_COLOR separately. If it's impossible to lookup
1343 a standard color, we just give up and use TTY_COLOR. */
1344 if ((!STRINGP (XCAR (color_desc
))
1345 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1346 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1348 /* Look up STD_COLOR separately. */
1349 rgb
= call1 (Qtty_color_standard_values
, color
);
1350 if (! parse_rgb_list (rgb
, std_color
))
1357 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1358 /* We were called early during startup, and the colors are not
1359 yet set up in tty-defined-color-alist. Don't return a failure
1360 indication, since this produces the annoying "Unable to
1361 load color" messages in the *Messages* buffer. */
1364 /* tty-color-desc seems to have returned a bad value. */
1368 /* A version of defined_color for non-X frames. */
1371 tty_defined_color (f
, color_name
, color_def
, alloc
)
1380 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1382 color_def
->blue
= 0;
1383 color_def
->green
= 0;
1386 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1388 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1390 if (strcmp (color_name
, "unspecified-fg") == 0)
1391 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1392 else if (strcmp (color_name
, "unspecified-bg") == 0)
1393 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1396 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1403 /* Decide if color named COLOR_NAME is valid for the display
1404 associated with the frame F; if so, return the rgb values in
1405 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1407 This does the right thing for any type of frame. */
1410 defined_color (f
, color_name
, color_def
, alloc
)
1416 if (!FRAME_WINDOW_P (f
))
1417 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1418 #ifdef HAVE_X_WINDOWS
1419 else if (FRAME_X_P (f
))
1420 return x_defined_color (f
, color_name
, color_def
, alloc
);
1423 else if (FRAME_W32_P (f
))
1424 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1427 else if (FRAME_MAC_P (f
))
1428 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1435 /* Given the index IDX of a tty color on frame F, return its name, a
1439 tty_color_name (f
, idx
)
1443 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1446 Lisp_Object coldesc
;
1448 XSETFRAME (frame
, f
);
1449 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1451 if (!NILP (coldesc
))
1452 return XCAR (coldesc
);
1455 /* We can have an MSDOG frame under -nw for a short window of
1456 opportunity before internal_terminal_init is called. DTRT. */
1457 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1458 return msdos_stdcolor_name (idx
);
1461 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1462 return build_string (unspecified_fg
);
1463 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1464 return build_string (unspecified_bg
);
1467 return vga_stdcolor_name (idx
);
1470 return Qunspecified
;
1474 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1475 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1478 face_color_gray_p (f
, color_name
)
1485 if (defined_color (f
, color_name
, &color
, 0))
1486 gray_p
= ((abs (color
.red
- color
.green
)
1487 < max (color
.red
, color
.green
) / 20)
1488 && (abs (color
.green
- color
.blue
)
1489 < max (color
.green
, color
.blue
) / 20)
1490 && (abs (color
.blue
- color
.red
)
1491 < max (color
.blue
, color
.red
) / 20));
1499 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1500 BACKGROUND_P non-zero means the color will be used as background
1504 face_color_supported_p (f
, color_name
, background_p
)
1512 XSETFRAME (frame
, f
);
1514 #ifdef HAVE_WINDOW_SYSTEM
1516 ? (!NILP (Fxw_display_color_p (frame
))
1517 || xstricmp (color_name
, "black") == 0
1518 || xstricmp (color_name
, "white") == 0
1520 && face_color_gray_p (f
, color_name
))
1521 || (!NILP (Fx_display_grayscale_p (frame
))
1522 && face_color_gray_p (f
, color_name
)))
1525 tty_defined_color (f
, color_name
, ¬_used
, 0);
1529 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1530 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1531 FRAME specifies the frame and thus the display for interpreting COLOR.
1532 If FRAME is nil or omitted, use the selected frame. */)
1534 Lisp_Object color
, frame
;
1538 CHECK_STRING (color
);
1540 frame
= selected_frame
;
1542 CHECK_FRAME (frame
);
1544 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1548 DEFUN ("color-supported-p", Fcolor_supported_p
,
1549 Scolor_supported_p
, 1, 3, 0,
1550 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1551 BACKGROUND-P non-nil means COLOR is used as a background.
1552 Otherwise, this function tells whether it can be used as a foreground.
1553 If FRAME is nil or omitted, use the selected frame.
1554 COLOR must be a valid color name. */)
1555 (color
, frame
, background_p
)
1556 Lisp_Object frame
, color
, background_p
;
1560 CHECK_STRING (color
);
1562 frame
= selected_frame
;
1564 CHECK_FRAME (frame
);
1566 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1572 /* Load color with name NAME for use by face FACE on frame F.
1573 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1574 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1575 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1576 pixel color. If color cannot be loaded, display a message, and
1577 return the foreground, background or underline color of F, but
1578 record that fact in flags of the face so that we don't try to free
1582 load_color (f
, face
, name
, target_index
)
1586 enum lface_attribute_index target_index
;
1590 xassert (STRINGP (name
));
1591 xassert (target_index
== LFACE_FOREGROUND_INDEX
1592 || target_index
== LFACE_BACKGROUND_INDEX
1593 || target_index
== LFACE_UNDERLINE_INDEX
1594 || target_index
== LFACE_OVERLINE_INDEX
1595 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1596 || target_index
== LFACE_BOX_INDEX
);
1598 /* if the color map is full, defined_color will return a best match
1599 to the values in an existing cell. */
1600 if (!defined_color (f
, SDATA (name
), &color
, 1))
1602 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1604 switch (target_index
)
1606 case LFACE_FOREGROUND_INDEX
:
1607 face
->foreground_defaulted_p
= 1;
1608 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1611 case LFACE_BACKGROUND_INDEX
:
1612 face
->background_defaulted_p
= 1;
1613 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1616 case LFACE_UNDERLINE_INDEX
:
1617 face
->underline_defaulted_p
= 1;
1618 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1621 case LFACE_OVERLINE_INDEX
:
1622 face
->overline_color_defaulted_p
= 1;
1623 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1626 case LFACE_STRIKE_THROUGH_INDEX
:
1627 face
->strike_through_color_defaulted_p
= 1;
1628 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1631 case LFACE_BOX_INDEX
:
1632 face
->box_color_defaulted_p
= 1;
1633 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1642 ++ncolors_allocated
;
1649 #ifdef HAVE_WINDOW_SYSTEM
1651 /* Load colors for face FACE which is used on frame F. Colors are
1652 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1653 of ATTRS. If the background color specified is not supported on F,
1654 try to emulate gray colors with a stipple from Vface_default_stipple. */
1657 load_face_colors (f
, face
, attrs
)
1664 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1665 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1667 /* Swap colors if face is inverse-video. */
1668 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1676 /* Check for support for foreground, not for background because
1677 face_color_supported_p is smart enough to know that grays are
1678 "supported" as background because we are supposed to use stipple
1680 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1681 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1683 x_destroy_bitmap (f
, face
->stipple
);
1684 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1685 &face
->pixmap_w
, &face
->pixmap_h
);
1688 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1689 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1693 /* Free color PIXEL on frame F. */
1696 unload_color (f
, pixel
)
1698 unsigned long pixel
;
1700 #ifdef HAVE_X_WINDOWS
1704 x_free_colors (f
, &pixel
, 1);
1711 /* Free colors allocated for FACE. */
1714 free_face_colors (f
, face
)
1718 #ifdef HAVE_X_WINDOWS
1719 if (face
->colors_copied_bitwise_p
)
1724 if (!face
->foreground_defaulted_p
)
1726 x_free_colors (f
, &face
->foreground
, 1);
1727 IF_DEBUG (--ncolors_allocated
);
1730 if (!face
->background_defaulted_p
)
1732 x_free_colors (f
, &face
->background
, 1);
1733 IF_DEBUG (--ncolors_allocated
);
1736 if (face
->underline_p
1737 && !face
->underline_defaulted_p
)
1739 x_free_colors (f
, &face
->underline_color
, 1);
1740 IF_DEBUG (--ncolors_allocated
);
1743 if (face
->overline_p
1744 && !face
->overline_color_defaulted_p
)
1746 x_free_colors (f
, &face
->overline_color
, 1);
1747 IF_DEBUG (--ncolors_allocated
);
1750 if (face
->strike_through_p
1751 && !face
->strike_through_color_defaulted_p
)
1753 x_free_colors (f
, &face
->strike_through_color
, 1);
1754 IF_DEBUG (--ncolors_allocated
);
1757 if (face
->box
!= FACE_NO_BOX
1758 && !face
->box_color_defaulted_p
)
1760 x_free_colors (f
, &face
->box_color
, 1);
1761 IF_DEBUG (--ncolors_allocated
);
1765 #endif /* HAVE_X_WINDOWS */
1768 #endif /* HAVE_WINDOW_SYSTEM */
1772 /***********************************************************************
1774 ***********************************************************************/
1776 /* An enumerator for each field of an XLFD font name. */
1797 /* An enumerator for each possible slant value of a font. Taken from
1798 the XLFD specification. */
1806 XLFD_SLANT_REVERSE_ITALIC
,
1807 XLFD_SLANT_REVERSE_OBLIQUE
,
1811 /* Relative font weight according to XLFD documentation. */
1815 XLFD_WEIGHT_UNKNOWN
,
1816 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1817 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1818 XLFD_WEIGHT_LIGHT
, /* 30 */
1819 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1820 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1821 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1822 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1823 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1824 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1827 /* Relative proportionate width. */
1831 XLFD_SWIDTH_UNKNOWN
,
1832 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1833 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1834 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1835 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1836 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1837 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1838 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1839 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1840 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1843 /* Structure used for tables mapping XLFD weight, slant, and width
1844 names to numeric and symbolic values. */
1850 Lisp_Object
*symbol
;
1853 /* Table of XLFD slant names and their numeric and symbolic
1854 representations. This table must be sorted by slant names in
1857 static struct table_entry slant_table
[] =
1859 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1860 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1861 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1862 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1863 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1864 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1867 /* Table of XLFD weight names. This table must be sorted by weight
1868 names in ascending order. */
1870 static struct table_entry weight_table
[] =
1872 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1873 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1874 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1875 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1876 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1877 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1878 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1879 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1880 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1881 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1882 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1883 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1884 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1885 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1886 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1887 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1890 /* Table of XLFD width names. This table must be sorted by width
1891 names in ascending order. */
1893 static struct table_entry swidth_table
[] =
1895 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1896 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1897 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1898 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1899 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1900 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1901 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1902 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1903 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1904 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1905 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1906 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1907 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1908 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1909 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1912 /* Structure used to hold the result of splitting font names in XLFD
1913 format into their fields. */
1917 /* The original name which is modified destructively by
1918 split_font_name. The pointer is kept here to be able to free it
1919 if it was allocated from the heap. */
1922 /* Font name fields. Each vector element points into `name' above.
1923 Fields are NUL-terminated. */
1924 char *fields
[XLFD_LAST
];
1926 /* Numeric values for those fields that interest us. See
1927 split_font_name for which these are. */
1928 int numeric
[XLFD_LAST
];
1930 /* If the original name matches one of Vface_font_rescale_alist,
1931 the value is the corresponding rescale ratio. Otherwise, the
1933 double rescale_ratio
;
1935 /* Lower value mean higher priority. */
1936 int registry_priority
;
1939 /* The frame in effect when sorting font names. Set temporarily in
1940 sort_fonts so that it is available in font comparison functions. */
1942 static struct frame
*font_frame
;
1944 /* Order by which font selection chooses fonts. The default values
1945 mean `first, find a best match for the font width, then for the
1946 font height, then for weight, then for slant.' This variable can be
1947 set via set-face-font-sort-order. */
1950 static int font_sort_order
[4] = {
1951 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1954 static int font_sort_order
[4];
1957 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1958 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1959 is a pointer to the matching table entry or null if no table entry
1962 static struct table_entry
*
1963 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1964 struct table_entry
*table
;
1966 struct font_name
*font
;
1969 /* Function split_font_name converts fields to lower-case, so there
1970 is no need to use xstrlwr or xstricmp here. */
1971 char *s
= font
->fields
[field_index
];
1972 int low
, mid
, high
, cmp
;
1979 mid
= (low
+ high
) / 2;
1980 cmp
= strcmp (table
[mid
].name
, s
);
1994 /* Return a numeric representation for font name field
1995 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1996 has DIM entries. Value is the numeric value found or DFLT if no
1997 table entry matches. This function is used to translate weight,
1998 slant, and swidth names of XLFD font names to numeric values. */
2001 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
2002 struct table_entry
*table
;
2004 struct font_name
*font
;
2008 struct table_entry
*p
;
2009 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2010 return p
? p
->numeric
: dflt
;
2014 /* Return a symbolic representation for font name field
2015 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2016 has DIM entries. Value is the symbolic value found or DFLT if no
2017 table entry matches. This function is used to translate weight,
2018 slant, and swidth names of XLFD font names to symbols. */
2020 static INLINE Lisp_Object
2021 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2022 struct table_entry
*table
;
2024 struct font_name
*font
;
2028 struct table_entry
*p
;
2029 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2030 return p
? *p
->symbol
: dflt
;
2034 /* Return a numeric value for the slant of the font given by FONT. */
2037 xlfd_numeric_slant (font
)
2038 struct font_name
*font
;
2040 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2041 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2045 /* Return a symbol representing the weight of the font given by FONT. */
2047 static INLINE Lisp_Object
2048 xlfd_symbolic_slant (font
)
2049 struct font_name
*font
;
2051 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2052 font
, XLFD_SLANT
, Qnormal
);
2056 /* Return a numeric value for the weight of the font given by FONT. */
2059 xlfd_numeric_weight (font
)
2060 struct font_name
*font
;
2062 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2063 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2067 /* Return a symbol representing the slant of the font given by FONT. */
2069 static INLINE Lisp_Object
2070 xlfd_symbolic_weight (font
)
2071 struct font_name
*font
;
2073 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2074 font
, XLFD_WEIGHT
, Qnormal
);
2078 /* Return a numeric value for the swidth of the font whose XLFD font
2079 name fields are found in FONT. */
2082 xlfd_numeric_swidth (font
)
2083 struct font_name
*font
;
2085 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2086 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2090 /* Return a symbolic value for the swidth of FONT. */
2092 static INLINE Lisp_Object
2093 xlfd_symbolic_swidth (font
)
2094 struct font_name
*font
;
2096 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2097 font
, XLFD_SWIDTH
, Qnormal
);
2101 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2102 entries. Value is a pointer to the matching table entry or null if
2103 no element of TABLE contains SYMBOL. */
2105 static struct table_entry
*
2106 face_value (table
, dim
, symbol
)
2107 struct table_entry
*table
;
2113 xassert (SYMBOLP (symbol
));
2115 for (i
= 0; i
< dim
; ++i
)
2116 if (EQ (*table
[i
].symbol
, symbol
))
2119 return i
< dim
? table
+ i
: NULL
;
2123 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2124 entries. Value is -1 if SYMBOL is not found in TABLE. */
2127 face_numeric_value (table
, dim
, symbol
)
2128 struct table_entry
*table
;
2132 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2133 return p
? p
->numeric
: -1;
2137 /* Return a numeric value representing the weight specified by Lisp
2138 symbol WEIGHT. Value is one of the enumerators of enum
2142 face_numeric_weight (weight
)
2145 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2149 /* Return a numeric value representing the slant specified by Lisp
2150 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2153 face_numeric_slant (slant
)
2156 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2160 /* Return a numeric value representing the swidth specified by Lisp
2161 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2164 face_numeric_swidth (width
)
2167 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2170 #ifdef HAVE_WINDOW_SYSTEM
2173 split_font_name_into_vector (fontname
)
2174 Lisp_Object fontname
;
2176 struct font_name font
;
2180 font
.name
= LSTRDUPA (fontname
);
2181 if (! split_font_name (NULL
, &font
, 0))
2183 vec
= Fmake_vector (make_number (XLFD_LAST
), Qnil
);
2184 for (i
= 0; i
< XLFD_LAST
; i
++)
2185 if (font
.fields
[i
][0] != '*')
2186 ASET (vec
, i
, build_string (font
.fields
[i
]));
2191 build_font_name_from_vector (vec
)
2194 struct font_name font
;
2195 Lisp_Object fontname
;
2199 for (i
= 0; i
< XLFD_LAST
; i
++)
2201 font
.fields
[i
] = (NILP (AREF (vec
, i
))
2202 ? "*" : (char *) SDATA (AREF (vec
, i
)));
2203 if ((i
== XLFD_FAMILY
|| i
== XLFD_REGISTRY
)
2204 && (p
= strchr (font
.fields
[i
], '-')))
2206 char *p1
= STRDUPA (font
.fields
[i
]);
2208 p1
[p
- font
.fields
[i
]] = '\0';
2209 if (i
== XLFD_FAMILY
)
2211 font
.fields
[XLFD_FOUNDRY
] = p1
;
2212 font
.fields
[XLFD_FAMILY
] = p
+ 1;
2216 font
.fields
[XLFD_REGISTRY
] = p1
;
2217 font
.fields
[XLFD_ENCODING
] = p
+ 1;
2223 p
= build_font_name (&font
);
2224 fontname
= build_string (p
);
2229 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2233 struct font_name
*font
;
2235 /* Function split_font_name converts fields to lower-case, so there
2236 is no need to use tolower here. */
2237 return *font
->fields
[XLFD_SPACING
] != 'p';
2241 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2243 The actual height of the font when displayed on F depends on the
2244 resolution of both the font and frame. For example, a 10pt font
2245 designed for a 100dpi display will display larger than 10pt on a
2246 75dpi display. (It's not unusual to use fonts not designed for the
2247 display one is using. For example, some intlfonts are available in
2248 72dpi versions, only.)
2250 Value is the real point size of FONT on frame F, or 0 if it cannot
2253 By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */
2256 xlfd_point_size (f
, font
)
2258 struct font_name
*font
;
2260 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2261 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2265 if (*pixel_field
== '[')
2267 /* The pixel size field is `[A B C D]' which specifies
2268 a transformation matrix.
2274 by which all glyphs of the font are transformed. The spec
2275 says that s scalar value N for the pixel size is equivalent
2276 to A = N * resx/resy, B = C = 0, D = N. */
2277 char *start
= pixel_field
+ 1, *end
;
2281 for (i
= 0; i
< 4; ++i
)
2283 matrix
[i
] = strtod (start
, &end
);
2290 pixel
= atoi (pixel_field
);
2292 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel
;
2296 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2302 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2303 of frame F. This function is used to guess a point size of font
2304 when only the pixel height of the font is available. */
2307 pixel_point_size (f
, pixel
)
2311 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2315 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2316 point size of one dot. */
2317 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2318 int_pt
= real_pt
+ 0.5;
2324 /* Return a rescaling ratio of a font of NAME. */
2327 font_rescale_ratio (name
)
2330 Lisp_Object tail
, elt
;
2332 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2335 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2336 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2337 return XFLOAT_DATA (XCDR (elt
));
2343 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2344 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2345 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2346 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2347 zero if the font name doesn't have the format we expect. The
2348 expected format is a font name that starts with a `-' and has
2349 XLFD_LAST fields separated by `-'. */
2352 split_font_name (f
, font
, numeric_p
)
2354 struct font_name
*font
;
2359 double rescale_ratio
;
2362 /* This must be done before splitting the font name. */
2363 rescale_ratio
= font_rescale_ratio (font
->name
);
2365 if (*font
->name
== '-')
2367 char *p
= xstrlwr (font
->name
) + 1;
2369 while (i
< XLFD_LAST
)
2371 font
->fields
[i
] = p
;
2374 /* Pixel and point size may be of the form `[....]'. For
2375 BNF, see XLFD spec, chapter 4. Negative values are
2376 indicated by tilde characters which we replace with
2377 `-' characters, here. */
2379 && (i
- 1 == XLFD_PIXEL_SIZE
2380 || i
- 1 == XLFD_POINT_SIZE
))
2385 for (++p
; *p
&& *p
!= ']'; ++p
)
2389 /* Check that the matrix contains 4 floating point
2391 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2394 if (strtod (start
, &end
) == 0 && start
== end
)
2401 while (*p
&& *p
!= '-')
2411 success_p
= i
== XLFD_LAST
;
2413 /* If requested, and font name was in the expected format,
2414 compute numeric values for some fields. */
2415 if (numeric_p
&& success_p
)
2417 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2418 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2419 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2420 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2421 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2422 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2423 font
->rescale_ratio
= rescale_ratio
;
2426 /* Initialize it to zero. It will be overridden by font_list while
2427 trying alternate registries. */
2428 font
->registry_priority
= 0;
2434 /* Build an XLFD font name from font name fields in FONT. Value is a
2435 pointer to the font name, which is allocated via xmalloc. */
2438 build_font_name (font
)
2439 struct font_name
*font
;
2443 char *font_name
= (char *) xmalloc (size
);
2444 int total_length
= 0;
2446 for (i
= 0; i
< XLFD_LAST
; ++i
)
2448 /* Add 1 because of the leading `-'. */
2449 int len
= strlen (font
->fields
[i
]) + 1;
2451 /* Reallocate font_name if necessary. Add 1 for the final
2453 if (total_length
+ len
+ 1 >= size
)
2455 int new_size
= max (2 * size
, size
+ len
+ 1);
2456 int sz
= new_size
* sizeof *font_name
;
2457 font_name
= (char *) xrealloc (font_name
, sz
);
2461 font_name
[total_length
] = '-';
2462 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2463 total_length
+= len
;
2466 font_name
[total_length
] = 0;
2471 /* Free an array FONTS of N font_name structures. This frees FONTS
2472 itself and all `name' fields in its elements. */
2475 free_font_names (fonts
, n
)
2476 struct font_name
*fonts
;
2480 xfree (fonts
[--n
].name
);
2485 /* Sort vector FONTS of font_name structures which contains NFONTS
2486 elements using qsort and comparison function CMPFN. F is the frame
2487 on which the fonts will be used. The global variable font_frame
2488 is temporarily set to F to make it available in CMPFN. */
2491 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2493 struct font_name
*fonts
;
2495 int (*cmpfn
) P_ ((const void *, const void *));
2498 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2503 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2504 display in x_display_list. FONTS is a pointer to a vector of
2505 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2506 alternative patterns from Valternate_fontname_alist if no fonts are
2507 found matching PATTERN.
2509 For all fonts found, set FONTS[i].name to the name of the font,
2510 allocated via xmalloc, and split font names into fields. Ignore
2511 fonts that we can't parse. Value is the number of fonts found. */
2514 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2517 struct font_name
**pfonts
;
2518 int nfonts
, try_alternatives_p
;
2522 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2523 better to do it the other way around. */
2525 Lisp_Object lpattern
, tem
;
2526 struct font_name
*fonts
= 0;
2527 int num_fonts
= nfonts
;
2530 lpattern
= build_string (pattern
);
2532 /* Get the list of fonts matching PATTERN. */
2535 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2538 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2541 if (nfonts
< 0 && CONSP (lfonts
))
2542 num_fonts
= XFASTINT (Flength (lfonts
));
2544 /* Make a copy of the font names we got from X, and
2545 split them into fields. */
2547 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2549 Lisp_Object elt
, tail
;
2550 const char *name
= SDATA (XCAR (tem
));
2552 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2553 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2557 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2568 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2572 /* Make a copy of the font name. */
2573 fonts
[n
].name
= xstrdup (name
);
2575 if (split_font_name (f
, fonts
+ n
, 1))
2577 if (font_scalable_p (fonts
+ n
)
2578 && !may_use_scalable_font_p (name
))
2581 xfree (fonts
[n
].name
);
2587 xfree (fonts
[n
].name
);
2590 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2591 if (n
== 0 && try_alternatives_p
)
2593 Lisp_Object list
= Valternate_fontname_alist
;
2601 while (CONSP (list
))
2603 Lisp_Object entry
= XCAR (list
);
2605 && STRINGP (XCAR (entry
))
2606 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2613 Lisp_Object patterns
= XCAR (list
);
2616 while (CONSP (patterns
)
2617 /* If list is screwed up, give up. */
2618 && (name
= XCAR (patterns
),
2620 /* Ignore patterns equal to PATTERN because we tried that
2621 already with no success. */
2622 && (strcmp (SDATA (name
), pattern
) == 0
2623 || (n
= x_face_list_fonts (f
, SDATA (name
),
2626 patterns
= XCDR (patterns
);
2634 /* Check if a font matching pattern_offset_t on frame F is available
2635 or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
2636 a font name pattern is generated from FAMILY and REGISTRY. */
2639 face_font_available_p (f
, pattern
)
2641 Lisp_Object pattern
;
2645 if (! STRINGP (pattern
))
2647 Lisp_Object family
, registry
;
2648 char *family_str
, *registry_str
, *pattern_str
;
2650 CHECK_CONS (pattern
);
2651 family
= XCAR (pattern
);
2656 CHECK_STRING (family
);
2657 family_str
= (char *) SDATA (family
);
2659 registry
= XCDR (pattern
);
2660 if (NILP (registry
))
2664 CHECK_STRING (registry
);
2665 registry_str
= (char *) SDATA (registry
);
2668 pattern_str
= (char *) alloca (strlen (family_str
)
2669 + strlen (registry_str
)
2671 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2672 strcat (pattern_str
, family_str
);
2673 strcat (pattern_str
, "-*-");
2674 strcat (pattern_str
, registry_str
);
2675 if (!index (registry_str
, '-'))
2677 if (registry_str
[strlen (registry_str
) - 1] == '*')
2678 strcat (pattern_str
, "-*");
2680 strcat (pattern_str
, "*-*");
2682 pattern
= build_string (pattern_str
);
2685 /* Get the list of fonts matching PATTERN. */
2688 fonts
= w32_list_fonts (f
, pattern
, 0, 1);
2691 fonts
= x_list_fonts (f
, pattern
, -1, 1);
2693 return XINT (Flength (fonts
));
2697 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2698 using comparison function CMPFN. Value is the number of fonts
2699 found. If value is non-zero, *FONTS is set to a vector of
2700 font_name structures allocated from the heap containing matching
2701 fonts. Each element of *FONTS contains a name member that is also
2702 allocated from the heap. Font names in these structures are split
2703 into fields. Use free_font_names to free such an array. */
2706 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2709 int (*cmpfn
) P_ ((const void *, const void *));
2710 struct font_name
**fonts
;
2714 /* Get the list of fonts matching pattern. 100 should suffice. */
2715 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2716 if (INTEGERP (Vfont_list_limit
))
2717 nfonts
= XINT (Vfont_list_limit
);
2720 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2722 /* Sort the resulting array and return it in *FONTS. If no
2723 fonts were found, make sure to set *FONTS to null. */
2725 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2736 /* Compare two font_name structures *A and *B. Value is analogous to
2737 strcmp. Sort order is given by the global variable
2738 font_sort_order. Font names are sorted so that, everything else
2739 being equal, fonts with a resolution closer to that of the frame on
2740 which they are used are listed first. The global variable
2741 font_frame is the frame on which we operate. */
2744 cmp_font_names (a
, b
)
2747 struct font_name
*x
= (struct font_name
*) a
;
2748 struct font_name
*y
= (struct font_name
*) b
;
2751 /* All strings have been converted to lower-case by split_font_name,
2752 so we can use strcmp here. */
2753 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2758 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2760 int j
= font_sort_order
[i
];
2761 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2766 /* Everything else being equal, we prefer fonts with an
2767 y-resolution closer to that of the frame. */
2768 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2769 int x_resy
= x
->numeric
[XLFD_RESY
];
2770 int y_resy
= y
->numeric
[XLFD_RESY
];
2771 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2779 /* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
2780 is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
2781 family name string or nil. REGISTRY is a registry name string.
2782 Set *FONTS to a vector of font_name structures allocated from the
2783 heap containing the fonts found. Value is the number of fonts
2787 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2789 Lisp_Object pattern
, family
, registry
;
2790 struct font_name
**fonts
;
2792 char *pattern_str
, *family_str
, *registry_str
;
2796 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2797 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2799 pattern_str
= (char *) alloca (strlen (family_str
)
2800 + strlen (registry_str
)
2802 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2803 strcat (pattern_str
, family_str
);
2804 strcat (pattern_str
, "-*-");
2805 strcat (pattern_str
, registry_str
);
2806 if (!index (registry_str
, '-'))
2808 if (registry_str
[strlen (registry_str
) - 1] == '*')
2809 strcat (pattern_str
, "-*");
2811 strcat (pattern_str
, "*-*");
2815 pattern_str
= (char *) SDATA (pattern
);
2817 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2821 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2822 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2823 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2826 static struct font_name
*
2827 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2828 struct font_name
*fonts1
, *fonts2
;
2829 int nfonts1
, nfonts2
;
2831 int new_nfonts
= nfonts1
+ nfonts2
;
2832 struct font_name
*new_fonts
;
2834 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2835 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2836 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2843 /* Get a sorted list of fonts of family FAMILY on frame F.
2845 If PATTERN is non-nil, list fonts matching that pattern.
2847 If REGISTRY is non-nil, it is a list of registry (and encoding)
2848 names. Return fonts with those registries and the alternative
2849 registries from Vface_alternative_font_registry_alist.
2851 If REGISTRY is nil return fonts of any registry.
2853 Set *FONTS to a vector of font_name structures allocated from the
2854 heap containing the fonts found. Value is the number of fonts
2858 font_list (f
, pattern
, family
, registry
, fonts
)
2860 Lisp_Object pattern
, family
, registry
;
2861 struct font_name
**fonts
;
2867 if (NILP (registry
))
2868 return font_list_1 (f
, pattern
, family
, registry
, fonts
);
2870 for (reg_prio
= 0, nfonts
= 0; CONSP (registry
); registry
= XCDR (registry
))
2872 Lisp_Object elt
, alter
;
2874 struct font_name
*fonts2
;
2876 elt
= XCAR (registry
);
2877 alter
= Fassoc (elt
, Vface_alternative_font_registry_alist
);
2879 alter
= Fcons (elt
, Qnil
);
2880 for (; CONSP (alter
); alter
= XCDR (alter
), reg_prio
++)
2882 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
), &fonts2
);
2886 for (i
= 0; i
< nfonts2
; i
++)
2887 fonts2
[i
].registry_priority
= reg_prio
;
2889 *fonts
= concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
);
2901 /* Remove elements from LIST whose cars are `equal'. Called from
2902 x-family-fonts and x-font-family-list to remove duplicate font
2906 remove_duplicates (list
)
2909 Lisp_Object tail
= list
;
2911 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2913 Lisp_Object next
= XCDR (tail
);
2914 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2915 XSETCDR (tail
, XCDR (next
));
2922 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2923 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2924 If FAMILY is omitted or nil, list all families.
2925 Otherwise, FAMILY must be a string, possibly containing wildcards
2927 If FRAME is omitted or nil, use the selected frame.
2928 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2929 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2930 FAMILY is the font family name. POINT-SIZE is the size of the
2931 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2932 width, weight and slant of the font. These symbols are the same as for
2933 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2934 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2935 giving the registry and encoding of the font.
2936 The result list is sorted according to the current setting of
2937 the face font sort order. */)
2939 Lisp_Object family
, frame
;
2941 struct frame
*f
= check_x_frame (frame
);
2942 struct font_name
*fonts
;
2945 struct gcpro gcpro1
;
2948 CHECK_STRING (family
);
2952 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2953 for (i
= nfonts
- 1; i
>= 0; --i
)
2955 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2958 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2959 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2960 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2961 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2962 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2963 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2964 tem
= build_font_name (fonts
+ i
);
2965 ASET (v
, 6, build_string (tem
));
2966 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2967 fonts
[i
].fields
[XLFD_ENCODING
]);
2968 ASET (v
, 7, build_string (tem
));
2971 result
= Fcons (v
, result
);
2974 remove_duplicates (result
);
2975 free_font_names (fonts
, nfonts
);
2981 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2983 doc
: /* Return a list of available font families on FRAME.
2984 If FRAME is omitted or nil, use the selected frame.
2985 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2986 is a font family, and FIXED-P is non-nil if fonts of that family
2987 are fixed-pitch. */)
2991 struct frame
*f
= check_x_frame (frame
);
2993 struct font_name
*fonts
;
2995 struct gcpro gcpro1
;
2996 int count
= SPECPDL_INDEX ();
2998 /* Let's consider all fonts. */
2999 specbind (intern ("font-list-limit"), make_number (-1));
3000 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
3004 for (i
= nfonts
- 1; i
>= 0; --i
)
3005 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
3006 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
3009 remove_duplicates (result
);
3010 free_font_names (fonts
, nfonts
);
3012 return unbind_to (count
, result
);
3016 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
3017 doc
: /* Return a list of the names of available fonts matching PATTERN.
3018 If optional arguments FACE and FRAME are specified, return only fonts
3019 the same size as FACE on FRAME.
3020 PATTERN is a string, perhaps with wildcard characters;
3021 the * character matches any substring, and
3022 the ? character matches any single character.
3023 PATTERN is case-insensitive.
3024 FACE is a face name--a symbol.
3026 The return value is a list of strings, suitable as arguments to
3029 Fonts Emacs can't use may or may not be excluded
3030 even if they match PATTERN and FACE.
3031 The optional fourth argument MAXIMUM sets a limit on how many
3032 fonts to match. The first MAXIMUM fonts are reported.
3033 The optional fifth argument WIDTH, if specified, is a number of columns
3034 occupied by a character of a font. In that case, return only fonts
3035 the WIDTH times as wide as FACE on FRAME. */)
3036 (pattern
, face
, frame
, maximum
, width
)
3037 Lisp_Object pattern
, face
, frame
, maximum
, width
;
3044 CHECK_STRING (pattern
);
3050 CHECK_NATNUM (maximum
);
3051 maxnames
= XINT (maximum
);
3055 CHECK_NUMBER (width
);
3057 /* We can't simply call check_x_frame because this function may be
3058 called before any frame is created. */
3059 f
= frame_or_selected_frame (frame
, 2);
3060 if (!FRAME_WINDOW_P (f
))
3062 /* Perhaps we have not yet created any frame. */
3067 /* Determine the width standard for comparison with the fonts we find. */
3073 /* This is of limited utility since it works with character
3074 widths. Keep it for compatibility. --gerd. */
3075 int face_id
= lookup_named_face (f
, face
, 0);
3076 struct face
*face
= (face_id
< 0
3078 : FACE_FROM_ID (f
, face_id
));
3081 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3082 not maximum as on X. Redefine here. */
3084 #define FONT_WIDTH FONT_MAX_WIDTH
3087 if (face
&& face
->font
)
3088 size
= FONT_WIDTH (face
->font
);
3090 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3093 size
*= XINT (width
);
3097 Lisp_Object args
[2];
3099 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3101 /* We don't have to check fontsets. */
3103 args
[1] = list_fontsets (f
, pattern
, size
);
3104 return Fnconc (2, args
);
3108 #endif /* HAVE_WINDOW_SYSTEM */
3112 /***********************************************************************
3114 ***********************************************************************/
3116 /* Access face attributes of face LFACE, a Lisp vector. */
3118 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3119 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3120 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3121 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3122 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3123 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3124 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3125 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3126 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3127 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3128 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3129 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3130 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3131 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3132 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3133 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3134 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3136 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3137 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3139 #define LFACEP(LFACE) \
3141 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3142 && EQ (AREF (LFACE, 0), Qface))
3147 /* Check consistency of Lisp face attribute vector ATTRS. */
3150 check_lface_attrs (attrs
)
3153 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3154 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3155 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3156 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3157 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3158 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3159 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3160 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3161 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3162 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3163 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3164 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3165 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3166 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3167 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3168 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3169 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3170 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3171 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3172 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3173 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3174 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3175 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3176 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3177 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3178 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3179 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3180 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3181 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3182 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3183 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3184 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3185 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3186 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3187 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3188 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3189 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3190 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3191 #ifdef HAVE_WINDOW_SYSTEM
3192 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3193 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3194 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3195 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3196 || NILP (attrs
[LFACE_FONT_INDEX
])
3197 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3198 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3199 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3204 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3212 xassert (LFACEP (lface
));
3213 check_lface_attrs (XVECTOR (lface
)->contents
);
3217 #else /* GLYPH_DEBUG == 0 */
3219 #define check_lface_attrs(attrs) (void) 0
3220 #define check_lface(lface) (void) 0
3222 #endif /* GLYPH_DEBUG == 0 */
3226 /* Face-merge cycle checking. */
3228 /* A `named merge point' is simply a point during face-merging where we
3229 look up a face by name. We keep a stack of which named lookups we're
3230 currently processing so that we can easily detect cycles, using a
3231 linked- list of struct named_merge_point structures, typically
3232 allocated on the stack frame of the named lookup functions which are
3233 active (so no consing is required). */
3234 struct named_merge_point
3236 Lisp_Object face_name
;
3237 struct named_merge_point
*prev
;
3241 /* If a face merging cycle is detected for FACE_NAME, return 0,
3242 otherwise add NEW_NAMED_MERGE_POINT, which is initialized using
3243 FACE_NAME, as the head of the linked list pointed to by
3244 NAMED_MERGE_POINTS, and return 1. */
3247 push_named_merge_point (struct named_merge_point
*new_named_merge_point
,
3248 Lisp_Object face_name
,
3249 struct named_merge_point
**named_merge_points
)
3251 struct named_merge_point
*prev
;
3253 for (prev
= *named_merge_points
; prev
; prev
= prev
->prev
)
3254 if (EQ (face_name
, prev
->face_name
))
3257 new_named_merge_point
->face_name
= face_name
;
3258 new_named_merge_point
->prev
= *named_merge_points
;
3260 *named_merge_points
= new_named_merge_point
;
3268 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3269 to make it a symvol. If FACE_NAME is an alias for another face,
3270 return that face's name. */
3273 resolve_face_name (face_name
)
3274 Lisp_Object face_name
;
3276 Lisp_Object aliased
;
3278 if (STRINGP (face_name
))
3279 face_name
= intern (SDATA (face_name
));
3281 while (SYMBOLP (face_name
))
3283 aliased
= Fget (face_name
, Qface_alias
);
3287 face_name
= aliased
;
3294 /* Return the face definition of FACE_NAME on frame F. F null means
3295 return the definition for new frames. FACE_NAME may be a string or
3296 a symbol (apparently Emacs 20.2 allowed strings as face names in
3297 face text properties; Ediff uses that). If FACE_NAME is an alias
3298 for another face, return that face's definition. If SIGNAL_P is
3299 non-zero, signal an error if FACE_NAME is not a valid face name.
3300 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3303 static INLINE Lisp_Object
3304 lface_from_face_name (f
, face_name
, signal_p
)
3306 Lisp_Object face_name
;
3311 face_name
= resolve_face_name (face_name
);
3314 lface
= assq_no_quit (face_name
, f
->face_alist
);
3316 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3319 lface
= XCDR (lface
);
3321 signal_error ("Invalid face", face_name
);
3323 check_lface (lface
);
3328 /* Get face attributes of face FACE_NAME from frame-local faces on
3329 frame F. Store the resulting attributes in ATTRS which must point
3330 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3331 is non-zero, signal an error if FACE_NAME does not name a face.
3332 Otherwise, value is zero if FACE_NAME is not a face. */
3335 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3337 Lisp_Object face_name
;
3344 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3347 bcopy (XVECTOR (lface
)->contents
, attrs
,
3348 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3358 /* Non-zero if all attributes in face attribute vector ATTRS are
3359 specified, i.e. are non-nil. */
3362 lface_fully_specified_p (attrs
)
3367 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3368 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3369 && i
!= LFACE_AVGWIDTH_INDEX
&& i
!= LFACE_FONTSET_INDEX
)
3370 if (UNSPECIFIEDP (attrs
[i
])
3372 /* MAC_TODO: No stipple support on Mac OS yet, this index is
3373 always unspecified. */
3374 && i
!= LFACE_STIPPLE_INDEX
3379 return i
== LFACE_VECTOR_SIZE
;
3382 #ifdef HAVE_WINDOW_SYSTEM
3384 /* Set font-related attributes of Lisp face LFACE from the fullname of
3385 the font opened by FONTNAME. If FORCE_P is zero, set only
3386 unspecified attributes of LFACE. The exception is `font'
3387 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3389 If FONTNAME is not available on frame F,
3390 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3391 If the fullname is not in a valid XLFD format,
3392 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3393 in LFACE and return 1.
3394 Otherwise, return 1. */
3397 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3400 Lisp_Object fontname
;
3401 int force_p
, may_fail_p
;
3403 struct font_name font
;
3408 char *font_name
= SDATA (fontname
);
3409 struct font_info
*font_info
;
3411 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3412 fontset
= fs_query_fontset (fontname
, 0);
3414 font_name
= SDATA (fontset_ascii (fontset
));
3415 else if (fontset
== 0)
3422 /* Check if FONT_NAME is surely available on the system. Usually
3423 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3424 returns quickly. But, even if FONT_NAME is not yet cached,
3425 caching it now is not futail because we anyway load the font
3428 font_info
= FS_LOAD_FONT (f
, font_name
);
3438 font
.name
= STRDUPA (font_info
->full_name
);
3439 have_xlfd_p
= split_font_name (f
, &font
, 1);
3441 /* Set attributes only if unspecified, otherwise face defaults for
3442 new frames would never take effect. If we couldn't get a font
3443 name conforming to XLFD, set normal values. */
3445 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3450 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3451 + strlen (font
.fields
[XLFD_FOUNDRY
])
3453 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3454 font
.fields
[XLFD_FAMILY
]);
3455 val
= build_string (buffer
);
3458 val
= build_string ("*");
3459 LFACE_FAMILY (lface
) = val
;
3462 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3465 pt
= xlfd_point_size (f
, &font
);
3467 pt
= pixel_point_size (f
, font_info
->height
* 10);
3469 LFACE_HEIGHT (lface
) = make_number (pt
);
3472 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3473 LFACE_SWIDTH (lface
)
3474 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3476 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3477 LFACE_AVGWIDTH (lface
)
3479 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3482 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3483 LFACE_WEIGHT (lface
)
3484 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3486 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3488 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3492 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3493 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3497 LFACE_FONT (lface
) = fontname
;
3499 = new_fontset_from_font_name (build_string (font_info
->full_name
));
3500 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3505 #endif /* HAVE_WINDOW_SYSTEM */
3508 /* Merges the face height FROM with the face height TO, and returns the
3509 merged height. If FROM is an invalid height, then INVALID is
3510 returned instead. FROM and TO may be either absolute face heights or
3511 `relative' heights; the returned value is always an absolute height
3512 unless both FROM and TO are relative. GCPRO is a lisp value that
3513 will be protected from garbage-collection if this function makes a
3517 merge_face_heights (from
, to
, invalid
)
3518 Lisp_Object from
, to
, invalid
;
3520 Lisp_Object result
= invalid
;
3522 if (INTEGERP (from
))
3523 /* FROM is absolute, just use it as is. */
3525 else if (FLOATP (from
))
3526 /* FROM is a scale, use it to adjust TO. */
3529 /* relative X absolute => absolute */
3530 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3531 else if (FLOATP (to
))
3532 /* relative X relative => relative */
3533 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3534 else if (UNSPECIFIEDP (to
))
3537 else if (FUNCTIONP (from
))
3538 /* FROM is a function, which use to adjust TO. */
3540 /* Call function with current height as argument.
3541 From is the new height. */
3542 Lisp_Object args
[2];
3546 result
= safe_call (2, args
);
3548 /* Ensure that if TO was absolute, so is the result. */
3549 if (INTEGERP (to
) && !INTEGERP (result
))
3557 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3558 store the resulting attributes in TO, which must be already be
3559 completely specified and contain only absolute attributes. Every
3560 specified attribute of FROM overrides the corresponding attribute of
3561 TO; relative attributes in FROM are merged with the absolute value in
3562 TO and replace it. NAMED_MERGE_POINTS is used internally to detect
3563 loops in face inheritance; it should be 0 when called from other
3567 merge_face_vectors (f
, from
, to
, named_merge_points
)
3569 Lisp_Object
*from
, *to
;
3570 struct named_merge_point
*named_merge_points
;
3574 /* If FROM inherits from some other faces, merge their attributes into
3575 TO before merging FROM's direct attributes. Note that an :inherit
3576 attribute of `unspecified' is the same as one of nil; we never
3577 merge :inherit attributes, so nil is more correct, but lots of
3578 other code uses `unspecified' as a generic value for face attributes. */
3579 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3580 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3581 merge_face_ref (f
, from
[LFACE_INHERIT_INDEX
], to
, 0, named_merge_points
);
3583 /* If TO specifies a :font attribute, and FROM specifies some
3584 font-related attribute, we need to clear TO's :font attribute
3585 (because it will be inconsistent with whatever FROM specifies, and
3586 FROM takes precedence). */
3587 if (!NILP (to
[LFACE_FONT_INDEX
])
3588 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3589 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3590 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3591 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3592 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3593 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3594 to
[LFACE_FONT_INDEX
] = Qnil
;
3596 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3597 if (!UNSPECIFIEDP (from
[i
]))
3599 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3600 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
]);
3605 /* TO is always an absolute face, which should inherit from nothing.
3606 We blindly copy the :inherit attribute above and fix it up here. */
3607 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3610 /* Merge the named face FACE_NAME on frame F, into the vector of face
3611 attributes TO. NAMED_MERGE_POINTS is used to detect loops in face
3612 inheritance. Returns true if FACE_NAME is a valid face name and
3613 merging succeeded. */
3616 merge_named_face (f
, face_name
, to
, named_merge_points
)
3618 Lisp_Object face_name
;
3620 struct named_merge_point
*named_merge_points
;
3622 struct named_merge_point named_merge_point
;
3624 if (push_named_merge_point (&named_merge_point
,
3625 face_name
, &named_merge_points
))
3627 struct gcpro gcpro1
;
3628 Lisp_Object from
[LFACE_VECTOR_SIZE
];
3629 int ok
= get_lface_attributes (f
, face_name
, from
, 0);
3633 GCPRO1 (named_merge_point
.face_name
);
3634 merge_face_vectors (f
, from
, to
, named_merge_points
);
3645 /* Merge face attributes from the lisp `face reference' FACE_REF on
3646 frame F into the face attribute vector TO. If ERR_MSGS is non-zero,
3647 problems with FACE_REF cause an error message to be shown. Return
3648 non-zero if no errors occurred (regardless of the value of ERR_MSGS).
3649 NAMED_MERGE_POINTS is used to detect loops in face inheritance or
3650 list structure; it may be 0 for most callers.
3652 FACE_REF may be a single face specification or a list of such
3653 specifications. Each face specification can be:
3655 1. A symbol or string naming a Lisp face.
3657 2. A property list of the form (KEYWORD VALUE ...) where each
3658 KEYWORD is a face attribute name, and value is an appropriate value
3661 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3662 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3663 for compatibility with 20.2.
3665 Face specifications earlier in lists take precedence over later
3669 merge_face_ref (f
, face_ref
, to
, err_msgs
, named_merge_points
)
3671 Lisp_Object face_ref
;
3674 struct named_merge_point
*named_merge_points
;
3676 int ok
= 1; /* Succeed without an error? */
3678 if (CONSP (face_ref
))
3680 Lisp_Object first
= XCAR (face_ref
);
3682 if (EQ (first
, Qforeground_color
)
3683 || EQ (first
, Qbackground_color
))
3685 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3686 . COLOR). COLOR must be a string. */
3687 Lisp_Object color_name
= XCDR (face_ref
);
3688 Lisp_Object color
= first
;
3690 if (STRINGP (color_name
))
3692 if (EQ (color
, Qforeground_color
))
3693 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3695 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3700 add_to_log ("Invalid face color", color_name
, Qnil
);
3704 else if (SYMBOLP (first
)
3705 && *SDATA (SYMBOL_NAME (first
)) == ':')
3707 /* Assume this is the property list form. */
3708 while (CONSP (face_ref
) && CONSP (XCDR (face_ref
)))
3710 Lisp_Object keyword
= XCAR (face_ref
);
3711 Lisp_Object value
= XCAR (XCDR (face_ref
));
3714 /* Specifying `unspecified' is a no-op. */
3715 if (EQ (value
, Qunspecified
))
3717 else if (EQ (keyword
, QCfamily
))
3719 if (STRINGP (value
))
3720 to
[LFACE_FAMILY_INDEX
] = value
;
3724 else if (EQ (keyword
, QCheight
))
3726 Lisp_Object new_height
=
3727 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
], Qnil
);
3729 if (! NILP (new_height
))
3730 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3734 else if (EQ (keyword
, QCweight
))
3737 && face_numeric_weight (value
) >= 0)
3738 to
[LFACE_WEIGHT_INDEX
] = value
;
3742 else if (EQ (keyword
, QCslant
))
3745 && face_numeric_slant (value
) >= 0)
3746 to
[LFACE_SLANT_INDEX
] = value
;
3750 else if (EQ (keyword
, QCunderline
))
3755 to
[LFACE_UNDERLINE_INDEX
] = value
;
3759 else if (EQ (keyword
, QCoverline
))
3764 to
[LFACE_OVERLINE_INDEX
] = value
;
3768 else if (EQ (keyword
, QCstrike_through
))
3773 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3777 else if (EQ (keyword
, QCbox
))
3780 value
= make_number (1);
3781 if (INTEGERP (value
)
3785 to
[LFACE_BOX_INDEX
] = value
;
3789 else if (EQ (keyword
, QCinverse_video
)
3790 || EQ (keyword
, QCreverse_video
))
3792 if (EQ (value
, Qt
) || NILP (value
))
3793 to
[LFACE_INVERSE_INDEX
] = value
;
3797 else if (EQ (keyword
, QCforeground
))
3799 if (STRINGP (value
))
3800 to
[LFACE_FOREGROUND_INDEX
] = value
;
3804 else if (EQ (keyword
, QCbackground
))
3806 if (STRINGP (value
))
3807 to
[LFACE_BACKGROUND_INDEX
] = value
;
3811 else if (EQ (keyword
, QCstipple
))
3813 #ifdef HAVE_X_WINDOWS
3814 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3815 if (!NILP (pixmap_p
))
3816 to
[LFACE_STIPPLE_INDEX
] = value
;
3821 else if (EQ (keyword
, QCwidth
))
3824 && face_numeric_swidth (value
) >= 0)
3825 to
[LFACE_SWIDTH_INDEX
] = value
;
3829 else if (EQ (keyword
, QCinherit
))
3831 /* This is not really very useful; it's just like a
3832 normal face reference. */
3833 if (! merge_face_ref (f
, value
, to
,
3834 err_msgs
, named_merge_points
))
3842 add_to_log ("Invalid face attribute %S %S", keyword
, value
);
3846 face_ref
= XCDR (XCDR (face_ref
));
3851 /* This is a list of face refs. Those at the beginning of the
3852 list take precedence over what follows, so we have to merge
3853 from the end backwards. */
3854 Lisp_Object next
= XCDR (face_ref
);
3857 ok
= merge_face_ref (f
, next
, to
, err_msgs
, named_merge_points
);
3859 if (! merge_face_ref (f
, first
, to
, err_msgs
, named_merge_points
))
3865 /* FACE_REF ought to be a face name. */
3866 ok
= merge_named_face (f
, face_ref
, to
, named_merge_points
);
3867 if (!ok
&& err_msgs
)
3868 add_to_log ("Invalid face reference: %s", face_ref
, Qnil
);
3875 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3876 Sinternal_make_lisp_face
, 1, 2, 0,
3877 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3878 If FACE was not known as a face before, create a new one.
3879 If optional argument FRAME is specified, make a frame-local face
3880 for that frame. Otherwise operate on the global face definition.
3881 Value is a vector of face attributes. */)
3883 Lisp_Object face
, frame
;
3885 Lisp_Object global_lface
, lface
;
3889 CHECK_SYMBOL (face
);
3890 global_lface
= lface_from_face_name (NULL
, face
, 0);
3894 CHECK_LIVE_FRAME (frame
);
3896 lface
= lface_from_face_name (f
, face
, 0);
3899 f
= NULL
, lface
= Qnil
;
3901 /* Add a global definition if there is none. */
3902 if (NILP (global_lface
))
3904 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3906 AREF (global_lface
, 0) = Qface
;
3907 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3908 Vface_new_frame_defaults
);
3910 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3911 face id to Lisp face is given by the vector lface_id_to_name.
3912 The mapping from Lisp face to Lisp face id is given by the
3913 property `face' of the Lisp face name. */
3914 if (next_lface_id
== lface_id_to_name_size
)
3916 int new_size
= max (50, 2 * lface_id_to_name_size
);
3917 int sz
= new_size
* sizeof *lface_id_to_name
;
3918 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3919 lface_id_to_name_size
= new_size
;
3922 lface_id_to_name
[next_lface_id
] = face
;
3923 Fput (face
, Qface
, make_number (next_lface_id
));
3927 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3928 AREF (global_lface
, i
) = Qunspecified
;
3930 /* Add a frame-local definition. */
3935 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3937 AREF (lface
, 0) = Qface
;
3938 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3941 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3942 AREF (lface
, i
) = Qunspecified
;
3945 lface
= global_lface
;
3947 /* Changing a named face means that all realized faces depending on
3948 that face are invalid. Since we cannot tell which realized faces
3949 depend on the face, make sure they are all removed. This is done
3950 by incrementing face_change_count. The next call to
3951 init_iterator will then free realized faces. */
3952 if (NILP (Fget (face
, Qface_no_inherit
)))
3954 ++face_change_count
;
3955 ++windows_or_buffers_changed
;
3958 xassert (LFACEP (lface
));
3959 check_lface (lface
);
3964 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3965 Sinternal_lisp_face_p
, 1, 2, 0,
3966 doc
: /* Return non-nil if FACE names a face.
3967 If optional second parameter FRAME is non-nil, check for the
3968 existence of a frame-local face with name FACE on that frame.
3969 Otherwise check for the existence of a global face. */)
3971 Lisp_Object face
, frame
;
3977 CHECK_LIVE_FRAME (frame
);
3978 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3981 lface
= lface_from_face_name (NULL
, face
, 0);
3987 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3988 Sinternal_copy_lisp_face
, 4, 4, 0,
3989 doc
: /* Copy face FROM to TO.
3990 If FRAME is t, copy the global face definition of FROM.
3991 Otherwise, copy the frame-local definition of FROM on FRAME.
3992 If NEW-FRAME is a frame, copy that data into the frame-local
3993 definition of TO on NEW-FRAME. If NEW-FRAME is nil.
3994 FRAME controls where the data is copied to.
3996 The value is TO. */)
3997 (from
, to
, frame
, new_frame
)
3998 Lisp_Object from
, to
, frame
, new_frame
;
4000 Lisp_Object lface
, copy
;
4002 CHECK_SYMBOL (from
);
4007 /* Copy global definition of FROM. We don't make copies of
4008 strings etc. because 20.2 didn't do it either. */
4009 lface
= lface_from_face_name (NULL
, from
, 1);
4010 copy
= Finternal_make_lisp_face (to
, Qnil
);
4014 /* Copy frame-local definition of FROM. */
4015 if (NILP (new_frame
))
4017 CHECK_LIVE_FRAME (frame
);
4018 CHECK_LIVE_FRAME (new_frame
);
4019 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
4020 copy
= Finternal_make_lisp_face (to
, new_frame
);
4023 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
4024 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
4026 /* Changing a named face means that all realized faces depending on
4027 that face are invalid. Since we cannot tell which realized faces
4028 depend on the face, make sure they are all removed. This is done
4029 by incrementing face_change_count. The next call to
4030 init_iterator will then free realized faces. */
4031 if (NILP (Fget (to
, Qface_no_inherit
)))
4033 ++face_change_count
;
4034 ++windows_or_buffers_changed
;
4041 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
4042 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
4043 doc
: /* Set attribute ATTR of FACE to VALUE.
4044 FRAME being a frame means change the face on that frame.
4045 FRAME nil means change the face of the selected frame.
4046 FRAME t means change the default for new frames.
4047 FRAME 0 means change the face on all frames, and change the default
4049 (face
, attr
, value
, frame
)
4050 Lisp_Object face
, attr
, value
, frame
;
4053 Lisp_Object old_value
= Qnil
;
4054 /* Set 1 if ATTR is QCfont. */
4055 int font_attr_p
= 0;
4056 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
4057 int font_related_attr_p
= 0;
4059 CHECK_SYMBOL (face
);
4060 CHECK_SYMBOL (attr
);
4062 face
= resolve_face_name (face
);
4064 /* If FRAME is 0, change face on all frames, and change the
4065 default for new frames. */
4066 if (INTEGERP (frame
) && XINT (frame
) == 0)
4069 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
4070 FOR_EACH_FRAME (tail
, frame
)
4071 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4075 /* Set lface to the Lisp attribute vector of FACE. */
4077 lface
= lface_from_face_name (NULL
, face
, 1);
4081 frame
= selected_frame
;
4083 CHECK_LIVE_FRAME (frame
);
4084 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4086 /* If a frame-local face doesn't exist yet, create one. */
4088 lface
= Finternal_make_lisp_face (face
, frame
);
4091 if (EQ (attr
, QCfamily
))
4093 if (!UNSPECIFIEDP (value
))
4095 CHECK_STRING (value
);
4096 if (SCHARS (value
) == 0)
4097 signal_error ("Invalid face family", value
);
4099 old_value
= LFACE_FAMILY (lface
);
4100 LFACE_FAMILY (lface
) = value
;
4101 font_related_attr_p
= 1;
4103 else if (EQ (attr
, QCheight
))
4105 if (!UNSPECIFIEDP (value
))
4109 test
= (EQ (face
, Qdefault
)
4111 /* The default face must have an absolute size,
4112 otherwise, we do a test merge with a random
4113 height to see if VALUE's ok. */
4114 : merge_face_heights (value
, make_number (10), Qnil
));
4116 if (!INTEGERP (test
) || XINT (test
) <= 0)
4117 signal_error ("Invalid face height", value
);
4120 old_value
= LFACE_HEIGHT (lface
);
4121 LFACE_HEIGHT (lface
) = value
;
4122 font_related_attr_p
= 1;
4124 else if (EQ (attr
, QCweight
))
4126 if (!UNSPECIFIEDP (value
))
4128 CHECK_SYMBOL (value
);
4129 if (face_numeric_weight (value
) < 0)
4130 signal_error ("Invalid face weight", value
);
4132 old_value
= LFACE_WEIGHT (lface
);
4133 LFACE_WEIGHT (lface
) = value
;
4134 font_related_attr_p
= 1;
4136 else if (EQ (attr
, QCslant
))
4138 if (!UNSPECIFIEDP (value
))
4140 CHECK_SYMBOL (value
);
4141 if (face_numeric_slant (value
) < 0)
4142 signal_error ("Invalid face slant", value
);
4144 old_value
= LFACE_SLANT (lface
);
4145 LFACE_SLANT (lface
) = value
;
4146 font_related_attr_p
= 1;
4148 else if (EQ (attr
, QCunderline
))
4150 if (!UNSPECIFIEDP (value
))
4151 if ((SYMBOLP (value
)
4153 && !EQ (value
, Qnil
))
4154 /* Underline color. */
4156 && SCHARS (value
) == 0))
4157 signal_error ("Invalid face underline", value
);
4159 old_value
= LFACE_UNDERLINE (lface
);
4160 LFACE_UNDERLINE (lface
) = value
;
4162 else if (EQ (attr
, QCoverline
))
4164 if (!UNSPECIFIEDP (value
))
4165 if ((SYMBOLP (value
)
4167 && !EQ (value
, Qnil
))
4168 /* Overline color. */
4170 && SCHARS (value
) == 0))
4171 signal_error ("Invalid face overline", value
);
4173 old_value
= LFACE_OVERLINE (lface
);
4174 LFACE_OVERLINE (lface
) = value
;
4176 else if (EQ (attr
, QCstrike_through
))
4178 if (!UNSPECIFIEDP (value
))
4179 if ((SYMBOLP (value
)
4181 && !EQ (value
, Qnil
))
4182 /* Strike-through color. */
4184 && SCHARS (value
) == 0))
4185 signal_error ("Invalid face strike-through", value
);
4187 old_value
= LFACE_STRIKE_THROUGH (lface
);
4188 LFACE_STRIKE_THROUGH (lface
) = value
;
4190 else if (EQ (attr
, QCbox
))
4194 /* Allow t meaning a simple box of width 1 in foreground color
4197 value
= make_number (1);
4199 if (UNSPECIFIEDP (value
))
4201 else if (NILP (value
))
4203 else if (INTEGERP (value
))
4204 valid_p
= XINT (value
) != 0;
4205 else if (STRINGP (value
))
4206 valid_p
= SCHARS (value
) > 0;
4207 else if (CONSP (value
))
4223 if (EQ (k
, QCline_width
))
4225 if (!INTEGERP (v
) || XINT (v
) == 0)
4228 else if (EQ (k
, QCcolor
))
4230 if (!NILP (v
) && (!STRINGP (v
) || SCHARS (v
) == 0))
4233 else if (EQ (k
, QCstyle
))
4235 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4242 valid_p
= NILP (tem
);
4248 signal_error ("Invalid face box", value
);
4250 old_value
= LFACE_BOX (lface
);
4251 LFACE_BOX (lface
) = value
;
4253 else if (EQ (attr
, QCinverse_video
)
4254 || EQ (attr
, QCreverse_video
))
4256 if (!UNSPECIFIEDP (value
))
4258 CHECK_SYMBOL (value
);
4259 if (!EQ (value
, Qt
) && !NILP (value
))
4260 signal_error ("Invalid inverse-video face attribute value", value
);
4262 old_value
= LFACE_INVERSE (lface
);
4263 LFACE_INVERSE (lface
) = value
;
4265 else if (EQ (attr
, QCforeground
))
4267 if (!UNSPECIFIEDP (value
))
4269 /* Don't check for valid color names here because it depends
4270 on the frame (display) whether the color will be valid
4271 when the face is realized. */
4272 CHECK_STRING (value
);
4273 if (SCHARS (value
) == 0)
4274 signal_error ("Empty foreground color value", value
);
4276 old_value
= LFACE_FOREGROUND (lface
);
4277 LFACE_FOREGROUND (lface
) = value
;
4279 else if (EQ (attr
, QCbackground
))
4281 if (!UNSPECIFIEDP (value
))
4283 /* Don't check for valid color names here because it depends
4284 on the frame (display) whether the color will be valid
4285 when the face is realized. */
4286 CHECK_STRING (value
);
4287 if (SCHARS (value
) == 0)
4288 signal_error ("Empty background color value", value
);
4290 old_value
= LFACE_BACKGROUND (lface
);
4291 LFACE_BACKGROUND (lface
) = value
;
4293 else if (EQ (attr
, QCstipple
))
4295 #ifdef HAVE_X_WINDOWS
4296 if (!UNSPECIFIEDP (value
)
4298 && NILP (Fbitmap_spec_p (value
)))
4299 signal_error ("Invalid stipple attribute", value
);
4300 old_value
= LFACE_STIPPLE (lface
);
4301 LFACE_STIPPLE (lface
) = value
;
4302 #endif /* HAVE_X_WINDOWS */
4304 else if (EQ (attr
, QCwidth
))
4306 if (!UNSPECIFIEDP (value
))
4308 CHECK_SYMBOL (value
);
4309 if (face_numeric_swidth (value
) < 0)
4310 signal_error ("Invalid face width", value
);
4312 old_value
= LFACE_SWIDTH (lface
);
4313 LFACE_SWIDTH (lface
) = value
;
4314 font_related_attr_p
= 1;
4316 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4318 #ifdef HAVE_WINDOW_SYSTEM
4319 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4321 /* Set font-related attributes of the Lisp face from an XLFD
4327 f
= SELECTED_FRAME ();
4329 f
= check_x_frame (frame
);
4331 if (!UNSPECIFIEDP (value
))
4333 CHECK_STRING (value
);
4335 /* VALUE may be a fontset name or an alias of fontset. In
4336 such a case, use the base fontset name. */
4337 tmp
= Fquery_fontset (value
, Qnil
);
4340 else if (EQ (attr
, QCfontset
))
4341 signal_error ("Invalid fontset name", value
);
4343 if (EQ (attr
, QCfont
))
4345 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4346 signal_error ("Invalid font or fontset name", value
);
4349 LFACE_FONTSET (lface
) = value
;
4354 #endif /* HAVE_WINDOW_SYSTEM */
4356 else if (EQ (attr
, QCinherit
))
4359 if (SYMBOLP (value
))
4362 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4363 if (!SYMBOLP (XCAR (tail
)))
4366 LFACE_INHERIT (lface
) = value
;
4368 signal_error ("Invalid face inheritance", value
);
4370 else if (EQ (attr
, QCbold
))
4372 old_value
= LFACE_WEIGHT (lface
);
4373 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4374 font_related_attr_p
= 1;
4376 else if (EQ (attr
, QCitalic
))
4378 old_value
= LFACE_SLANT (lface
);
4379 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4380 font_related_attr_p
= 1;
4383 signal_error ("Invalid face attribute name", attr
);
4385 if (font_related_attr_p
4386 && !UNSPECIFIEDP (value
))
4387 /* If a font-related attribute other than QCfont is specified, the
4388 original `font' attribute nor that of default face is useless
4389 to determine a new font. Thus, we set it to nil so that font
4390 selection mechanism doesn't use it. */
4391 LFACE_FONT (lface
) = Qnil
;
4393 /* Changing a named face means that all realized faces depending on
4394 that face are invalid. Since we cannot tell which realized faces
4395 depend on the face, make sure they are all removed. This is done
4396 by incrementing face_change_count. The next call to
4397 init_iterator will then free realized faces. */
4399 && NILP (Fget (face
, Qface_no_inherit
))
4400 && (EQ (attr
, QCfont
)
4401 || EQ (attr
, QCfontset
)
4402 || NILP (Fequal (old_value
, value
))))
4404 ++face_change_count
;
4405 ++windows_or_buffers_changed
;
4408 if (!UNSPECIFIEDP (value
)
4409 && NILP (Fequal (old_value
, value
)))
4415 if (EQ (face
, Qdefault
))
4417 #ifdef HAVE_WINDOW_SYSTEM
4418 /* Changed font-related attributes of the `default' face are
4419 reflected in changed `font' frame parameters. */
4421 && (font_related_attr_p
|| font_attr_p
)
4422 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4423 set_font_frame_param (frame
, lface
);
4425 #endif /* HAVE_WINDOW_SYSTEM */
4427 if (EQ (attr
, QCforeground
))
4428 param
= Qforeground_color
;
4429 else if (EQ (attr
, QCbackground
))
4430 param
= Qbackground_color
;
4432 #ifdef HAVE_WINDOW_SYSTEM
4434 else if (EQ (face
, Qscroll_bar
))
4436 /* Changing the colors of `scroll-bar' sets frame parameters
4437 `scroll-bar-foreground' and `scroll-bar-background'. */
4438 if (EQ (attr
, QCforeground
))
4439 param
= Qscroll_bar_foreground
;
4440 else if (EQ (attr
, QCbackground
))
4441 param
= Qscroll_bar_background
;
4443 #endif /* not WINDOWSNT */
4444 else if (EQ (face
, Qborder
))
4446 /* Changing background color of `border' sets frame parameter
4448 if (EQ (attr
, QCbackground
))
4449 param
= Qborder_color
;
4451 else if (EQ (face
, Qcursor
))
4453 /* Changing background color of `cursor' sets frame parameter
4455 if (EQ (attr
, QCbackground
))
4456 param
= Qcursor_color
;
4458 else if (EQ (face
, Qmouse
))
4460 /* Changing background color of `mouse' sets frame parameter
4462 if (EQ (attr
, QCbackground
))
4463 param
= Qmouse_color
;
4465 #endif /* HAVE_WINDOW_SYSTEM */
4466 else if (EQ (face
, Qmenu
))
4468 /* Indicate that we have to update the menu bar when
4469 realizing faces on FRAME. FRAME t change the
4470 default for new frames. We do this by setting
4471 setting the flag in new face caches */
4474 struct frame
*f
= XFRAME (frame
);
4475 if (FRAME_FACE_CACHE (f
) == NULL
)
4476 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4477 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4480 menu_face_changed_default
= 1;
4486 /* Update `default-frame-alist', which is used for new frames. */
4488 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4491 /* Update the current frame's parameters. */
4494 cons
= XCAR (Vparam_value_alist
);
4495 XSETCAR (cons
, param
);
4496 XSETCDR (cons
, value
);
4497 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4506 #ifdef HAVE_WINDOW_SYSTEM
4508 /* Set the `font' frame parameter of FRAME determined from `default'
4509 face attributes LFACE. If a font name is explicitely
4510 specfied in LFACE, use it as is. Otherwise, determine a font name
4511 from the other font-related atrributes of LFACE. In that case, if
4512 there's no matching font, signals an error. */
4515 set_font_frame_param (frame
, lface
)
4516 Lisp_Object frame
, lface
;
4518 struct frame
*f
= XFRAME (frame
);
4520 if (FRAME_WINDOW_P (f
))
4522 Lisp_Object font_name
;
4525 if (STRINGP (LFACE_FONT (lface
)))
4526 font_name
= LFACE_FONT (lface
);
4529 /* Choose a font name that reflects LFACE's attributes and has
4530 the registry and encoding pattern specified in the default
4531 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4532 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
, NULL
);
4534 error ("No font matches the specified attribute");
4535 font_name
= build_string (font
);
4539 f
->default_face_done_p
= 0;
4540 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4545 /* Update the corresponding face when frame parameter PARAM on frame F
4546 has been assigned the value NEW_VALUE. */
4549 update_face_from_frame_parameter (f
, param
, new_value
)
4551 Lisp_Object param
, new_value
;
4553 Lisp_Object face
= Qnil
;
4556 /* If there are no faces yet, give up. This is the case when called
4557 from Fx_create_frame, and we do the necessary things later in
4558 face-set-after-frame-defaults. */
4559 if (NILP (f
->face_alist
))
4562 if (EQ (param
, Qforeground_color
))
4565 lface
= lface_from_face_name (f
, face
, 1);
4566 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4567 ? new_value
: Qunspecified
);
4568 realize_basic_faces (f
);
4570 else if (EQ (param
, Qbackground_color
))
4574 /* Changing the background color might change the background
4575 mode, so that we have to load new defface specs. Call
4576 frame-update-face-colors to do that. */
4577 XSETFRAME (frame
, f
);
4578 call1 (Qframe_update_face_colors
, frame
);
4581 lface
= lface_from_face_name (f
, face
, 1);
4582 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4583 ? new_value
: Qunspecified
);
4584 realize_basic_faces (f
);
4586 else if (EQ (param
, Qborder_color
))
4589 lface
= lface_from_face_name (f
, face
, 1);
4590 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4591 ? new_value
: Qunspecified
);
4593 else if (EQ (param
, Qcursor_color
))
4596 lface
= lface_from_face_name (f
, face
, 1);
4597 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4598 ? new_value
: Qunspecified
);
4600 else if (EQ (param
, Qmouse_color
))
4603 lface
= lface_from_face_name (f
, face
, 1);
4604 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4605 ? new_value
: Qunspecified
);
4608 /* Changing a named face means that all realized faces depending on
4609 that face are invalid. Since we cannot tell which realized faces
4610 depend on the face, make sure they are all removed. This is done
4611 by incrementing face_change_count. The next call to
4612 init_iterator will then free realized faces. */
4614 && NILP (Fget (face
, Qface_no_inherit
)))
4616 ++face_change_count
;
4617 ++windows_or_buffers_changed
;
4622 /* Get the value of X resource RESOURCE, class CLASS for the display
4623 of frame FRAME. This is here because ordinary `x-get-resource'
4624 doesn't take a frame argument. */
4626 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4627 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4628 (resource
, class, frame
)
4629 Lisp_Object resource
, class, frame
;
4631 Lisp_Object value
= Qnil
;
4632 CHECK_STRING (resource
);
4633 CHECK_STRING (class);
4634 CHECK_LIVE_FRAME (frame
);
4636 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4637 resource
, class, Qnil
, Qnil
);
4643 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4644 If VALUE is "on" or "true", return t. If VALUE is "off" or
4645 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4646 error; if SIGNAL_P is zero, return 0. */
4649 face_boolean_x_resource_value (value
, signal_p
)
4653 Lisp_Object result
= make_number (0);
4655 xassert (STRINGP (value
));
4657 if (xstricmp (SDATA (value
), "on") == 0
4658 || xstricmp (SDATA (value
), "true") == 0)
4660 else if (xstricmp (SDATA (value
), "off") == 0
4661 || xstricmp (SDATA (value
), "false") == 0)
4663 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4664 result
= Qunspecified
;
4666 signal_error ("Invalid face attribute value from X resource", value
);
4672 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4673 Finternal_set_lisp_face_attribute_from_resource
,
4674 Sinternal_set_lisp_face_attribute_from_resource
,
4675 3, 4, 0, doc
: /* */)
4676 (face
, attr
, value
, frame
)
4677 Lisp_Object face
, attr
, value
, frame
;
4679 CHECK_SYMBOL (face
);
4680 CHECK_SYMBOL (attr
);
4681 CHECK_STRING (value
);
4683 if (xstricmp (SDATA (value
), "unspecified") == 0)
4684 value
= Qunspecified
;
4685 else if (EQ (attr
, QCheight
))
4687 value
= Fstring_to_number (value
, make_number (10));
4688 if (XINT (value
) <= 0)
4689 signal_error ("Invalid face height from X resource", value
);
4691 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4692 value
= face_boolean_x_resource_value (value
, 1);
4693 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4694 value
= intern (SDATA (value
));
4695 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4696 value
= face_boolean_x_resource_value (value
, 1);
4697 else if (EQ (attr
, QCunderline
)
4698 || EQ (attr
, QCoverline
)
4699 || EQ (attr
, QCstrike_through
))
4701 Lisp_Object boolean_value
;
4703 /* If the result of face_boolean_x_resource_value is t or nil,
4704 VALUE does NOT specify a color. */
4705 boolean_value
= face_boolean_x_resource_value (value
, 0);
4706 if (SYMBOLP (boolean_value
))
4707 value
= boolean_value
;
4709 else if (EQ (attr
, QCbox
))
4710 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4712 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4715 #endif /* HAVE_WINDOW_SYSTEM */
4718 /***********************************************************************
4720 ***********************************************************************/
4722 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4724 /* Make menus on frame F appear as specified by the `menu' face. */
4727 x_update_menu_appearance (f
)
4730 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4734 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4738 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4739 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4740 const char *myname
= SDATA (Vx_resource_name
);
4743 const char *popup_path
= "popup_menu";
4745 const char *popup_path
= "menu.popup";
4748 if (STRINGP (LFACE_FOREGROUND (lface
)))
4750 sprintf (line
, "%s.%s*foreground: %s",
4752 SDATA (LFACE_FOREGROUND (lface
)));
4753 XrmPutLineResource (&rdb
, line
);
4754 sprintf (line
, "%s.pane.menubar*foreground: %s",
4755 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4756 XrmPutLineResource (&rdb
, line
);
4760 if (STRINGP (LFACE_BACKGROUND (lface
)))
4762 sprintf (line
, "%s.%s*background: %s",
4764 SDATA (LFACE_BACKGROUND (lface
)));
4765 XrmPutLineResource (&rdb
, line
);
4766 sprintf (line
, "%s.pane.menubar*background: %s",
4767 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4768 XrmPutLineResource (&rdb
, line
);
4773 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4774 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4775 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4776 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4777 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4778 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4781 const char *suffix
= "List";
4784 const char *suffix
= "";
4787 #if defined HAVE_X_I18N
4788 extern char *xic_create_fontsetname
4789 P_ ((char *base_fontname
, Bool motif
));
4790 char *fontsetname
= xic_create_fontsetname (face
->font_name
, motif
);
4792 char *fontsetname
= face
->font_name
;
4794 sprintf (line
, "%s.pane.menubar*font%s: %s",
4795 myname
, suffix
, fontsetname
);
4796 XrmPutLineResource (&rdb
, line
);
4797 sprintf (line
, "%s.%s*font%s: %s",
4798 myname
, popup_path
, suffix
, fontsetname
);
4799 XrmPutLineResource (&rdb
, line
);
4801 if (fontsetname
!= face
->font_name
)
4802 xfree (fontsetname
);
4805 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4806 free_frame_menubar (f
);
4810 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4813 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4814 Sface_attribute_relative_p
,
4816 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4818 Lisp_Object attribute
, value
;
4820 if (EQ (value
, Qunspecified
))
4822 else if (EQ (attribute
, QCheight
))
4823 return INTEGERP (value
) ? Qnil
: Qt
;
4828 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4830 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4831 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4832 the result will be absolute, otherwise it will be relative. */)
4833 (attribute
, value1
, value2
)
4834 Lisp_Object attribute
, value1
, value2
;
4836 if (EQ (value1
, Qunspecified
))
4838 else if (EQ (attribute
, QCheight
))
4839 return merge_face_heights (value1
, value2
, value1
);
4845 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4846 Sinternal_get_lisp_face_attribute
,
4848 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4849 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4850 face attribute name, signal an error.
4851 If the optional argument FRAME is given, report on face SYMBOL in that
4852 frame. If FRAME is t, report on the defaults for face SYMBOL (for new
4853 frames). If FRAME is omitted or nil, use the selected frame. */)
4854 (symbol
, keyword
, frame
)
4855 Lisp_Object symbol
, keyword
, frame
;
4857 Lisp_Object lface
, value
= Qnil
;
4859 CHECK_SYMBOL (symbol
);
4860 CHECK_SYMBOL (keyword
);
4863 lface
= lface_from_face_name (NULL
, symbol
, 1);
4867 frame
= selected_frame
;
4868 CHECK_LIVE_FRAME (frame
);
4869 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4872 if (EQ (keyword
, QCfamily
))
4873 value
= LFACE_FAMILY (lface
);
4874 else if (EQ (keyword
, QCheight
))
4875 value
= LFACE_HEIGHT (lface
);
4876 else if (EQ (keyword
, QCweight
))
4877 value
= LFACE_WEIGHT (lface
);
4878 else if (EQ (keyword
, QCslant
))
4879 value
= LFACE_SLANT (lface
);
4880 else if (EQ (keyword
, QCunderline
))
4881 value
= LFACE_UNDERLINE (lface
);
4882 else if (EQ (keyword
, QCoverline
))
4883 value
= LFACE_OVERLINE (lface
);
4884 else if (EQ (keyword
, QCstrike_through
))
4885 value
= LFACE_STRIKE_THROUGH (lface
);
4886 else if (EQ (keyword
, QCbox
))
4887 value
= LFACE_BOX (lface
);
4888 else if (EQ (keyword
, QCinverse_video
)
4889 || EQ (keyword
, QCreverse_video
))
4890 value
= LFACE_INVERSE (lface
);
4891 else if (EQ (keyword
, QCforeground
))
4892 value
= LFACE_FOREGROUND (lface
);
4893 else if (EQ (keyword
, QCbackground
))
4894 value
= LFACE_BACKGROUND (lface
);
4895 else if (EQ (keyword
, QCstipple
))
4896 value
= LFACE_STIPPLE (lface
);
4897 else if (EQ (keyword
, QCwidth
))
4898 value
= LFACE_SWIDTH (lface
);
4899 else if (EQ (keyword
, QCinherit
))
4900 value
= LFACE_INHERIT (lface
);
4901 else if (EQ (keyword
, QCfont
))
4902 value
= LFACE_FONT (lface
);
4903 else if (EQ (keyword
, QCfontset
))
4904 value
= LFACE_FONTSET (lface
);
4906 signal_error ("Invalid face attribute name", keyword
);
4912 DEFUN ("internal-lisp-face-attribute-values",
4913 Finternal_lisp_face_attribute_values
,
4914 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4915 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4916 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4920 Lisp_Object result
= Qnil
;
4922 CHECK_SYMBOL (attr
);
4924 if (EQ (attr
, QCweight
)
4925 || EQ (attr
, QCslant
)
4926 || EQ (attr
, QCwidth
))
4928 /* Extract permissible symbols from tables. */
4929 struct table_entry
*table
;
4932 if (EQ (attr
, QCweight
))
4933 table
= weight_table
, dim
= DIM (weight_table
);
4934 else if (EQ (attr
, QCslant
))
4935 table
= slant_table
, dim
= DIM (slant_table
);
4937 table
= swidth_table
, dim
= DIM (swidth_table
);
4939 for (i
= 0; i
< dim
; ++i
)
4941 Lisp_Object symbol
= *table
[i
].symbol
;
4942 Lisp_Object tail
= result
;
4945 && !EQ (XCAR (tail
), symbol
))
4949 result
= Fcons (symbol
, result
);
4952 else if (EQ (attr
, QCunderline
))
4953 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4954 else if (EQ (attr
, QCoverline
))
4955 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4956 else if (EQ (attr
, QCstrike_through
))
4957 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4958 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4959 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4965 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4966 Sinternal_merge_in_global_face
, 2, 2, 0,
4967 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4968 Default face attributes override any local face attributes. */)
4970 Lisp_Object face
, frame
;
4973 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4975 CHECK_LIVE_FRAME (frame
);
4976 global_lface
= lface_from_face_name (NULL
, face
, 1);
4977 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4978 if (NILP (local_lface
))
4979 local_lface
= Finternal_make_lisp_face (face
, frame
);
4981 /* Make every specified global attribute override the local one.
4982 BEWARE!! This is only used from `face-set-after-frame-default' where
4983 the local frame is defined from default specs in `face-defface-spec'
4984 and those should be overridden by global settings. Hence the strange
4985 "global before local" priority. */
4986 lvec
= XVECTOR (local_lface
)->contents
;
4987 gvec
= XVECTOR (global_lface
)->contents
;
4988 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4989 if (! UNSPECIFIEDP (gvec
[i
]))
4996 /* The following function is implemented for compatibility with 20.2.
4997 The function is used in x-resolve-fonts when it is asked to
4998 return fonts with the same size as the font of a face. This is
4999 done in fontset.el. */
5001 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
5002 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
5003 The font name is, by default, for ASCII characters.
5004 If the optional argument FRAME is given, report on face FACE in that frame.
5005 If FRAME is t, report on the defaults for face FACE (for new frames).
5006 The font default for a face is either nil, or a list
5007 of the form (bold), (italic) or (bold italic).
5008 If FRAME is omitted or nil, use the selected frame. And, in this case,
5009 if the optional third argument CHARACTER is given,
5010 return the font name used for CHARACTER. */)
5011 (face
, frame
, character
)
5012 Lisp_Object face
, frame
, character
;
5016 Lisp_Object result
= Qnil
;
5017 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
5019 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
5020 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
5021 result
= Fcons (Qbold
, result
);
5023 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
5024 && !EQ (LFACE_SLANT (lface
), Qnormal
))
5025 result
= Fcons (Qitalic
, result
);
5031 struct frame
*f
= frame_or_selected_frame (frame
, 1);
5032 int face_id
= lookup_named_face (f
, face
, 1);
5033 struct face
*face
= FACE_FROM_ID (f
, face_id
);
5037 #ifdef HAVE_WINDOW_SYSTEM
5038 if (FRAME_WINDOW_P (f
) && !NILP (character
))
5040 CHECK_CHARACTER (character
);
5041 face_id
= FACE_FOR_CHAR (f
, face
, XINT (character
), -1, Qnil
);
5042 face
= FACE_FROM_ID (f
, face_id
);
5043 return (face
->font
&& face
->font_name
5044 ? build_string (face
->font_name
)
5048 return build_string (face
->font_name
);
5053 /* Compare face-attribute values v1 and v2 for equality. Value is non-zero if
5054 all attributes are `equal'. Tries to be fast because this function
5055 is called quite often. */
5058 face_attr_equal_p (v1
, v2
)
5061 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
5062 and the other is specified. */
5063 if (XTYPE (v1
) != XTYPE (v2
))
5072 if (SBYTES (v1
) != SBYTES (v2
))
5075 return bcmp (SDATA (v1
), SDATA (v2
), SBYTES (v1
)) == 0;
5082 return !NILP (Fequal (v1
, v2
));
5087 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
5088 all attributes are `equal'. Tries to be fast because this function
5089 is called quite often. */
5092 lface_equal_p (v1
, v2
)
5093 Lisp_Object
*v1
, *v2
;
5097 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
5098 equal_p
= face_attr_equal_p (v1
[i
], v2
[i
]);
5104 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
5105 Sinternal_lisp_face_equal_p
, 2, 3, 0,
5106 doc
: /* True if FACE1 and FACE2 are equal.
5107 If the optional argument FRAME is given, report on face FACE in that frame.
5108 If FRAME is t, report on the defaults for face FACE (for new frames).
5109 If FRAME is omitted or nil, use the selected frame. */)
5110 (face1
, face2
, frame
)
5111 Lisp_Object face1
, face2
, frame
;
5114 Lisp_Object lface1
, lface2
;
5116 lface1
= lface_from_face_name (NULL
, face1
, 1);
5117 lface2
= lface_from_face_name (NULL
, face2
, 1);
5118 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
5119 XVECTOR (lface2
)->contents
);
5120 return equal_p
? Qt
: Qnil
;
5124 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
5125 Sinternal_lisp_face_empty_p
, 1, 2, 0,
5126 doc
: /* True if FACE has no attribute specified.
5127 If the optional argument FRAME is given, report on face FACE in that frame.
5128 If FRAME is t, report on the defaults for face FACE (for new frames).
5129 If FRAME is omitted or nil, use the selected frame. */)
5131 Lisp_Object face
, frame
;
5138 frame
= selected_frame
;
5139 CHECK_LIVE_FRAME (frame
);
5143 lface
= lface_from_face_name (NULL
, face
, 1);
5145 lface
= lface_from_face_name (f
, face
, 1);
5147 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5148 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5151 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5155 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5157 doc
: /* Return an alist of frame-local faces defined on FRAME.
5158 For internal use only. */)
5162 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5163 return f
->face_alist
;
5167 /* Return a hash code for Lisp string STRING with case ignored. Used
5168 below in computing a hash value for a Lisp face. */
5170 static INLINE
unsigned
5171 hash_string_case_insensitive (string
)
5174 const unsigned char *s
;
5176 xassert (STRINGP (string
));
5177 for (s
= SDATA (string
); *s
; ++s
)
5178 hash
= (hash
<< 1) ^ tolower (*s
);
5183 /* Return a hash code for face attribute vector V. */
5185 static INLINE
unsigned
5189 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5190 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5191 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5192 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5193 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5194 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5195 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5199 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5200 considering charsets/registries). They do if they specify the same
5201 family, point size, weight, width, slant, font, and fontset. Both
5202 LFACE1 and LFACE2 must be fully-specified. */
5205 lface_same_font_attributes_p (lface1
, lface2
)
5206 Lisp_Object
*lface1
, *lface2
;
5208 xassert (lface_fully_specified_p (lface1
)
5209 && lface_fully_specified_p (lface2
));
5210 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5211 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5212 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5213 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5214 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5215 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5216 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5217 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5218 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5219 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5220 && ! xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5221 SDATA (lface2
[LFACE_FONT_INDEX
]))))
5222 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5223 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5224 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5225 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
5226 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
5232 /***********************************************************************
5234 ***********************************************************************/
5236 /* Allocate and return a new realized face for Lisp face attribute
5239 static struct face
*
5240 make_realized_face (attr
)
5243 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5244 bzero (face
, sizeof *face
);
5245 face
->ascii_face
= face
;
5246 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5251 /* Free realized face FACE, including its X resources. FACE may
5255 free_realized_face (f
, face
)
5261 #ifdef HAVE_WINDOW_SYSTEM
5262 if (FRAME_WINDOW_P (f
))
5264 /* Free fontset of FACE if it is ASCII face. */
5265 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5266 free_face_fontset (f
, face
);
5269 x_free_gc (f
, face
->gc
);
5273 free_face_colors (f
, face
);
5274 x_destroy_bitmap (f
, face
->stipple
);
5276 #endif /* HAVE_WINDOW_SYSTEM */
5283 /* Prepare face FACE for subsequent display on frame F. This
5284 allocated GCs if they haven't been allocated yet or have been freed
5285 by clearing the face cache. */
5288 prepare_face_for_display (f
, face
)
5292 #ifdef HAVE_WINDOW_SYSTEM
5293 xassert (FRAME_WINDOW_P (f
));
5298 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5300 xgcv
.foreground
= face
->foreground
;
5301 xgcv
.background
= face
->background
;
5302 #ifdef HAVE_X_WINDOWS
5303 xgcv
.graphics_exposures
= False
;
5305 /* The font of FACE may be null if we couldn't load it. */
5308 #ifdef HAVE_X_WINDOWS
5309 xgcv
.font
= face
->font
->fid
;
5312 xgcv
.font
= face
->font
;
5315 xgcv
.font
= face
->font
;
5321 #ifdef HAVE_X_WINDOWS
5324 xgcv
.fill_style
= FillOpaqueStippled
;
5325 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5326 mask
|= GCFillStyle
| GCStipple
;
5329 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5332 #endif /* HAVE_WINDOW_SYSTEM */
5336 /* Returns the `distance' between the colors X and Y. */
5339 color_distance (x
, y
)
5342 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5343 Quoting from that paper:
5345 This formula has results that are very close to L*u*v* (with the
5346 modified lightness curve) and, more importantly, it is a more even
5347 algorithm: it does not have a range of colours where it suddenly
5348 gives far from optimal results.
5350 See <http://www.compuphase.com/cmetric.htm> for more info. */
5352 long r
= (x
->red
- y
->red
) >> 8;
5353 long g
= (x
->green
- y
->green
) >> 8;
5354 long b
= (x
->blue
- y
->blue
) >> 8;
5355 long r_mean
= (x
->red
+ y
->red
) >> 9;
5358 (((512 + r_mean
) * r
* r
) >> 8)
5360 + (((767 - r_mean
) * b
* b
) >> 8);
5364 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5365 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5366 COLOR1 and COLOR2 may be either strings containing the color name,
5367 or lists of the form (RED GREEN BLUE).
5368 If FRAME is unspecified or nil, the current frame is used. */)
5369 (color1
, color2
, frame
)
5370 Lisp_Object color1
, color2
, frame
;
5373 XColor cdef1
, cdef2
;
5376 frame
= selected_frame
;
5377 CHECK_LIVE_FRAME (frame
);
5380 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5381 || !STRINGP (color1
)
5382 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5383 signal_error ("Invalid color", color1
);
5384 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5385 || !STRINGP (color2
)
5386 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5387 signal_error ("Invalid color", color2
);
5389 return make_number (color_distance (&cdef1
, &cdef2
));
5393 /***********************************************************************
5395 ***********************************************************************/
5397 /* Return a new face cache for frame F. */
5399 static struct face_cache
*
5403 struct face_cache
*c
;
5406 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5407 bzero (c
, sizeof *c
);
5408 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5409 c
->buckets
= (struct face
**) xmalloc (size
);
5410 bzero (c
->buckets
, size
);
5412 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5414 c
->menu_face_changed_p
= menu_face_changed_default
;
5419 /* Clear out all graphics contexts for all realized faces, except for
5420 the basic faces. This should be done from time to time just to avoid
5421 keeping too many graphics contexts that are no longer needed. */
5425 struct face_cache
*c
;
5427 if (c
&& FRAME_WINDOW_P (c
->f
))
5429 #ifdef HAVE_WINDOW_SYSTEM
5431 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5433 struct face
*face
= c
->faces_by_id
[i
];
5434 if (face
&& face
->gc
)
5436 x_free_gc (c
->f
, face
->gc
);
5440 #endif /* HAVE_WINDOW_SYSTEM */
5445 /* Free all realized faces in face cache C, including basic faces.
5446 C may be null. If faces are freed, make sure the frame's current
5447 matrix is marked invalid, so that a display caused by an expose
5448 event doesn't try to use faces we destroyed. */
5451 free_realized_faces (c
)
5452 struct face_cache
*c
;
5457 struct frame
*f
= c
->f
;
5459 /* We must block input here because we can't process X events
5460 safely while only some faces are freed, or when the frame's
5461 current matrix still references freed faces. */
5464 for (i
= 0; i
< c
->used
; ++i
)
5466 free_realized_face (f
, c
->faces_by_id
[i
]);
5467 c
->faces_by_id
[i
] = NULL
;
5471 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5472 bzero (c
->buckets
, size
);
5474 /* Must do a thorough redisplay the next time. Mark current
5475 matrices as invalid because they will reference faces freed
5476 above. This function is also called when a frame is
5477 destroyed. In this case, the root window of F is nil. */
5478 if (WINDOWP (f
->root_window
))
5480 clear_current_matrices (f
);
5481 ++windows_or_buffers_changed
;
5489 /* Free all realized faces that are using FONTSET on frame F. */
5492 free_realized_faces_for_fontset (f
, fontset
)
5496 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5500 /* We must block input here because we can't process X events safely
5501 while only some faces are freed, or when the frame's current
5502 matrix still references freed faces. */
5505 for (i
= 0; i
< cache
->used
; i
++)
5507 face
= cache
->faces_by_id
[i
];
5509 && face
->fontset
== fontset
)
5511 uncache_face (cache
, face
);
5512 free_realized_face (f
, face
);
5516 /* Must do a thorough redisplay the next time. Mark current
5517 matrices as invalid because they will reference faces freed
5518 above. This function is also called when a frame is destroyed.
5519 In this case, the root window of F is nil. */
5520 if (WINDOWP (f
->root_window
))
5522 clear_current_matrices (f
);
5523 ++windows_or_buffers_changed
;
5530 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5531 This is done after attributes of a named face have been changed,
5532 because we can't tell which realized faces depend on that face. */
5535 free_all_realized_faces (frame
)
5541 FOR_EACH_FRAME (rest
, frame
)
5542 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5545 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5549 /* Free face cache C and faces in it, including their X resources. */
5553 struct face_cache
*c
;
5557 free_realized_faces (c
);
5559 xfree (c
->faces_by_id
);
5565 /* Cache realized face FACE in face cache C. HASH is the hash value
5566 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5567 FACE), insert the new face to the beginning of the collision list
5568 of the face hash table of C. Otherwise, add the new face to the
5569 end of the collision list. This way, lookup_face can quickly find
5570 that a requested face is not cached. */
5573 cache_face (c
, face
, hash
)
5574 struct face_cache
*c
;
5578 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5582 if (face
->ascii_face
!= face
)
5584 struct face
*last
= c
->buckets
[i
];
5595 c
->buckets
[i
] = face
;
5596 face
->prev
= face
->next
= NULL
;
5602 face
->next
= c
->buckets
[i
];
5604 face
->next
->prev
= face
;
5605 c
->buckets
[i
] = face
;
5608 /* Find a free slot in C->faces_by_id and use the index of the free
5609 slot as FACE->id. */
5610 for (i
= 0; i
< c
->used
; ++i
)
5611 if (c
->faces_by_id
[i
] == NULL
)
5615 /* Maybe enlarge C->faces_by_id. */
5618 if (c
->used
== c
->size
)
5621 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
5622 if (new_size
== c
->size
)
5623 abort (); /* Alternatives? ++kfs */
5624 sz
= new_size
* sizeof *c
->faces_by_id
;
5625 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5632 /* Check that FACE got a unique id. */
5637 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5638 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5644 #endif /* GLYPH_DEBUG */
5646 c
->faces_by_id
[i
] = face
;
5650 /* Remove face FACE from cache C. */
5653 uncache_face (c
, face
)
5654 struct face_cache
*c
;
5657 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5660 face
->prev
->next
= face
->next
;
5662 c
->buckets
[i
] = face
->next
;
5665 face
->next
->prev
= face
->prev
;
5667 c
->faces_by_id
[face
->id
] = NULL
;
5668 if (face
->id
== c
->used
)
5673 /* Look up a realized face with face attributes ATTR in the face cache
5674 of frame F. The face will be used to display ASCII characters.
5675 Value is the ID of the face found. If no suitable face is found,
5676 realize a new one. */
5679 lookup_face (f
, attr
)
5683 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5688 xassert (cache
!= NULL
);
5689 check_lface_attrs (attr
);
5691 /* Look up ATTR in the face cache. */
5692 hash
= lface_hash (attr
);
5693 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5695 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5697 if (face
->ascii_face
!= face
)
5699 /* There's no more ASCII face. */
5703 if (face
->hash
== hash
5704 && lface_equal_p (face
->lface
, attr
))
5708 /* If not found, realize a new face. */
5710 face
= realize_face (cache
, attr
, -1);
5713 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5714 #endif /* GLYPH_DEBUG */
5719 #ifdef HAVE_WINDOW_SYSTEM
5720 /* Look up a realized face that has the same attributes as BASE_FACE
5721 except for the font in the face cache of frame F. If FONT_ID is
5722 not negative, it is an ID number of an already opened font that is
5723 used by the face. If FONT_ID is negative, the face has no font.
5724 Value is the ID of the face found. If no suitable face is found,
5725 realize a new one. */
5728 lookup_non_ascii_face (f
, font_id
, base_face
)
5731 struct face
*base_face
;
5733 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5738 xassert (cache
!= NULL
);
5739 base_face
= base_face
->ascii_face
;
5740 hash
= lface_hash (base_face
->lface
);
5741 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5743 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5745 if (face
->ascii_face
== face
)
5747 if (face
->ascii_face
== base_face
5748 && face
->font_info_id
== font_id
)
5752 /* If not found, realize a new face. */
5754 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5757 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5758 #endif /* GLYPH_DEBUG */
5762 #endif /* HAVE_WINDOW_SYSTEM */
5764 /* Return the face id of the realized face for named face SYMBOL on
5765 frame F suitable for displaying ASCII characters. Value is -1 if
5766 the face couldn't be determined, which might happen if the default
5767 face isn't realized and cannot be realized. */
5770 lookup_named_face (f
, symbol
, signal_p
)
5775 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5776 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5777 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5779 if (default_face
== NULL
)
5781 if (!realize_basic_faces (f
))
5783 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5786 if (!get_lface_attributes (f
, symbol
, symbol_attrs
, signal_p
))
5789 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5790 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5792 return lookup_face (f
, attrs
);
5796 /* Return the ID of the realized ASCII face of Lisp face with ID
5797 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5800 ascii_face_of_lisp_face (f
, lface_id
)
5806 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5808 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5809 face_id
= lookup_named_face (f
, face_name
, 1);
5818 /* Return a face for charset ASCII that is like the face with id
5819 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5820 STEPS < 0 means larger. Value is the id of the face. */
5823 smaller_face (f
, face_id
, steps
)
5827 #ifdef HAVE_WINDOW_SYSTEM
5829 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5830 int pt
, last_pt
, last_height
;
5833 struct face
*new_face
;
5835 /* If not called for an X frame, just return the original face. */
5836 if (FRAME_TERMCAP_P (f
))
5839 /* Try in increments of 1/2 pt. */
5840 delta
= steps
< 0 ? 5 : -5;
5841 steps
= abs (steps
);
5843 face
= FACE_FROM_ID (f
, face_id
);
5844 bcopy (face
->lface
, attrs
, sizeof attrs
);
5845 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5846 new_face_id
= face_id
;
5847 last_height
= FONT_HEIGHT (face
->font
);
5851 /* Give up if we cannot find a font within 10pt. */
5852 && abs (last_pt
- pt
) < 100)
5854 /* Look up a face for a slightly smaller/larger font. */
5856 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5857 new_face_id
= lookup_face (f
, attrs
);
5858 new_face
= FACE_FROM_ID (f
, new_face_id
);
5860 /* If height changes, count that as one step. */
5861 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5862 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5865 last_height
= FONT_HEIGHT (new_face
->font
);
5872 #else /* not HAVE_WINDOW_SYSTEM */
5876 #endif /* not HAVE_WINDOW_SYSTEM */
5880 /* Return a face for charset ASCII that is like the face with id
5881 FACE_ID on frame F, but has height HEIGHT. */
5884 face_with_height (f
, face_id
, height
)
5889 #ifdef HAVE_WINDOW_SYSTEM
5891 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5893 if (FRAME_TERMCAP_P (f
)
5897 face
= FACE_FROM_ID (f
, face_id
);
5898 bcopy (face
->lface
, attrs
, sizeof attrs
);
5899 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5900 face_id
= lookup_face (f
, attrs
);
5901 #endif /* HAVE_WINDOW_SYSTEM */
5907 /* Return the face id of the realized face for named face SYMBOL on
5908 frame F suitable for displaying ASCII characters, and use
5909 attributes of the face FACE_ID for attributes that aren't
5910 completely specified by SYMBOL. This is like lookup_named_face,
5911 except that the default attributes come from FACE_ID, not from the
5912 default face. FACE_ID is assumed to be already realized. */
5915 lookup_derived_face (f
, symbol
, face_id
)
5920 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5921 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5922 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5927 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5928 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5929 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
5930 return lookup_face (f
, attrs
);
5933 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5934 Sface_attributes_as_vector
, 1, 1, 0,
5935 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5940 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5942 merge_face_ref (XFRAME (selected_frame
), plist
, XVECTOR (lface
)->contents
,
5949 /***********************************************************************
5950 Face capability testing
5951 ***********************************************************************/
5954 /* If the distance (as returned by color_distance) between two colors is
5955 less than this, then they are considered the same, for determining
5956 whether a color is supported or not. The range of values is 0-65535. */
5958 #define TTY_SAME_COLOR_THRESHOLD 10000
5960 #ifdef HAVE_WINDOW_SYSTEM
5962 /* Return non-zero if all the face attributes in ATTRS are supported
5963 on the window-system frame F.
5965 The definition of `supported' is somewhat heuristic, but basically means
5966 that a face containing all the attributes in ATTRS, when merged with the
5967 default face for display, can be represented in a way that's
5969 \(1) different in appearance than the default face, and
5970 \(2) `close in spirit' to what the attributes specify, if not exact. */
5973 x_supports_face_attributes_p (f
, attrs
, def_face
)
5976 struct face
*def_face
;
5978 Lisp_Object
*def_attrs
= def_face
->lface
;
5980 /* Check that other specified attributes are different that the default
5982 if ((!UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
5983 && face_attr_equal_p (attrs
[LFACE_UNDERLINE_INDEX
],
5984 def_attrs
[LFACE_UNDERLINE_INDEX
]))
5985 || (!UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
5986 && face_attr_equal_p (attrs
[LFACE_INVERSE_INDEX
],
5987 def_attrs
[LFACE_INVERSE_INDEX
]))
5988 || (!UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
5989 && face_attr_equal_p (attrs
[LFACE_FOREGROUND_INDEX
],
5990 def_attrs
[LFACE_FOREGROUND_INDEX
]))
5991 || (!UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
5992 && face_attr_equal_p (attrs
[LFACE_BACKGROUND_INDEX
],
5993 def_attrs
[LFACE_BACKGROUND_INDEX
]))
5994 || (!UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
5995 && face_attr_equal_p (attrs
[LFACE_STIPPLE_INDEX
],
5996 def_attrs
[LFACE_STIPPLE_INDEX
]))
5997 || (!UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
5998 && face_attr_equal_p (attrs
[LFACE_OVERLINE_INDEX
],
5999 def_attrs
[LFACE_OVERLINE_INDEX
]))
6000 || (!UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
6001 && face_attr_equal_p (attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6002 def_attrs
[LFACE_STRIKE_THROUGH_INDEX
]))
6003 || (!UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
6004 && face_attr_equal_p (attrs
[LFACE_BOX_INDEX
],
6005 def_attrs
[LFACE_BOX_INDEX
])))
6008 /* Check font-related attributes, as those are the most commonly
6009 "unsupported" on a window-system (because of missing fonts). */
6010 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
6011 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
6012 || !UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
6013 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
6014 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
6015 || !UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
]))
6019 Lisp_Object merged_attrs
[LFACE_VECTOR_SIZE
];
6021 bcopy (def_attrs
, merged_attrs
, sizeof merged_attrs
);
6023 merge_face_vectors (f
, attrs
, merged_attrs
, 0);
6025 face_id
= lookup_face (f
, merged_attrs
);
6026 face
= FACE_FROM_ID (f
, face_id
);
6029 error ("cannot make face");
6031 /* If the font is the same, then not supported. */
6032 if (face
->font
== def_face
->font
)
6036 /* Everything checks out, this face is supported. */
6040 #endif /* HAVE_WINDOW_SYSTEM */
6042 /* Return non-zero if all the face attributes in ATTRS are supported
6045 The definition of `supported' is somewhat heuristic, but basically means
6046 that a face containing all the attributes in ATTRS, when merged
6047 with the default face for display, can be represented in a way that's
6049 \(1) different in appearance than the default face, and
6050 \(2) `close in spirit' to what the attributes specify, if not exact.
6052 Point (2) implies that a `:weight black' attribute will be satisfied
6053 by any terminal that can display bold, and a `:foreground "yellow"' as
6054 long as the terminal can display a yellowish color, but `:slant italic'
6055 will _not_ be satisfied by the tty display code's automatic
6056 substitution of a `dim' face for italic. */
6059 tty_supports_face_attributes_p (f
, attrs
, def_face
)
6062 struct face
*def_face
;
6065 Lisp_Object val
, fg
, bg
;
6066 XColor fg_tty_color
, fg_std_color
;
6067 XColor bg_tty_color
, bg_std_color
;
6068 unsigned test_caps
= 0;
6069 Lisp_Object
*def_attrs
= def_face
->lface
;
6072 /* First check some easy-to-check stuff; ttys support none of the
6073 following attributes, so we can just return false if any are requested
6074 (even if `nominal' values are specified, we should still return false,
6075 as that will be the same value that the default face uses). We
6076 consider :slant unsupportable on ttys, even though the face code
6077 actually `fakes' them using a dim attribute if possible. This is
6078 because the faked result is too different from what the face
6080 if (!UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
6081 || !UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
6082 || !UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
6083 || !UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
6084 || !UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
6085 || !UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
6086 || !UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
6087 || !UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
]))
6091 /* Test for terminal `capabilities' (non-color character attributes). */
6093 /* font weight (bold/dim) */
6094 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6097 int def_weight
= face_numeric_weight (def_attrs
[LFACE_WEIGHT_INDEX
]);
6099 if (weight
> XLFD_WEIGHT_MEDIUM
)
6101 if (def_weight
> XLFD_WEIGHT_MEDIUM
)
6102 return 0; /* same as default */
6103 test_caps
= TTY_CAP_BOLD
;
6105 else if (weight
< XLFD_WEIGHT_MEDIUM
)
6107 if (def_weight
< XLFD_WEIGHT_MEDIUM
)
6108 return 0; /* same as default */
6109 test_caps
= TTY_CAP_DIM
;
6111 else if (def_weight
== XLFD_WEIGHT_MEDIUM
)
6112 return 0; /* same as default */
6116 val
= attrs
[LFACE_UNDERLINE_INDEX
];
6117 if (!UNSPECIFIEDP (val
))
6120 return 0; /* ttys can't use colored underlines */
6121 else if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6122 return 0; /* same as default */
6124 test_caps
|= TTY_CAP_UNDERLINE
;
6128 val
= attrs
[LFACE_INVERSE_INDEX
];
6129 if (!UNSPECIFIEDP (val
))
6131 if (face_attr_equal_p (val
, def_attrs
[LFACE_UNDERLINE_INDEX
]))
6132 return 0; /* same as default */
6134 test_caps
|= TTY_CAP_INVERSE
;
6138 /* Color testing. */
6140 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
6141 we use them when calling `tty_capable_p' below, even if the face
6142 specifies no colors. */
6143 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6144 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6146 /* Check if foreground color is close enough. */
6147 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
6150 Lisp_Object def_fg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6152 if (face_attr_equal_p (fg
, def_fg
))
6153 return 0; /* same as default */
6154 else if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
6155 return 0; /* not a valid color */
6156 else if (color_distance (&fg_tty_color
, &fg_std_color
)
6157 > TTY_SAME_COLOR_THRESHOLD
)
6158 return 0; /* displayed color is too different */
6160 /* Make sure the color is really different than the default. */
6162 XColor def_fg_color
;
6163 if (tty_lookup_color (f
, def_fg
, &def_fg_color
, 0)
6164 && (color_distance (&fg_tty_color
, &def_fg_color
)
6165 <= TTY_SAME_COLOR_THRESHOLD
))
6170 /* Check if background color is close enough. */
6171 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
6174 Lisp_Object def_bg
= def_attrs
[LFACE_FOREGROUND_INDEX
];
6176 if (face_attr_equal_p (bg
, def_bg
))
6177 return 0; /* same as default */
6178 else if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
6179 return 0; /* not a valid color */
6180 else if (color_distance (&bg_tty_color
, &bg_std_color
)
6181 > TTY_SAME_COLOR_THRESHOLD
)
6182 return 0; /* displayed color is too different */
6184 /* Make sure the color is really different than the default. */
6186 XColor def_bg_color
;
6187 if (tty_lookup_color (f
, def_bg
, &def_bg_color
, 0)
6188 && (color_distance (&bg_tty_color
, &def_bg_color
)
6189 <= TTY_SAME_COLOR_THRESHOLD
))
6194 /* If both foreground and background are requested, see if the
6195 distance between them is OK. We just check to see if the distance
6196 between the tty's foreground and background is close enough to the
6197 distance between the standard foreground and background. */
6198 if (STRINGP (fg
) && STRINGP (bg
))
6201 = (color_distance (&fg_std_color
, &bg_std_color
)
6202 - color_distance (&fg_tty_color
, &bg_tty_color
));
6203 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
6204 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
6209 /* See if the capabilities we selected above are supported, with the
6211 if (test_caps
!= 0 &&
6212 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
6216 /* Hmmm, everything checks out, this terminal must support this face. */
6221 DEFUN ("display-supports-face-attributes-p",
6222 Fdisplay_supports_face_attributes_p
, Sdisplay_supports_face_attributes_p
,
6224 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
6225 The optional argument DISPLAY can be a display name, a frame, or
6226 nil (meaning the selected frame's display)
6228 The definition of `supported' is somewhat heuristic, but basically means
6229 that a face containing all the attributes in ATTRIBUTES, when merged
6230 with the default face for display, can be represented in a way that's
6232 \(1) different in appearance than the default face, and
6233 \(2) `close in spirit' to what the attributes specify, if not exact.
6235 Point (2) implies that a `:weight black' attribute will be satisfied by
6236 any display that can display bold, and a `:foreground \"yellow\"' as long
6237 as it can display a yellowish color, but `:slant italic' will _not_ be
6238 satisfied by the tty display code's automatic substitution of a `dim'
6239 face for italic. */)
6240 (attributes
, display
)
6241 Lisp_Object attributes
, display
;
6246 struct face
*def_face
;
6247 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6249 if (noninteractive
|| !initialized
)
6250 /* We may not be able to access low-level face information in batch
6251 mode, or before being dumped, and this function is not going to
6252 be very useful in those cases anyway, so just give up. */
6256 frame
= selected_frame
;
6257 else if (FRAMEP (display
))
6261 /* Find any frame on DISPLAY. */
6262 Lisp_Object fl_tail
;
6265 for (fl_tail
= Vframe_list
; CONSP (fl_tail
); fl_tail
= XCDR (fl_tail
))
6267 frame
= XCAR (fl_tail
);
6268 if (!NILP (Fequal (Fcdr (Fassq (Qdisplay
,
6269 XFRAME (frame
)->param_alist
)),
6275 CHECK_LIVE_FRAME (frame
);
6278 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
6279 attrs
[i
] = Qunspecified
;
6280 merge_face_ref (f
, attributes
, attrs
, 1, 0);
6282 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6283 if (def_face
== NULL
)
6285 if (! realize_basic_faces (f
))
6286 error ("Cannot realize default face");
6287 def_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6290 /* Dispatch to the appropriate handler. */
6291 if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6292 supports
= tty_supports_face_attributes_p (f
, attrs
, def_face
);
6293 #ifdef HAVE_WINDOW_SYSTEM
6295 supports
= x_supports_face_attributes_p (f
, attrs
, def_face
);
6298 return supports
? Qt
: Qnil
;
6302 /***********************************************************************
6304 ***********************************************************************/
6306 DEFUN ("internal-set-font-selection-order",
6307 Finternal_set_font_selection_order
,
6308 Sinternal_set_font_selection_order
, 1, 1, 0,
6309 doc
: /* Set font selection order for face font selection to ORDER.
6310 ORDER must be a list of length 4 containing the symbols `:width',
6311 `:height', `:weight', and `:slant'. Face attributes appearing
6312 first in ORDER are matched first, e.g. if `:height' appears before
6313 `:weight' in ORDER, font selection first tries to find a font with
6314 a suitable height, and then tries to match the font weight.
6321 int indices
[DIM (font_sort_order
)];
6324 bzero (indices
, sizeof indices
);
6328 CONSP (list
) && i
< DIM (indices
);
6329 list
= XCDR (list
), ++i
)
6331 Lisp_Object attr
= XCAR (list
);
6334 if (EQ (attr
, QCwidth
))
6336 else if (EQ (attr
, QCheight
))
6337 xlfd
= XLFD_POINT_SIZE
;
6338 else if (EQ (attr
, QCweight
))
6340 else if (EQ (attr
, QCslant
))
6345 if (indices
[i
] != 0)
6350 if (!NILP (list
) || i
!= DIM (indices
))
6351 signal_error ("Invalid font sort order", order
);
6352 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6353 if (indices
[i
] == 0)
6354 signal_error ("Invalid font sort order", order
);
6356 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6358 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6359 free_all_realized_faces (Qnil
);
6366 DEFUN ("internal-set-alternative-font-family-alist",
6367 Finternal_set_alternative_font_family_alist
,
6368 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6369 doc
: /* Define alternative font families to try in face font selection.
6370 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6371 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6372 be found. Value is ALIST. */)
6377 Vface_alternative_font_family_alist
= alist
;
6378 free_all_realized_faces (Qnil
);
6383 DEFUN ("internal-set-alternative-font-registry-alist",
6384 Finternal_set_alternative_font_registry_alist
,
6385 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6386 doc
: /* Define alternative font registries to try in face font selection.
6387 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6388 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6389 be found. Value is ALIST. */)
6394 Vface_alternative_font_registry_alist
= alist
;
6395 free_all_realized_faces (Qnil
);
6400 #ifdef HAVE_WINDOW_SYSTEM
6402 /* Value is non-zero if FONT is the name of a scalable font. The
6403 X11R6 XLFD spec says that point size, pixel size, and average width
6404 are zero for scalable fonts. Intlfonts contain at least one
6405 scalable font ("*-muleindian-1") for which this isn't true, so we
6406 just test average width. */
6409 font_scalable_p (font
)
6410 struct font_name
*font
;
6412 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6413 return (*s
== '0' && *(s
+ 1) == '\0')
6415 /* Windows implementation of XLFD is slightly broken for backward
6416 compatibility with previous broken versions, so test for
6417 wildcards as well as 0. */
6424 /* Ignore the difference of font point size less than this value. */
6426 #define FONT_POINT_SIZE_QUANTUM 5
6428 /* Value is non-zero if FONT1 is a better match for font attributes
6429 VALUES than FONT2. VALUES is an array of face attribute values in
6430 font sort order. COMPARE_PT_P zero means don't compare point
6431 sizes. AVGWIDTH, if not zero, is a specified font average width
6435 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6437 struct font_name
*font1
, *font2
;
6438 int compare_pt_p
, avgwidth
;
6442 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6444 int xlfd_idx
= font_sort_order
[i
];
6446 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6450 if (xlfd_idx
== XLFD_POINT_SIZE
)
6452 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6453 / font1
->rescale_ratio
));
6454 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6455 / font2
->rescale_ratio
));
6456 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6461 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6462 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6465 if (delta1
> delta2
)
6467 else if (delta1
< delta2
)
6471 /* The difference may be equal because, e.g., the face
6472 specifies `italic' but we have only `regular' and
6473 `oblique'. Prefer `oblique' in this case. */
6474 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6475 && font1
->numeric
[xlfd_idx
] > values
[i
]
6476 && font2
->numeric
[xlfd_idx
] < values
[i
])
6484 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6485 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6486 if (delta1
> delta2
)
6488 else if (delta1
< delta2
)
6494 /* We prefer a real scalable font; i.e. not what autoscaled. */
6495 int auto_scaled_1
= (font1
->numeric
[XLFD_POINT_SIZE
] == 0
6496 && font1
->numeric
[XLFD_RESY
] > 0);
6497 int auto_scaled_2
= (font2
->numeric
[XLFD_POINT_SIZE
] == 0
6498 && font2
->numeric
[XLFD_RESY
] > 0);
6500 if (auto_scaled_1
!= auto_scaled_2
)
6501 return auto_scaled_2
;
6504 return font1
->registry_priority
< font2
->registry_priority
;
6508 /* Value is non-zero if FONT is an exact match for face attributes in
6509 SPECIFIED. SPECIFIED is an array of face attribute values in font
6510 sort order. AVGWIDTH, if non-zero, is an average width to compare
6514 exact_face_match_p (specified
, font
, avgwidth
)
6516 struct font_name
*font
;
6521 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6522 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6525 return (i
== DIM (font_sort_order
)
6527 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6531 /* Value is the name of a scaled font, generated from scalable font
6532 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6533 Value is allocated from heap. */
6536 build_scalable_font_name (f
, font
, specified_pt
)
6538 struct font_name
*font
;
6541 char pixel_size
[20];
6543 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6546 if (font
->numeric
[XLFD_PIXEL_SIZE
] != 0
6547 || font
->numeric
[XLFD_POINT_SIZE
] != 0)
6548 /* This is a scalable font but is requested for a specific size.
6549 We should not change that size. */
6550 return build_font_name (font
);
6552 /* If scalable font is for a specific resolution, compute
6553 the point size we must specify from the resolution of
6554 the display and the specified resolution of the font. */
6555 if (font
->numeric
[XLFD_RESY
] != 0)
6557 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6558 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6563 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6565 /* We may need a font of the different size. */
6566 pixel_value
*= font
->rescale_ratio
;
6568 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6569 font of the specified PIXEL_SIZE. */
6571 { /* Set point size of the font. */
6572 char point_size
[20];
6573 sprintf (point_size
, "%d", (int) pt
);
6574 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6575 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6579 /* Set pixel size. */
6580 sprintf (pixel_size
, "%d", pixel_value
);
6581 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6582 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6584 /* If font doesn't specify its resolution, use the
6585 resolution of the display. */
6586 if (font
->numeric
[XLFD_RESY
] == 0)
6589 sprintf (buffer
, "%d", (int) resy
);
6590 font
->fields
[XLFD_RESY
] = buffer
;
6591 font
->numeric
[XLFD_RESY
] = resy
;
6594 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6597 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6598 sprintf (buffer
, "%d", resx
);
6599 font
->fields
[XLFD_RESX
] = buffer
;
6600 font
->numeric
[XLFD_RESX
] = resx
;
6603 return build_font_name (font
);
6607 /* Value is non-zero if we are allowed to use scalable font FONT. We
6608 can't run a Lisp function here since this function may be called
6609 with input blocked. */
6612 may_use_scalable_font_p (font
)
6615 if (EQ (Vscalable_fonts_allowed
, Qt
))
6617 else if (CONSP (Vscalable_fonts_allowed
))
6619 Lisp_Object tail
, regexp
;
6621 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6623 regexp
= XCAR (tail
);
6624 if (STRINGP (regexp
)
6625 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6635 /* Return the name of the best matching font for face attributes ATTRS
6636 in the array of font_name structures FONTS which contains NFONTS
6637 elements. WIDTH_RATIO is a factor with which to multiply average
6638 widths if ATTRS specifies such a width.
6640 Value is a font name which is allocated from the heap. FONTS is
6641 freed by this function.
6643 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6644 indicate whether the resulting font should be drawn using overstrike
6645 to simulate bold-face. */
6648 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6651 struct font_name
*fonts
;
6654 int *needs_overstrike
;
6657 struct font_name
*best
;
6660 int exact_p
, avgwidth
;
6665 /* Make specified font attributes available in `specified',
6666 indexed by sort order. */
6667 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6669 int xlfd_idx
= font_sort_order
[i
];
6671 if (xlfd_idx
== XLFD_SWIDTH
)
6672 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6673 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6674 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6675 else if (xlfd_idx
== XLFD_WEIGHT
)
6676 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6677 else if (xlfd_idx
== XLFD_SLANT
)
6678 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6683 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6685 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6689 if (needs_overstrike
)
6690 *needs_overstrike
= 0;
6692 /* Start with the first non-scalable font in the list. */
6693 for (i
= 0; i
< nfonts
; ++i
)
6694 if (!font_scalable_p (fonts
+ i
))
6697 /* Find the best match among the non-scalable fonts. */
6702 for (i
= 1; i
< nfonts
; ++i
)
6703 if (!font_scalable_p (fonts
+ i
)
6704 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6708 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6716 /* Unless we found an exact match among non-scalable fonts, see if
6717 we can find a better match among scalable fonts. */
6720 /* A scalable font is better if
6722 1. its weight, slant, swidth attributes are better, or.
6724 2. the best non-scalable font doesn't have the required
6725 point size, and the scalable fonts weight, slant, swidth
6728 int non_scalable_has_exact_height_p
;
6730 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6731 non_scalable_has_exact_height_p
= 1;
6733 non_scalable_has_exact_height_p
= 0;
6735 for (i
= 0; i
< nfonts
; ++i
)
6736 if (font_scalable_p (fonts
+ i
))
6739 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6740 || (!non_scalable_has_exact_height_p
6741 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6743 non_scalable_has_exact_height_p
= 1;
6748 if (needs_overstrike
)
6750 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6751 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6753 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6755 /* We want a bold font, but didn't get one; try to use
6756 overstriking instead to simulate bold-face. However,
6757 don't overstrike an already-bold fontn unless the
6758 desired weight grossly exceeds the available weight. */
6759 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6760 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6762 *needs_overstrike
= 1;
6767 if (font_scalable_p (best
))
6768 font_name
= build_scalable_font_name (f
, best
, pt
);
6770 font_name
= build_font_name (best
);
6772 /* Free font_name structures. */
6773 free_font_names (fonts
, nfonts
);
6779 /* Get a list of matching fonts on frame F, considering FAMILY
6780 and alternative font families from Vface_alternative_font_registry_alist.
6782 FAMILY is the font family whose alternatives are considered.
6784 REGISTRY, if a string, specifies a font registry and encoding to
6785 match. A value of nil means include fonts of any registry and
6788 Return in *FONTS a pointer to a vector of font_name structures for
6789 the fonts matched. Value is the number of fonts found. */
6792 try_alternative_families (f
, family
, registry
, fonts
)
6794 Lisp_Object family
, registry
;
6795 struct font_name
**fonts
;
6800 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6803 /* Try alternative font families. */
6804 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6807 for (alter
= XCDR (alter
);
6808 CONSP (alter
) && nfonts
== 0;
6809 alter
= XCDR (alter
))
6811 if (STRINGP (XCAR (alter
)))
6812 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6816 /* Try all scalable fonts before giving up. */
6817 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6819 int count
= SPECPDL_INDEX ();
6820 specbind (Qscalable_fonts_allowed
, Qt
);
6821 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6822 unbind_to (count
, Qnil
);
6829 /* Get a list of matching fonts on frame F.
6831 PATTERN, if a string, specifies a font name pattern to match while
6832 ignoring FAMILY and REGISTRY.
6834 FAMILY, if a list, specifies a list of font families to try.
6836 REGISTRY, if a list, specifies a list of font registries and
6839 Return in *FONTS a pointer to a vector of font_name structures for
6840 the fonts matched. Value is the number of fonts found. */
6843 try_font_list (f
, pattern
, family
, registry
, fonts
)
6845 Lisp_Object pattern
, family
, registry
;
6846 struct font_name
**fonts
;
6850 if (STRINGP (pattern
))
6852 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6853 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6855 int count
= SPECPDL_INDEX ();
6856 specbind (Qscalable_fonts_allowed
, Qt
);
6857 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6858 unbind_to (count
, Qnil
);
6866 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6868 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6869 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6871 /* Try font family of the default face or "fixed". */
6872 if (nfonts
== 0 && !NILP (family
))
6874 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6876 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6878 family
= build_string ("fixed");
6879 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6882 /* Try any family with the given registry. */
6883 if (nfonts
== 0 && !NILP (family
))
6884 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6891 /* Return the fontset id of the base fontset name or alias name given
6892 by the fontset attribute of ATTRS. Value is -1 if the fontset
6893 attribute of ATTRS doesn't name a fontset. */
6896 face_fontset (attrs
)
6901 name
= attrs
[LFACE_FONTSET_INDEX
];
6902 if (!STRINGP (name
))
6904 return fs_query_fontset (name
, 0);
6908 /* Choose a name of font to use on frame F to display characters with
6909 Lisp face attributes specified by ATTRS. The font name is
6910 determined by the font-related attributes in ATTRS and FONT-SPEC
6913 When we are choosing a font for ASCII characters, FONT-SPEC is
6914 always nil. Otherwise FONT-SPEC is a list
6915 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6916 or a string specifying a font name pattern.
6918 If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
6919 indicate whether the resulting font should be drawn using
6920 overstrike to simulate bold-face.
6922 Value is the font name which is allocated from the heap and must be
6923 freed by the caller. */
6926 choose_face_font (f
, attrs
, font_spec
, needs_overstrike
)
6929 Lisp_Object font_spec
;
6930 int *needs_overstrike
;
6932 Lisp_Object pattern
, family
, adstyle
, registry
;
6933 char *font_name
= NULL
;
6934 struct font_name
*fonts
;
6937 if (needs_overstrike
)
6938 *needs_overstrike
= 0;
6940 /* If we are choosing an ASCII font and a font name is explicitly
6941 specified in ATTRS, return it. */
6942 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6943 return xstrdup (SDATA (attrs
[LFACE_FONT_INDEX
]));
6945 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6948 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6950 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6951 ADSTYLE is not used in the font selector for the moment. */
6952 if (VECTORP (font_spec
))
6955 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6956 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6957 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6958 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6960 else if (STRINGP (font_spec
))
6962 pattern
= font_spec
;
6969 /* We are choosing an ASCII font. By default, use the registry
6970 name "iso8859-1". But, if the registry name of the ASCII
6971 font specified in the fontset of ATTRS is not "iso8859-1"
6972 (e.g "iso10646-1"), use also that name with higher
6974 int fontset
= face_fontset (attrs
);
6977 struct font_name font
;
6981 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
6983 ascii
= fontset_ascii (fontset
);
6984 len
= SBYTES (ascii
);
6986 || strcmp (SDATA (ascii
) + len
- 9, "iso8859-1"))
6988 font
.name
= LSTRDUPA (ascii
);
6989 /* Check if the name is in XLFD. */
6990 if (split_font_name (f
, &font
, 0))
6992 font
.fields
[XLFD_ENCODING
][-1] = '-';
6993 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
6999 /* Get a list of fonts matching that pattern and choose the
7000 best match for the specified face attributes from it. */
7001 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
7002 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
),
7007 #endif /* HAVE_WINDOW_SYSTEM */
7011 /***********************************************************************
7013 ***********************************************************************/
7015 /* Realize basic faces on frame F. Value is zero if frame parameters
7016 of F don't contain enough information needed to realize the default
7020 realize_basic_faces (f
)
7024 int count
= SPECPDL_INDEX ();
7026 /* Block input here so that we won't be surprised by an X expose
7027 event, for instance, without having the faces set up. */
7029 specbind (Qscalable_fonts_allowed
, Qt
);
7031 if (realize_default_face (f
))
7033 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
7034 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
7035 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
7036 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
7037 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
7038 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
7039 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
7040 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
7041 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
7042 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
7044 /* Reflect changes in the `menu' face in menu bars. */
7045 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
7047 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
7048 #ifdef USE_X_TOOLKIT
7049 x_update_menu_appearance (f
);
7056 unbind_to (count
, Qnil
);
7062 /* Realize the default face on frame F. If the face is not fully
7063 specified, make it fully-specified. Attributes of the default face
7064 that are not explicitly specified are taken from frame parameters. */
7067 realize_default_face (f
)
7070 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7072 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7073 Lisp_Object frame_font
;
7076 /* If the `default' face is not yet known, create it. */
7077 lface
= lface_from_face_name (f
, Qdefault
, 0);
7081 XSETFRAME (frame
, f
);
7082 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
7086 #ifdef HAVE_WINDOW_SYSTEM
7087 if (FRAME_WINDOW_P (f
))
7089 /* Set frame_font to the value of the `font' frame parameter. */
7090 frame_font
= Fassq (Qfont
, f
->param_alist
);
7091 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
7092 frame_font
= XCDR (frame_font
);
7093 set_lface_from_font_name (f
, lface
, frame_font
,
7094 f
->default_face_done_p
, 1);
7095 f
->default_face_done_p
= 1;
7097 #endif /* HAVE_WINDOW_SYSTEM */
7099 if (!FRAME_WINDOW_P (f
))
7101 LFACE_FAMILY (lface
) = build_string ("default");
7102 LFACE_SWIDTH (lface
) = Qnormal
;
7103 LFACE_HEIGHT (lface
) = make_number (1);
7104 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
7105 LFACE_WEIGHT (lface
) = Qnormal
;
7106 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
7107 LFACE_SLANT (lface
) = Qnormal
;
7108 LFACE_AVGWIDTH (lface
) = Qunspecified
;
7111 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
7112 LFACE_UNDERLINE (lface
) = Qnil
;
7114 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
7115 LFACE_OVERLINE (lface
) = Qnil
;
7117 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
7118 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
7120 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
7121 LFACE_BOX (lface
) = Qnil
;
7123 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
7124 LFACE_INVERSE (lface
) = Qnil
;
7126 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
7128 /* This function is called so early that colors are not yet
7129 set in the frame parameter list. */
7130 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
7132 if (CONSP (color
) && STRINGP (XCDR (color
)))
7133 LFACE_FOREGROUND (lface
) = XCDR (color
);
7134 else if (FRAME_WINDOW_P (f
))
7136 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7137 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
7142 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
7144 /* This function is called so early that colors are not yet
7145 set in the frame parameter list. */
7146 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
7147 if (CONSP (color
) && STRINGP (XCDR (color
)))
7148 LFACE_BACKGROUND (lface
) = XCDR (color
);
7149 else if (FRAME_WINDOW_P (f
))
7151 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
7152 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
7157 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
7158 LFACE_STIPPLE (lface
) = Qnil
;
7160 /* Realize the face; it must be fully-specified now. */
7161 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
7162 check_lface (lface
);
7163 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
7164 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
7169 /* Realize basic faces other than the default face in face cache C.
7170 SYMBOL is the face name, ID is the face id the realized face must
7171 have. The default face must have been realized already. */
7174 realize_named_face (f
, symbol
, id
)
7179 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
7180 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
7181 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7182 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
7183 struct face
*new_face
;
7185 /* The default face must exist and be fully specified. */
7186 get_lface_attributes (f
, Qdefault
, attrs
, 1);
7187 check_lface_attrs (attrs
);
7188 xassert (lface_fully_specified_p (attrs
));
7190 /* If SYMBOL isn't know as a face, create it. */
7194 XSETFRAME (frame
, f
);
7195 lface
= Finternal_make_lisp_face (symbol
, frame
);
7198 /* Merge SYMBOL's face with the default face. */
7199 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
7200 merge_face_vectors (f
, symbol_attrs
, attrs
, 0);
7202 /* Realize the face. */
7203 new_face
= realize_face (c
, attrs
, id
);
7207 /* Realize the fully-specified face with attributes ATTRS in face
7208 cache CACHE for ASCII characters. If FORMER_FACE_ID is
7209 non-negative, it is an ID of face to remove before caching the new
7210 face. Value is a pointer to the newly created realized face. */
7212 static struct face
*
7213 realize_face (cache
, attrs
, former_face_id
)
7214 struct face_cache
*cache
;
7220 /* LFACE must be fully specified. */
7221 xassert (cache
!= NULL
);
7222 check_lface_attrs (attrs
);
7224 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
7226 /* Remove the former face. */
7227 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
7228 uncache_face (cache
, former_face
);
7229 free_realized_face (cache
->f
, former_face
);
7232 if (FRAME_WINDOW_P (cache
->f
))
7233 face
= realize_x_face (cache
, attrs
);
7234 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
7235 face
= realize_tty_face (cache
, attrs
);
7239 /* Insert the new face. */
7240 cache_face (cache
, face
, lface_hash (attrs
));
7245 #ifdef HAVE_WINDOW_SYSTEM
7246 /* Realize the fully-specified face that has the same attributes as
7247 BASE_FACE except for the font on frame F. If FONT_ID is not
7248 negative, it is an ID number of an already opened font that should
7249 be used by the face. If FONT_ID is negative, the face has no font,
7250 i.e., characters are displayed by empty boxes. */
7252 static struct face
*
7253 realize_non_ascii_face (f
, font_id
, base_face
)
7256 struct face
*base_face
;
7258 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
7260 struct font_info
*font_info
;
7262 face
= (struct face
*) xmalloc (sizeof *face
);
7266 /* Don't try to free the colors copied bitwise from BASE_FACE. */
7267 face
->colors_copied_bitwise_p
= 1;
7269 face
->font_info_id
= font_id
;
7272 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
7273 face
->font
= font_info
->font
;
7274 face
->font_name
= font_info
->full_name
;
7279 face
->font_name
= NULL
;
7284 cache_face (cache
, face
, face
->hash
);
7288 #endif /* HAVE_WINDOW_SYSTEM */
7291 /* Realize the fully-specified face with attributes ATTRS in face
7292 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
7293 the new face doesn't share font with the default face, a fontname
7294 is allocated from the heap and set in `font_name' of the new face,
7295 but it is not yet loaded here. Value is a pointer to the newly
7296 created realized face. */
7298 static struct face
*
7299 realize_x_face (cache
, attrs
)
7300 struct face_cache
*cache
;
7303 #ifdef HAVE_WINDOW_SYSTEM
7304 struct face
*face
, *default_face
;
7306 Lisp_Object stipple
, overline
, strike_through
, box
;
7308 xassert (FRAME_WINDOW_P (cache
->f
));
7310 /* Allocate a new realized face. */
7311 face
= make_realized_face (attrs
);
7312 face
->ascii_face
= face
;
7316 /* Determine the font to use. Most of the time, the font will be
7317 the same as the font of the default face, so try that first. */
7318 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7320 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
7322 face
->font
= default_face
->font
;
7323 face
->font_info_id
= default_face
->font_info_id
;
7324 face
->font_name
= default_face
->font_name
;
7326 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
7330 /* If the face attribute ATTRS specifies a fontset, use it as
7331 the base of a new realized fontset. Otherwise, use the same
7332 base fontset as of the default face. The base determines
7333 registry and encoding of a font. It may also determine
7334 foundry and family. The other fields of font name pattern
7335 are constructed from ATTRS. */
7336 int fontset
= face_fontset (attrs
);
7338 /* If we are realizing the default face, ATTRS should specify a
7339 fontset. In other words, if FONTSET is -1, we are not
7340 realizing the default face, thus the default face should have
7341 already been realized. */
7343 fontset
= default_face
->fontset
;
7346 load_face_font (f
, face
);
7347 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
7350 /* Load colors, and set remaining attributes. */
7352 load_face_colors (f
, face
, attrs
);
7355 box
= attrs
[LFACE_BOX_INDEX
];
7358 /* A simple box of line width 1 drawn in color given by
7360 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7362 face
->box
= FACE_SIMPLE_BOX
;
7363 face
->box_line_width
= 1;
7365 else if (INTEGERP (box
))
7367 /* Simple box of specified line width in foreground color of the
7369 xassert (XINT (box
) != 0);
7370 face
->box
= FACE_SIMPLE_BOX
;
7371 face
->box_line_width
= XINT (box
);
7372 face
->box_color
= face
->foreground
;
7373 face
->box_color_defaulted_p
= 1;
7375 else if (CONSP (box
))
7377 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7378 being one of `raised' or `sunken'. */
7379 face
->box
= FACE_SIMPLE_BOX
;
7380 face
->box_color
= face
->foreground
;
7381 face
->box_color_defaulted_p
= 1;
7382 face
->box_line_width
= 1;
7386 Lisp_Object keyword
, value
;
7388 keyword
= XCAR (box
);
7396 if (EQ (keyword
, QCline_width
))
7398 if (INTEGERP (value
) && XINT (value
) != 0)
7399 face
->box_line_width
= XINT (value
);
7401 else if (EQ (keyword
, QCcolor
))
7403 if (STRINGP (value
))
7405 face
->box_color
= load_color (f
, face
, value
,
7407 face
->use_box_color_for_shadows_p
= 1;
7410 else if (EQ (keyword
, QCstyle
))
7412 if (EQ (value
, Qreleased_button
))
7413 face
->box
= FACE_RAISED_BOX
;
7414 else if (EQ (value
, Qpressed_button
))
7415 face
->box
= FACE_SUNKEN_BOX
;
7420 /* Text underline, overline, strike-through. */
7422 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7424 /* Use default color (same as foreground color). */
7425 face
->underline_p
= 1;
7426 face
->underline_defaulted_p
= 1;
7427 face
->underline_color
= 0;
7429 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7431 /* Use specified color. */
7432 face
->underline_p
= 1;
7433 face
->underline_defaulted_p
= 0;
7434 face
->underline_color
7435 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7436 LFACE_UNDERLINE_INDEX
);
7438 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7440 face
->underline_p
= 0;
7441 face
->underline_defaulted_p
= 0;
7442 face
->underline_color
= 0;
7445 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7446 if (STRINGP (overline
))
7448 face
->overline_color
7449 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7450 LFACE_OVERLINE_INDEX
);
7451 face
->overline_p
= 1;
7453 else if (EQ (overline
, Qt
))
7455 face
->overline_color
= face
->foreground
;
7456 face
->overline_color_defaulted_p
= 1;
7457 face
->overline_p
= 1;
7460 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7461 if (STRINGP (strike_through
))
7463 face
->strike_through_color
7464 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7465 LFACE_STRIKE_THROUGH_INDEX
);
7466 face
->strike_through_p
= 1;
7468 else if (EQ (strike_through
, Qt
))
7470 face
->strike_through_color
= face
->foreground
;
7471 face
->strike_through_color_defaulted_p
= 1;
7472 face
->strike_through_p
= 1;
7475 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7476 if (!NILP (stipple
))
7477 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7480 #endif /* HAVE_WINDOW_SYSTEM */
7484 /* Map a specified color of face FACE on frame F to a tty color index.
7485 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7486 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7487 default foreground/background colors. */
7490 map_tty_color (f
, face
, idx
, defaulted
)
7493 enum lface_attribute_index idx
;
7496 Lisp_Object frame
, color
, def
;
7497 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7498 unsigned long default_pixel
, default_other_pixel
, pixel
;
7500 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7504 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7505 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7509 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7510 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7513 XSETFRAME (frame
, f
);
7514 color
= face
->lface
[idx
];
7518 && CONSP (Vtty_defined_color_alist
)
7519 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7522 /* Associations in tty-defined-color-alist are of the form
7523 (NAME INDEX R G B). We need the INDEX part. */
7524 pixel
= XINT (XCAR (XCDR (def
)));
7527 if (pixel
== default_pixel
&& STRINGP (color
))
7529 pixel
= load_color (f
, face
, color
, idx
);
7531 #if defined (MSDOS) || defined (WINDOWSNT)
7532 /* If the foreground of the default face is the default color,
7533 use the foreground color defined by the frame. */
7535 if (FRAME_MSDOS_P (f
))
7538 if (pixel
== default_pixel
7539 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7542 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7544 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7545 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7548 else if (pixel
== default_other_pixel
)
7551 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7553 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7554 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7560 #endif /* MSDOS or WINDOWSNT */
7564 face
->foreground
= pixel
;
7566 face
->background
= pixel
;
7570 /* Realize the fully-specified face with attributes ATTRS in face
7571 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
7572 Value is a pointer to the newly created realized face. */
7574 static struct face
*
7575 realize_tty_face (cache
, attrs
)
7576 struct face_cache
*cache
;
7581 int face_colors_defaulted
= 0;
7582 struct frame
*f
= cache
->f
;
7584 /* Frame must be a termcap frame. */
7585 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7587 /* Allocate a new realized face. */
7588 face
= make_realized_face (attrs
);
7589 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7591 /* Map face attributes to TTY appearances. We map slant to
7592 dimmed text because we want italic text to appear differently
7593 and because dimmed text is probably used infrequently. */
7594 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7595 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7597 if (weight
> XLFD_WEIGHT_MEDIUM
)
7598 face
->tty_bold_p
= 1;
7599 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7600 face
->tty_dim_p
= 1;
7601 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7602 face
->tty_underline_p
= 1;
7603 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7604 face
->tty_reverse_p
= 1;
7606 /* Map color names to color indices. */
7607 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7608 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7610 /* Swap colors if face is inverse-video. If the colors are taken
7611 from the frame colors, they are already inverted, since the
7612 frame-creation function calls x-handle-reverse-video. */
7613 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7615 unsigned long tem
= face
->foreground
;
7616 face
->foreground
= face
->background
;
7617 face
->background
= tem
;
7620 if (tty_suppress_bold_inverse_default_colors_p
7622 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7623 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7624 face
->tty_bold_p
= 0;
7630 DEFUN ("tty-suppress-bold-inverse-default-colors",
7631 Ftty_suppress_bold_inverse_default_colors
,
7632 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7633 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7634 SUPPRESS non-nil means suppress it.
7635 This affects bold faces on TTYs whose foreground is the default background
7636 color of the display and whose background is the default foreground color.
7637 For such faces, the bold face attribute is ignored if this variable
7640 Lisp_Object suppress
;
7642 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7643 ++face_change_count
;
7649 /***********************************************************************
7651 ***********************************************************************/
7653 /* Return the ID of the face to use to display character CH with face
7654 property PROP on frame F in current_buffer. */
7657 compute_char_face (f
, ch
, prop
)
7664 if (NILP (current_buffer
->enable_multibyte_characters
))
7669 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7670 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7674 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7675 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7676 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7677 merge_face_ref (f
, prop
, attrs
, 1, 0);
7678 face_id
= lookup_face (f
, attrs
);
7684 /* Return the face ID associated with buffer position POS for
7685 displaying ASCII characters. Return in *ENDPTR the position at
7686 which a different face is needed, as far as text properties and
7687 overlays are concerned. W is a window displaying current_buffer.
7689 REGION_BEG, REGION_END delimit the region, so it can be
7692 LIMIT is a position not to scan beyond. That is to limit the time
7693 this function can take.
7695 If MOUSE is non-zero, use the character's mouse-face, not its face.
7697 The face returned is suitable for displaying ASCII characters. */
7700 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7701 endptr
, limit
, mouse
)
7704 int region_beg
, region_end
;
7709 struct frame
*f
= XFRAME (w
->frame
);
7710 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7711 Lisp_Object prop
, position
;
7713 Lisp_Object
*overlay_vec
;
7716 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7717 Lisp_Object limit1
, end
;
7718 struct face
*default_face
;
7720 /* W must display the current buffer. We could write this function
7721 to use the frame and buffer of W, but right now it doesn't. */
7722 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7724 XSETFRAME (frame
, f
);
7725 XSETFASTINT (position
, pos
);
7728 if (pos
< region_beg
&& region_beg
< endpos
)
7729 endpos
= region_beg
;
7731 /* Get the `face' or `mouse_face' text property at POS, and
7732 determine the next position at which the property changes. */
7733 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7734 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7735 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7737 endpos
= XINT (end
);
7739 /* Look at properties from overlays. */
7743 GET_OVERLAYS_AT (pos
, overlay_vec
, noverlays
, &next_overlay
, 0);
7744 if (next_overlay
< endpos
)
7745 endpos
= next_overlay
;
7750 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7752 /* Optimize common cases where we can use the default face. */
7755 && !(pos
>= region_beg
&& pos
< region_end
))
7756 return DEFAULT_FACE_ID
;
7758 /* Begin with attributes from the default face. */
7759 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7761 /* Merge in attributes specified via text properties. */
7763 merge_face_ref (f
, prop
, attrs
, 1, 0);
7765 /* Now merge the overlay data. */
7766 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7767 for (i
= 0; i
< noverlays
; i
++)
7772 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7774 merge_face_ref (f
, prop
, attrs
, 1, 0);
7776 oend
= OVERLAY_END (overlay_vec
[i
]);
7777 oendpos
= OVERLAY_POSITION (oend
);
7778 if (oendpos
< endpos
)
7782 /* If in the region, merge in the region face. */
7783 if (pos
>= region_beg
&& pos
< region_end
)
7785 merge_named_face (f
, Qregion
, attrs
, 0);
7787 if (region_end
< endpos
)
7788 endpos
= region_end
;
7793 /* Look up a realized face with the given face attributes,
7794 or realize a new one for ASCII characters. */
7795 return lookup_face (f
, attrs
);
7799 /* Compute the face at character position POS in Lisp string STRING on
7800 window W, for ASCII characters.
7802 If STRING is an overlay string, it comes from position BUFPOS in
7803 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7804 not an overlay string. W must display the current buffer.
7805 REGION_BEG and REGION_END give the start and end positions of the
7806 region; both are -1 if no region is visible.
7808 BASE_FACE_ID is the id of a face to merge with. For strings coming
7809 from overlays or the `display' property it is the face at BUFPOS.
7811 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7813 Set *ENDPTR to the next position where to check for faces in
7814 STRING; -1 if the face is constant from POS to the end of the
7817 Value is the id of the face to use. The face returned is suitable
7818 for displaying ASCII characters. */
7821 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7822 region_end
, endptr
, base_face_id
, mouse_p
)
7826 int region_beg
, region_end
;
7828 enum face_id base_face_id
;
7831 Lisp_Object prop
, position
, end
, limit
;
7832 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7833 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7834 struct face
*base_face
;
7835 int multibyte_p
= STRING_MULTIBYTE (string
);
7836 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7838 /* Get the value of the face property at the current position within
7839 STRING. Value is nil if there is no face property. */
7840 XSETFASTINT (position
, pos
);
7841 prop
= Fget_text_property (position
, prop_name
, string
);
7843 /* Get the next position at which to check for faces. Value of end
7844 is nil if face is constant all the way to the end of the string.
7845 Otherwise it is a string position where to check faces next.
7846 Limit is the maximum position up to which to check for property
7847 changes in Fnext_single_property_change. Strings are usually
7848 short, so set the limit to the end of the string. */
7849 XSETFASTINT (limit
, SCHARS (string
));
7850 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7852 *endptr
= XFASTINT (end
);
7856 base_face
= FACE_FROM_ID (f
, base_face_id
);
7857 xassert (base_face
);
7859 /* Optimize the default case that there is no face property and we
7860 are not in the region. */
7862 && (base_face_id
!= DEFAULT_FACE_ID
7863 /* BUFPOS <= 0 means STRING is not an overlay string, so
7864 that the region doesn't have to be taken into account. */
7866 || bufpos
< region_beg
7867 || bufpos
>= region_end
)
7869 /* We can't realize faces for different charsets differently
7870 if we don't have fonts, so we can stop here if not working
7871 on a window-system frame. */
7872 || !FRAME_WINDOW_P (f
)
7873 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7874 return base_face
->id
;
7876 /* Begin with attributes from the base face. */
7877 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7879 /* Merge in attributes specified via text properties. */
7881 merge_face_ref (f
, prop
, attrs
, 1, 0);
7883 /* If in the region, merge in the region face. */
7885 && bufpos
>= region_beg
7886 && bufpos
< region_end
)
7887 merge_named_face (f
, Qregion
, attrs
, 0);
7889 /* Look up a realized face with the given face attributes,
7890 or realize a new one for ASCII characters. */
7891 return lookup_face (f
, attrs
);
7895 /* Merge a face into a realized face.
7897 F is frame where faces are (to be) realized.
7899 FACE_NAME is named face to merge.
7901 If FACE_NAME is nil, FACE_ID is face_id of realized face to merge.
7903 If FACE_NAME is t, FACE_ID is lface_id of face to merge.
7905 BASE_FACE_ID is realized face to merge into.
7911 merge_faces (f
, face_name
, face_id
, base_face_id
)
7913 Lisp_Object face_name
;
7914 int face_id
, base_face_id
;
7916 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7917 struct face
*base_face
;
7919 base_face
= FACE_FROM_ID (f
, base_face_id
);
7921 return base_face_id
;
7923 if (EQ (face_name
, Qt
))
7925 if (face_id
< 0 || face_id
>= lface_id_to_name_size
)
7926 return base_face_id
;
7927 face_name
= lface_id_to_name
[face_id
];
7928 face_id
= lookup_derived_face (f
, face_name
, base_face_id
);
7931 return base_face_id
;
7934 /* Begin with attributes from the base face. */
7935 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7937 if (!NILP (face_name
))
7939 if (!merge_named_face (f
, face_name
, attrs
, 0))
7940 return base_face_id
;
7946 return base_face_id
;
7947 face
= FACE_FROM_ID (f
, face_id
);
7949 return base_face_id
;
7950 merge_face_vectors (f
, face
->lface
, attrs
, 0);
7953 /* Look up a realized face with the given face attributes,
7954 or realize a new one for ASCII characters. */
7955 return lookup_face (f
, attrs
);
7959 /***********************************************************************
7961 ***********************************************************************/
7965 /* Print the contents of the realized face FACE to stderr. */
7968 dump_realized_face (face
)
7971 fprintf (stderr
, "ID: %d\n", face
->id
);
7972 #ifdef HAVE_X_WINDOWS
7973 fprintf (stderr
, "gc: %ld\n", (long) face
->gc
);
7975 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7977 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7978 fprintf (stderr
, "background: 0x%lx (%s)\n",
7980 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7981 fprintf (stderr
, "font_name: %s (%s)\n",
7983 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7984 #ifdef HAVE_X_WINDOWS
7985 fprintf (stderr
, "font = %p\n", face
->font
);
7987 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7988 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7989 fprintf (stderr
, "underline: %d (%s)\n",
7991 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7992 fprintf (stderr
, "hash: %d\n", face
->hash
);
7996 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
8004 fprintf (stderr
, "font selection order: ");
8005 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
8006 fprintf (stderr
, "%d ", font_sort_order
[i
]);
8007 fprintf (stderr
, "\n");
8009 fprintf (stderr
, "alternative fonts: ");
8010 debug_print (Vface_alternative_font_family_alist
);
8011 fprintf (stderr
, "\n");
8013 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
8014 Fdump_face (make_number (i
));
8020 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
8022 error ("Not a valid face");
8023 dump_realized_face (face
);
8030 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
8031 0, 0, 0, doc
: /* */)
8034 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
8035 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
8036 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
8040 #endif /* GLYPH_DEBUG != 0 */
8044 /***********************************************************************
8046 ***********************************************************************/
8051 Qface
= intern ("face");
8053 Qface_no_inherit
= intern ("face-no-inherit");
8054 staticpro (&Qface_no_inherit
);
8055 Qbitmap_spec_p
= intern ("bitmap-spec-p");
8056 staticpro (&Qbitmap_spec_p
);
8057 Qframe_update_face_colors
= intern ("frame-update-face-colors");
8058 staticpro (&Qframe_update_face_colors
);
8060 /* Lisp face attribute keywords. */
8061 QCfamily
= intern (":family");
8062 staticpro (&QCfamily
);
8063 QCheight
= intern (":height");
8064 staticpro (&QCheight
);
8065 QCweight
= intern (":weight");
8066 staticpro (&QCweight
);
8067 QCslant
= intern (":slant");
8068 staticpro (&QCslant
);
8069 QCunderline
= intern (":underline");
8070 staticpro (&QCunderline
);
8071 QCinverse_video
= intern (":inverse-video");
8072 staticpro (&QCinverse_video
);
8073 QCreverse_video
= intern (":reverse-video");
8074 staticpro (&QCreverse_video
);
8075 QCforeground
= intern (":foreground");
8076 staticpro (&QCforeground
);
8077 QCbackground
= intern (":background");
8078 staticpro (&QCbackground
);
8079 QCstipple
= intern (":stipple");;
8080 staticpro (&QCstipple
);
8081 QCwidth
= intern (":width");
8082 staticpro (&QCwidth
);
8083 QCfont
= intern (":font");
8084 staticpro (&QCfont
);
8085 QCfontset
= intern (":fontset");
8086 staticpro (&QCfontset
);
8087 QCbold
= intern (":bold");
8088 staticpro (&QCbold
);
8089 QCitalic
= intern (":italic");
8090 staticpro (&QCitalic
);
8091 QCoverline
= intern (":overline");
8092 staticpro (&QCoverline
);
8093 QCstrike_through
= intern (":strike-through");
8094 staticpro (&QCstrike_through
);
8095 QCbox
= intern (":box");
8097 QCinherit
= intern (":inherit");
8098 staticpro (&QCinherit
);
8100 /* Symbols used for Lisp face attribute values. */
8101 QCcolor
= intern (":color");
8102 staticpro (&QCcolor
);
8103 QCline_width
= intern (":line-width");
8104 staticpro (&QCline_width
);
8105 QCstyle
= intern (":style");
8106 staticpro (&QCstyle
);
8107 Qreleased_button
= intern ("released-button");
8108 staticpro (&Qreleased_button
);
8109 Qpressed_button
= intern ("pressed-button");
8110 staticpro (&Qpressed_button
);
8111 Qnormal
= intern ("normal");
8112 staticpro (&Qnormal
);
8113 Qultra_light
= intern ("ultra-light");
8114 staticpro (&Qultra_light
);
8115 Qextra_light
= intern ("extra-light");
8116 staticpro (&Qextra_light
);
8117 Qlight
= intern ("light");
8118 staticpro (&Qlight
);
8119 Qsemi_light
= intern ("semi-light");
8120 staticpro (&Qsemi_light
);
8121 Qsemi_bold
= intern ("semi-bold");
8122 staticpro (&Qsemi_bold
);
8123 Qbold
= intern ("bold");
8125 Qextra_bold
= intern ("extra-bold");
8126 staticpro (&Qextra_bold
);
8127 Qultra_bold
= intern ("ultra-bold");
8128 staticpro (&Qultra_bold
);
8129 Qoblique
= intern ("oblique");
8130 staticpro (&Qoblique
);
8131 Qitalic
= intern ("italic");
8132 staticpro (&Qitalic
);
8133 Qreverse_oblique
= intern ("reverse-oblique");
8134 staticpro (&Qreverse_oblique
);
8135 Qreverse_italic
= intern ("reverse-italic");
8136 staticpro (&Qreverse_italic
);
8137 Qultra_condensed
= intern ("ultra-condensed");
8138 staticpro (&Qultra_condensed
);
8139 Qextra_condensed
= intern ("extra-condensed");
8140 staticpro (&Qextra_condensed
);
8141 Qcondensed
= intern ("condensed");
8142 staticpro (&Qcondensed
);
8143 Qsemi_condensed
= intern ("semi-condensed");
8144 staticpro (&Qsemi_condensed
);
8145 Qsemi_expanded
= intern ("semi-expanded");
8146 staticpro (&Qsemi_expanded
);
8147 Qexpanded
= intern ("expanded");
8148 staticpro (&Qexpanded
);
8149 Qextra_expanded
= intern ("extra-expanded");
8150 staticpro (&Qextra_expanded
);
8151 Qultra_expanded
= intern ("ultra-expanded");
8152 staticpro (&Qultra_expanded
);
8153 Qbackground_color
= intern ("background-color");
8154 staticpro (&Qbackground_color
);
8155 Qforeground_color
= intern ("foreground-color");
8156 staticpro (&Qforeground_color
);
8157 Qunspecified
= intern ("unspecified");
8158 staticpro (&Qunspecified
);
8160 Qface_alias
= intern ("face-alias");
8161 staticpro (&Qface_alias
);
8162 Qdefault
= intern ("default");
8163 staticpro (&Qdefault
);
8164 Qtool_bar
= intern ("tool-bar");
8165 staticpro (&Qtool_bar
);
8166 Qregion
= intern ("region");
8167 staticpro (&Qregion
);
8168 Qfringe
= intern ("fringe");
8169 staticpro (&Qfringe
);
8170 Qheader_line
= intern ("header-line");
8171 staticpro (&Qheader_line
);
8172 Qscroll_bar
= intern ("scroll-bar");
8173 staticpro (&Qscroll_bar
);
8174 Qmenu
= intern ("menu");
8176 Qcursor
= intern ("cursor");
8177 staticpro (&Qcursor
);
8178 Qborder
= intern ("border");
8179 staticpro (&Qborder
);
8180 Qmouse
= intern ("mouse");
8181 staticpro (&Qmouse
);
8182 Qmode_line_inactive
= intern ("mode-line-inactive");
8183 staticpro (&Qmode_line_inactive
);
8184 Qtty_color_desc
= intern ("tty-color-desc");
8185 staticpro (&Qtty_color_desc
);
8186 Qtty_color_standard_values
= intern ("tty-color-standard-values");
8187 staticpro (&Qtty_color_standard_values
);
8188 Qtty_color_by_index
= intern ("tty-color-by-index");
8189 staticpro (&Qtty_color_by_index
);
8190 Qtty_color_alist
= intern ("tty-color-alist");
8191 staticpro (&Qtty_color_alist
);
8192 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
8193 staticpro (&Qscalable_fonts_allowed
);
8195 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
8196 staticpro (&Vparam_value_alist
);
8197 Vface_alternative_font_family_alist
= Qnil
;
8198 staticpro (&Vface_alternative_font_family_alist
);
8199 Vface_alternative_font_registry_alist
= Qnil
;
8200 staticpro (&Vface_alternative_font_registry_alist
);
8202 defsubr (&Sinternal_make_lisp_face
);
8203 defsubr (&Sinternal_lisp_face_p
);
8204 defsubr (&Sinternal_set_lisp_face_attribute
);
8205 #ifdef HAVE_WINDOW_SYSTEM
8206 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
8208 defsubr (&Scolor_gray_p
);
8209 defsubr (&Scolor_supported_p
);
8210 defsubr (&Sface_attribute_relative_p
);
8211 defsubr (&Smerge_face_attribute
);
8212 defsubr (&Sinternal_get_lisp_face_attribute
);
8213 defsubr (&Sinternal_lisp_face_attribute_values
);
8214 defsubr (&Sinternal_lisp_face_equal_p
);
8215 defsubr (&Sinternal_lisp_face_empty_p
);
8216 defsubr (&Sinternal_copy_lisp_face
);
8217 defsubr (&Sinternal_merge_in_global_face
);
8218 defsubr (&Sface_font
);
8219 defsubr (&Sframe_face_alist
);
8220 defsubr (&Sdisplay_supports_face_attributes_p
);
8221 defsubr (&Scolor_distance
);
8222 defsubr (&Sinternal_set_font_selection_order
);
8223 defsubr (&Sinternal_set_alternative_font_family_alist
);
8224 defsubr (&Sinternal_set_alternative_font_registry_alist
);
8225 defsubr (&Sface_attributes_as_vector
);
8227 defsubr (&Sdump_face
);
8228 defsubr (&Sshow_face_resources
);
8229 #endif /* GLYPH_DEBUG */
8230 defsubr (&Sclear_face_cache
);
8231 defsubr (&Stty_suppress_bold_inverse_default_colors
);
8233 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
8234 defsubr (&Sdump_colors
);
8237 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
8238 doc
: /* *Limit for font matching.
8239 If an integer > 0, font matching functions won't load more than
8240 that number of fonts when searching for a matching font. */);
8241 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
8243 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
8244 doc
: /* List of global face definitions (for internal use only.) */);
8245 Vface_new_frame_defaults
= Qnil
;
8247 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
8248 doc
: /* *Default stipple pattern used on monochrome displays.
8249 This stipple pattern is used on monochrome displays
8250 instead of shades of gray for a face background color.
8251 See `set-face-stipple' for possible values for this variable. */);
8252 Vface_default_stipple
= build_string ("gray3");
8254 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
8255 doc
: /* An alist of defined terminal colors and their RGB values. */);
8256 Vtty_defined_color_alist
= Qnil
;
8258 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
8259 doc
: /* Allowed scalable fonts.
8260 A value of nil means don't allow any scalable fonts.
8261 A value of t means allow any scalable font.
8262 Otherwise, value must be a list of regular expressions. A font may be
8263 scaled if its name matches a regular expression in the list.
8264 Note that if value is nil, a scalable font might still be used, if no
8265 other font of the appropriate family and registry is available. */);
8266 Vscalable_fonts_allowed
= Qnil
;
8268 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
8269 doc
: /* List of ignored fonts.
8270 Each element is a regular expression that matches names of fonts to
8272 Vface_ignored_fonts
= Qnil
;
8274 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
8275 doc
: /* Alist of fonts vs the rescaling factors.
8276 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
8277 FONT-NAME-PATTERN is a regular expression matching a font name, and
8278 RESCALE-RATIO is a floating point number to specify how much larger
8279 \(or smaller) font we should use. For instance, if a face requests
8280 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
8281 Vface_font_rescale_alist
= Qnil
;
8283 #ifdef HAVE_WINDOW_SYSTEM
8284 defsubr (&Sbitmap_spec_p
);
8285 defsubr (&Sx_list_fonts
);
8286 defsubr (&Sinternal_face_x_get_resource
);
8287 defsubr (&Sx_family_fonts
);
8288 defsubr (&Sx_font_family_list
);
8289 #endif /* HAVE_WINDOW_SYSTEM */
8292 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
8293 (do not change this comment) */