1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2003
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. */
197 #include <sys/types.h>
198 #include <sys/stat.h>
201 #include "character.h"
203 #include "keyboard.h"
206 #ifdef HAVE_WINDOW_SYSTEM
208 #endif /* HAVE_WINDOW_SYSTEM */
210 #ifdef HAVE_X_WINDOWS
214 #include <Xm/XmStrDefs.h>
215 #endif /* USE_MOTIF */
216 #endif /* HAVE_X_WINDOWS */
225 /* Redefine X specifics to W32 equivalents to avoid cluttering the
226 code with #ifdef blocks. */
227 #undef FRAME_X_DISPLAY_INFO
228 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
229 #define x_display_info w32_display_info
230 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
231 #define check_x check_w32
232 #define x_list_fonts w32_list_fonts
233 #define GCGraphicsExposures 0
234 #endif /* WINDOWSNT */
238 #define x_display_info mac_display_info
239 #define check_x check_mac
243 #include "dispextern.h"
244 #include "blockinput.h"
246 #include "intervals.h"
248 #ifdef HAVE_X_WINDOWS
250 /* Compensate for a bug in Xos.h on some systems, on which it requires
251 time.h. On some such systems, Xos.h tries to redefine struct
252 timeval and struct timezone if USG is #defined while it is
255 #ifdef XOS_NEEDS_TIME_H
261 #else /* not XOS_NEEDS_TIME_H */
263 #endif /* not XOS_NEEDS_TIME_H */
265 #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 /* Error symbol for wrong_type_argument in load_pixmap. */
394 Lisp_Object Qbitmap_spec_p
;
396 /* Alist of global face definitions. Each element is of the form
397 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
398 is a Lisp vector of face attributes. These faces are used
399 to initialize faces for new frames. */
401 Lisp_Object Vface_new_frame_defaults
;
403 /* The next ID to assign to Lisp faces. */
405 static int next_lface_id
;
407 /* A vector mapping Lisp face Id's to face names. */
409 static Lisp_Object
*lface_id_to_name
;
410 static int lface_id_to_name_size
;
412 /* TTY color-related functions (defined in tty-colors.el). */
414 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
416 /* The name of the function used to compute colors on TTYs. */
418 Lisp_Object Qtty_color_alist
;
420 /* An alist of defined terminal colors and their RGB values. */
422 Lisp_Object Vtty_defined_color_alist
;
424 /* Counter for calls to clear_face_cache. If this counter reaches
425 CLEAR_FONT_TABLE_COUNT, and a frame has more than
426 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
428 static int clear_font_table_count
;
429 #define CLEAR_FONT_TABLE_COUNT 100
430 #define CLEAR_FONT_TABLE_NFONTS 10
432 /* Non-zero means face attributes have been changed since the last
433 redisplay. Used in redisplay_internal. */
435 int face_change_count
;
437 /* Non-zero means don't display bold text if a face's foreground
438 and background colors are the inverse of the default colors of the
439 display. This is a kluge to suppress `bold black' foreground text
440 which is hard to read on an LCD monitor. */
442 int tty_suppress_bold_inverse_default_colors_p
;
444 /* A list of the form `((x . y))' used to avoid consing in
445 Finternal_set_lisp_face_attribute. */
447 static Lisp_Object Vparam_value_alist
;
449 /* The total number of colors currently allocated. */
452 static int ncolors_allocated
;
453 static int npixmaps_allocated
;
457 /* Non-zero means the definition of the `menu' face for new frames has
460 int menu_face_changed_default
;
463 /* Function prototypes. */
468 static void map_tty_color
P_ ((struct frame
*, struct face
*,
469 enum lface_attribute_index
, int *));
470 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
471 static int may_use_scalable_font_p
P_ ((const char *));
472 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
473 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
475 static int x_face_list_fonts
P_ ((struct frame
*, char *,
476 struct font_name
**, int, int));
477 static int font_scalable_p
P_ ((struct font_name
*));
478 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
479 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
480 static unsigned char *xstrlwr
P_ ((unsigned char *));
481 static void signal_error
P_ ((char *, Lisp_Object
));
482 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
483 static void load_face_font
P_ ((struct frame
*, struct face
*));
484 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
485 static void free_face_colors
P_ ((struct frame
*, struct face
*));
486 static int face_color_gray_p
P_ ((struct frame
*, char *));
487 static char *build_font_name
P_ ((struct font_name
*));
488 static void free_font_names
P_ ((struct font_name
*, int));
489 static int sorted_font_list
P_ ((struct frame
*, char *,
490 int (*cmpfn
) P_ ((const void *, const void *)),
491 struct font_name
**));
492 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
493 Lisp_Object
, struct font_name
**));
494 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
495 Lisp_Object
, struct font_name
**));
496 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
497 Lisp_Object
, Lisp_Object
, struct font_name
**));
498 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
499 Lisp_Object
, struct font_name
**));
500 static int cmp_font_names
P_ ((const void *, const void *));
501 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
503 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
505 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
506 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
507 static int realize_basic_faces
P_ ((struct frame
*));
508 static int realize_default_face
P_ ((struct frame
*));
509 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
510 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
511 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
512 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
513 static unsigned lface_hash
P_ ((Lisp_Object
*));
514 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
515 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
516 static void clear_face_gcs
P_ ((struct face_cache
*));
517 static void free_face_cache
P_ ((struct face_cache
*));
518 static int face_numeric_weight
P_ ((Lisp_Object
));
519 static int face_numeric_slant
P_ ((Lisp_Object
));
520 static int face_numeric_swidth
P_ ((Lisp_Object
));
521 static int face_fontset
P_ ((Lisp_Object
*));
522 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
523 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
524 Lisp_Object
*, Lisp_Object
));
525 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
527 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
528 Lisp_Object
, int, int));
529 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
530 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
531 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
532 struct font_name
*, int, int, int *));
533 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
534 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
535 static int xlfd_numeric_slant
P_ ((struct font_name
*));
536 static int xlfd_numeric_weight
P_ ((struct font_name
*));
537 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
538 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
539 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
540 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
541 static int xlfd_fixed_p
P_ ((struct font_name
*));
542 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
544 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
545 struct font_name
*, int,
547 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
548 struct font_name
*, int));
550 #ifdef HAVE_WINDOW_SYSTEM
552 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
553 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
554 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
555 int (*cmpfn
) P_ ((const void *, const void *))));
556 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
557 static void x_free_gc
P_ ((struct frame
*, GC
));
558 static void clear_font_table
P_ ((struct x_display_info
*));
561 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
562 #endif /* WINDOWSNT */
565 static void x_update_menu_appearance
P_ ((struct frame
*));
567 extern void free_frame_menubar
P_ ((struct frame
*));
568 #endif /* USE_X_TOOLKIT */
570 #endif /* HAVE_WINDOW_SYSTEM */
573 /***********************************************************************
575 ***********************************************************************/
577 #ifdef HAVE_X_WINDOWS
579 #ifdef DEBUG_X_COLORS
581 /* The following is a poor mans infrastructure for debugging X color
582 allocation problems on displays with PseudoColor-8. Some X servers
583 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
584 color reference counts completely so that they don't signal an
585 error when a color is freed whose reference count is already 0.
586 Other X servers do. To help me debug this, the following code
587 implements a simple reference counting schema of its own, for a
588 single display/screen. --gerd. */
590 /* Reference counts for pixel colors. */
592 int color_count
[256];
594 /* Register color PIXEL as allocated. */
597 register_color (pixel
)
600 xassert (pixel
< 256);
601 ++color_count
[pixel
];
605 /* Register color PIXEL as deallocated. */
608 unregister_color (pixel
)
611 xassert (pixel
< 256);
612 if (color_count
[pixel
] > 0)
613 --color_count
[pixel
];
619 /* Register N colors from PIXELS as deallocated. */
622 unregister_colors (pixels
, n
)
623 unsigned long *pixels
;
627 for (i
= 0; i
< n
; ++i
)
628 unregister_color (pixels
[i
]);
632 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
633 doc
: /* Dump currently allocated colors to stderr. */)
638 fputc ('\n', stderr
);
640 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
643 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
646 fputc ('\n', stderr
);
648 fputc ('\t', stderr
);
652 fputc ('\n', stderr
);
656 #endif /* DEBUG_X_COLORS */
659 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
660 color values. Interrupt input must be blocked when this function
664 x_free_colors (f
, pixels
, npixels
)
666 unsigned long *pixels
;
669 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
671 /* If display has an immutable color map, freeing colors is not
672 necessary and some servers don't allow it. So don't do it. */
673 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
675 #ifdef DEBUG_X_COLORS
676 unregister_colors (pixels
, npixels
);
678 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
684 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
685 color values. Interrupt input must be blocked when this function
689 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
693 unsigned long *pixels
;
696 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
697 int class = dpyinfo
->visual
->class;
699 /* If display has an immutable color map, freeing colors is not
700 necessary and some servers don't allow it. So don't do it. */
701 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
703 #ifdef DEBUG_X_COLORS
704 unregister_colors (pixels
, npixels
);
706 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
711 /* Create and return a GC for use on frame F. GC values and mask
712 are given by XGCV and MASK. */
715 x_create_gc (f
, mask
, xgcv
)
722 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
729 /* Free GC which was used on frame F. */
737 xassert (--ngcs
>= 0);
738 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
742 #endif /* HAVE_X_WINDOWS */
745 /* W32 emulation of GCs */
748 x_create_gc (f
, mask
, xgcv
)
755 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
762 /* Free GC which was used on frame F. */
770 xassert (--ngcs
>= 0);
775 #endif /* WINDOWSNT */
778 /* Mac OS emulation of GCs */
780 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
783 x_create_gc (f
, mask
, xgcv
)
789 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
798 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
803 /* Like stricmp. Used to compare parts of font names which are in
808 const unsigned char *s1
, *s2
;
812 unsigned char c1
= tolower (*s1
);
813 unsigned char c2
= tolower (*s2
);
815 return c1
< c2
? -1 : 1;
820 return *s2
== 0 ? 0 : -1;
825 /* Like strlwr, which might not always be available. */
827 static unsigned char *
831 unsigned char *p
= s
;
840 /* Signal `error' with message S, and additional argument ARG. */
843 signal_error (s
, arg
)
847 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
851 /* If FRAME is nil, return a pointer to the selected frame.
852 Otherwise, check that FRAME is a live frame, and return a pointer
853 to it. NPARAM is the parameter number of FRAME, for
854 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
855 Lisp function definitions. */
857 static INLINE
struct frame
*
858 frame_or_selected_frame (frame
, nparam
)
863 frame
= selected_frame
;
865 CHECK_LIVE_FRAME (frame
);
866 return XFRAME (frame
);
870 /***********************************************************************
872 ***********************************************************************/
874 /* Initialize face cache and basic faces for frame F. */
880 /* Make a face cache, if F doesn't have one. */
881 if (FRAME_FACE_CACHE (f
) == NULL
)
882 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
884 #ifdef HAVE_WINDOW_SYSTEM
885 /* Make the image cache. */
886 if (FRAME_WINDOW_P (f
))
888 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
889 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
890 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
892 #endif /* HAVE_WINDOW_SYSTEM */
894 /* Realize basic faces. Must have enough information in frame
895 parameters to realize basic faces at this point. */
896 #ifdef HAVE_X_WINDOWS
897 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
900 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
903 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
905 if (!realize_basic_faces (f
))
910 /* Free face cache of frame F. Called from Fdelete_frame. */
916 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
920 free_face_cache (face_cache
);
921 FRAME_FACE_CACHE (f
) = NULL
;
924 #ifdef HAVE_WINDOW_SYSTEM
925 if (FRAME_WINDOW_P (f
))
927 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
930 --image_cache
->refcount
;
931 if (image_cache
->refcount
== 0)
932 free_image_cache (f
);
935 #endif /* HAVE_WINDOW_SYSTEM */
939 /* Clear face caches, and recompute basic faces for frame F. Call
940 this after changing frame parameters on which those faces depend,
941 or when realized faces have been freed due to changing attributes
945 recompute_basic_faces (f
)
948 if (FRAME_FACE_CACHE (f
))
950 clear_face_cache (0);
951 if (!realize_basic_faces (f
))
957 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
958 try to free unused fonts, too. */
961 clear_face_cache (clear_fonts_p
)
964 #ifdef HAVE_WINDOW_SYSTEM
965 Lisp_Object tail
, frame
;
969 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
971 struct x_display_info
*dpyinfo
;
973 /* Fonts are common for frames on one display, i.e. on
975 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
976 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
977 clear_font_table (dpyinfo
);
979 /* From time to time see if we can unload some fonts. This also
980 frees all realized faces on all frames. Fonts needed by
981 faces will be loaded again when faces are realized again. */
982 clear_font_table_count
= 0;
984 FOR_EACH_FRAME (tail
, frame
)
986 struct frame
*f
= XFRAME (frame
);
987 if (FRAME_WINDOW_P (f
)
988 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
989 free_all_realized_faces (frame
);
994 /* Clear GCs of realized faces. */
995 FOR_EACH_FRAME (tail
, frame
)
998 if (FRAME_WINDOW_P (f
))
1000 clear_face_gcs (FRAME_FACE_CACHE (f
));
1001 clear_image_cache (f
, 0);
1005 #endif /* HAVE_WINDOW_SYSTEM */
1009 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1010 doc
: /* Clear face caches on all frames.
1011 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1013 Lisp_Object thoroughly
;
1015 clear_face_cache (!NILP (thoroughly
));
1016 ++face_change_count
;
1017 ++windows_or_buffers_changed
;
1023 #ifdef HAVE_WINDOW_SYSTEM
1026 /* Remove fonts from the font table of DPYINFO except for the default
1027 ASCII fonts of frames on that display. Called from clear_face_cache
1028 from time to time. */
1031 clear_font_table (dpyinfo
)
1032 struct x_display_info
*dpyinfo
;
1036 /* Free those fonts that are not used by frames on DPYINFO. */
1037 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1039 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1040 Lisp_Object tail
, frame
;
1042 /* Check if slot is already free. */
1043 if (font_info
->name
== NULL
)
1046 /* Don't free a default font of some frame. */
1047 FOR_EACH_FRAME (tail
, frame
)
1049 struct frame
*f
= XFRAME (frame
);
1050 if (FRAME_WINDOW_P (f
)
1051 && font_info
->font
== FRAME_FONT (f
))
1059 if (font_info
->full_name
!= font_info
->name
)
1060 xfree (font_info
->full_name
);
1061 xfree (font_info
->name
);
1063 /* Free the font. */
1065 #ifdef HAVE_X_WINDOWS
1066 XFreeFont (dpyinfo
->display
, font_info
->font
);
1069 w32_unload_font (dpyinfo
, font_info
->font
);
1073 /* Mark font table slot free. */
1074 font_info
->font
= NULL
;
1075 font_info
->name
= font_info
->full_name
= NULL
;
1079 #endif /* HAVE_WINDOW_SYSTEM */
1083 /***********************************************************************
1085 ***********************************************************************/
1087 #ifdef HAVE_WINDOW_SYSTEM
1089 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1090 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1091 A bitmap specification is either a string, a file name, or a list
1092 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1093 HEIGHT is its height, and DATA is a string containing the bits of
1094 the pixmap. Bits are stored row by row, each row occupies
1095 \(WIDTH + 7)/8 bytes. */)
1101 if (STRINGP (object
))
1102 /* If OBJECT is a string, it's a file name. */
1104 else if (CONSP (object
))
1106 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1107 HEIGHT must be integers > 0, and DATA must be string large
1108 enough to hold a bitmap of the specified size. */
1109 Lisp_Object width
, height
, data
;
1111 height
= width
= data
= Qnil
;
1115 width
= XCAR (object
);
1116 object
= XCDR (object
);
1119 height
= XCAR (object
);
1120 object
= XCDR (object
);
1122 data
= XCAR (object
);
1126 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1128 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1130 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1135 return pixmap_p
? Qt
: Qnil
;
1139 /* Load a bitmap according to NAME (which is either a file name or a
1140 pixmap spec) for use on frame F. Value is the bitmap_id (see
1141 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1142 bitmap cannot be loaded, display a message saying so, and return
1143 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1144 if these pointers are not null. */
1147 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1150 unsigned int *w_ptr
, *h_ptr
;
1158 tem
= Fbitmap_spec_p (name
);
1160 wrong_type_argument (Qbitmap_spec_p
, name
);
1165 /* Decode a bitmap spec into a bitmap. */
1170 w
= XINT (Fcar (name
));
1171 h
= XINT (Fcar (Fcdr (name
)));
1172 bits
= Fcar (Fcdr (Fcdr (name
)));
1174 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1179 /* It must be a string -- a file name. */
1180 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1186 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1197 ++npixmaps_allocated
;
1200 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1203 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1209 #endif /* HAVE_WINDOW_SYSTEM */
1213 /***********************************************************************
1215 ***********************************************************************/
1217 #ifdef HAVE_WINDOW_SYSTEM
1219 /* Load font of face FACE which is used on frame F to display ASCII
1220 characters. The name of the font to load is determined by lface. */
1223 load_face_font (f
, face
)
1227 struct font_info
*font_info
= NULL
;
1229 int needs_overstrike
;
1231 face
->font_info_id
= -1;
1233 face
->font_name
= NULL
;
1235 font_name
= choose_face_font (f
, face
->lface
, Qnil
, &needs_overstrike
);
1240 font_info
= FS_LOAD_FONT (f
, font_name
);
1245 face
->font_info_id
= font_info
->font_idx
;
1246 face
->font
= font_info
->font
;
1247 face
->font_name
= font_info
->full_name
;
1248 face
->overstrike
= needs_overstrike
;
1251 x_free_gc (f
, face
->gc
);
1256 add_to_log ("Unable to load font %s",
1257 build_string (font_name
), Qnil
);
1261 #endif /* HAVE_WINDOW_SYSTEM */
1265 /***********************************************************************
1267 ***********************************************************************/
1269 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1270 RGB_LIST should contain (at least) 3 lisp integers.
1271 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1274 parse_rgb_list (rgb_list
, color
)
1275 Lisp_Object rgb_list
;
1278 #define PARSE_RGB_LIST_FIELD(field) \
1279 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1281 color->field = XINT (XCAR (rgb_list)); \
1282 rgb_list = XCDR (rgb_list); \
1287 PARSE_RGB_LIST_FIELD (red
);
1288 PARSE_RGB_LIST_FIELD (green
);
1289 PARSE_RGB_LIST_FIELD (blue
);
1295 /* Lookup on frame F the color described by the lisp string COLOR.
1296 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1297 non-zero, then the `standard' definition of the same color is
1301 tty_lookup_color (f
, color
, tty_color
, std_color
)
1304 XColor
*tty_color
, *std_color
;
1306 Lisp_Object frame
, color_desc
;
1308 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1311 XSETFRAME (frame
, f
);
1313 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1314 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1318 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1321 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1323 rgb
= XCDR (XCDR (color_desc
));
1324 if (! parse_rgb_list (rgb
, tty_color
))
1327 /* Should we fill in STD_COLOR too? */
1330 /* Default STD_COLOR to the same as TTY_COLOR. */
1331 *std_color
= *tty_color
;
1333 /* Do a quick check to see if the returned descriptor is
1334 actually _exactly_ equal to COLOR, otherwise we have to
1335 lookup STD_COLOR separately. If it's impossible to lookup
1336 a standard color, we just give up and use TTY_COLOR. */
1337 if ((!STRINGP (XCAR (color_desc
))
1338 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1339 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1341 /* Look up STD_COLOR separately. */
1342 rgb
= call1 (Qtty_color_standard_values
, color
);
1343 if (! parse_rgb_list (rgb
, std_color
))
1350 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1351 /* We were called early during startup, and the colors are not
1352 yet set up in tty-defined-color-alist. Don't return a failure
1353 indication, since this produces the annoying "Unable to
1354 load color" messages in the *Messages* buffer. */
1357 /* tty-color-desc seems to have returned a bad value. */
1361 /* A version of defined_color for non-X frames. */
1364 tty_defined_color (f
, color_name
, color_def
, alloc
)
1373 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1375 color_def
->blue
= 0;
1376 color_def
->green
= 0;
1379 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, NULL
);
1381 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1383 if (strcmp (color_name
, "unspecified-fg") == 0)
1384 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1385 else if (strcmp (color_name
, "unspecified-bg") == 0)
1386 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1389 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1396 /* Decide if color named COLOR_NAME is valid for the display
1397 associated with the frame F; if so, return the rgb values in
1398 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1400 This does the right thing for any type of frame. */
1403 defined_color (f
, color_name
, color_def
, alloc
)
1409 if (!FRAME_WINDOW_P (f
))
1410 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1411 #ifdef HAVE_X_WINDOWS
1412 else if (FRAME_X_P (f
))
1413 return x_defined_color (f
, color_name
, color_def
, alloc
);
1416 else if (FRAME_W32_P (f
))
1417 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1420 else if (FRAME_MAC_P (f
))
1421 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1428 /* Given the index IDX of a tty color on frame F, return its name, a
1432 tty_color_name (f
, idx
)
1436 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1439 Lisp_Object coldesc
;
1441 XSETFRAME (frame
, f
);
1442 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1444 if (!NILP (coldesc
))
1445 return XCAR (coldesc
);
1448 /* We can have an MSDOG frame under -nw for a short window of
1449 opportunity before internal_terminal_init is called. DTRT. */
1450 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1451 return msdos_stdcolor_name (idx
);
1454 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1455 return build_string (unspecified_fg
);
1456 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1457 return build_string (unspecified_bg
);
1460 return vga_stdcolor_name (idx
);
1463 return Qunspecified
;
1467 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1468 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1471 face_color_gray_p (f
, color_name
)
1478 if (defined_color (f
, color_name
, &color
, 0))
1479 gray_p
= ((abs (color
.red
- color
.green
)
1480 < max (color
.red
, color
.green
) / 20)
1481 && (abs (color
.green
- color
.blue
)
1482 < max (color
.green
, color
.blue
) / 20)
1483 && (abs (color
.blue
- color
.red
)
1484 < max (color
.blue
, color
.red
) / 20));
1492 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1493 BACKGROUND_P non-zero means the color will be used as background
1497 face_color_supported_p (f
, color_name
, background_p
)
1505 XSETFRAME (frame
, f
);
1506 return (FRAME_WINDOW_P (f
)
1507 ? (!NILP (Fxw_display_color_p (frame
))
1508 || xstricmp (color_name
, "black") == 0
1509 || xstricmp (color_name
, "white") == 0
1511 && face_color_gray_p (f
, color_name
))
1512 || (!NILP (Fx_display_grayscale_p (frame
))
1513 && face_color_gray_p (f
, color_name
)))
1514 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1518 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1519 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1520 FRAME specifies the frame and thus the display for interpreting COLOR.
1521 If FRAME is nil or omitted, use the selected frame. */)
1523 Lisp_Object color
, frame
;
1527 CHECK_FRAME (frame
);
1528 CHECK_STRING (color
);
1530 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1534 DEFUN ("color-supported-p", Fcolor_supported_p
,
1535 Scolor_supported_p
, 1, 3, 0,
1536 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1537 BACKGROUND-P non-nil means COLOR is used as a background.
1538 If FRAME is nil or omitted, use the selected frame.
1539 COLOR must be a valid color name. */)
1540 (color
, frame
, background_p
)
1541 Lisp_Object frame
, color
, background_p
;
1545 CHECK_FRAME (frame
);
1546 CHECK_STRING (color
);
1548 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1554 /* Load color with name NAME for use by face FACE on frame F.
1555 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1556 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1557 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1558 pixel color. If color cannot be loaded, display a message, and
1559 return the foreground, background or underline color of F, but
1560 record that fact in flags of the face so that we don't try to free
1564 load_color (f
, face
, name
, target_index
)
1568 enum lface_attribute_index target_index
;
1572 xassert (STRINGP (name
));
1573 xassert (target_index
== LFACE_FOREGROUND_INDEX
1574 || target_index
== LFACE_BACKGROUND_INDEX
1575 || target_index
== LFACE_UNDERLINE_INDEX
1576 || target_index
== LFACE_OVERLINE_INDEX
1577 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1578 || target_index
== LFACE_BOX_INDEX
);
1580 /* if the color map is full, defined_color will return a best match
1581 to the values in an existing cell. */
1582 if (!defined_color (f
, SDATA (name
), &color
, 1))
1584 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1586 switch (target_index
)
1588 case LFACE_FOREGROUND_INDEX
:
1589 face
->foreground_defaulted_p
= 1;
1590 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1593 case LFACE_BACKGROUND_INDEX
:
1594 face
->background_defaulted_p
= 1;
1595 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1598 case LFACE_UNDERLINE_INDEX
:
1599 face
->underline_defaulted_p
= 1;
1600 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1603 case LFACE_OVERLINE_INDEX
:
1604 face
->overline_color_defaulted_p
= 1;
1605 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1608 case LFACE_STRIKE_THROUGH_INDEX
:
1609 face
->strike_through_color_defaulted_p
= 1;
1610 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1613 case LFACE_BOX_INDEX
:
1614 face
->box_color_defaulted_p
= 1;
1615 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1624 ++ncolors_allocated
;
1631 #ifdef HAVE_WINDOW_SYSTEM
1633 /* Load colors for face FACE which is used on frame F. Colors are
1634 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1635 of ATTRS. If the background color specified is not supported on F,
1636 try to emulate gray colors with a stipple from Vface_default_stipple. */
1639 load_face_colors (f
, face
, attrs
)
1646 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1647 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1649 /* Swap colors if face is inverse-video. */
1650 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1658 /* Check for support for foreground, not for background because
1659 face_color_supported_p is smart enough to know that grays are
1660 "supported" as background because we are supposed to use stipple
1662 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1663 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1665 x_destroy_bitmap (f
, face
->stipple
);
1666 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1667 &face
->pixmap_w
, &face
->pixmap_h
);
1670 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1671 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1675 /* Free color PIXEL on frame F. */
1678 unload_color (f
, pixel
)
1680 unsigned long pixel
;
1682 #ifdef HAVE_X_WINDOWS
1686 x_free_colors (f
, &pixel
, 1);
1693 /* Free colors allocated for FACE. */
1696 free_face_colors (f
, face
)
1700 #ifdef HAVE_X_WINDOWS
1701 if (face
->colors_copied_bitwise_p
)
1706 if (!face
->foreground_defaulted_p
)
1708 x_free_colors (f
, &face
->foreground
, 1);
1709 IF_DEBUG (--ncolors_allocated
);
1712 if (!face
->background_defaulted_p
)
1714 x_free_colors (f
, &face
->background
, 1);
1715 IF_DEBUG (--ncolors_allocated
);
1718 if (face
->underline_p
1719 && !face
->underline_defaulted_p
)
1721 x_free_colors (f
, &face
->underline_color
, 1);
1722 IF_DEBUG (--ncolors_allocated
);
1725 if (face
->overline_p
1726 && !face
->overline_color_defaulted_p
)
1728 x_free_colors (f
, &face
->overline_color
, 1);
1729 IF_DEBUG (--ncolors_allocated
);
1732 if (face
->strike_through_p
1733 && !face
->strike_through_color_defaulted_p
)
1735 x_free_colors (f
, &face
->strike_through_color
, 1);
1736 IF_DEBUG (--ncolors_allocated
);
1739 if (face
->box
!= FACE_NO_BOX
1740 && !face
->box_color_defaulted_p
)
1742 x_free_colors (f
, &face
->box_color
, 1);
1743 IF_DEBUG (--ncolors_allocated
);
1747 #endif /* HAVE_X_WINDOWS */
1750 #endif /* HAVE_WINDOW_SYSTEM */
1754 /***********************************************************************
1756 ***********************************************************************/
1758 /* An enumerator for each field of an XLFD font name. */
1779 /* An enumerator for each possible slant value of a font. Taken from
1780 the XLFD specification. */
1788 XLFD_SLANT_REVERSE_ITALIC
,
1789 XLFD_SLANT_REVERSE_OBLIQUE
,
1793 /* Relative font weight according to XLFD documentation. */
1797 XLFD_WEIGHT_UNKNOWN
,
1798 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1799 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1800 XLFD_WEIGHT_LIGHT
, /* 30 */
1801 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1802 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1803 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1804 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1805 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1806 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1809 /* Relative proportionate width. */
1813 XLFD_SWIDTH_UNKNOWN
,
1814 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1815 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1816 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1817 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1818 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1819 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1820 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1821 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1822 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1825 /* Structure used for tables mapping XLFD weight, slant, and width
1826 names to numeric and symbolic values. */
1832 Lisp_Object
*symbol
;
1835 /* Table of XLFD slant names and their numeric and symbolic
1836 representations. This table must be sorted by slant names in
1839 static struct table_entry slant_table
[] =
1841 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1842 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1843 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1844 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1845 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1846 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1849 /* Table of XLFD weight names. This table must be sorted by weight
1850 names in ascending order. */
1852 static struct table_entry weight_table
[] =
1854 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1855 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1856 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1857 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1858 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1859 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1860 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1861 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1862 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1863 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1864 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1865 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1866 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1867 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1868 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1869 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1872 /* Table of XLFD width names. This table must be sorted by width
1873 names in ascending order. */
1875 static struct table_entry swidth_table
[] =
1877 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1878 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1879 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1880 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1881 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1882 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1883 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1884 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1885 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1886 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1887 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1888 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1889 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1890 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1891 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1894 /* Structure used to hold the result of splitting font names in XLFD
1895 format into their fields. */
1899 /* The original name which is modified destructively by
1900 split_font_name. The pointer is kept here to be able to free it
1901 if it was allocated from the heap. */
1904 /* Font name fields. Each vector element points into `name' above.
1905 Fields are NUL-terminated. */
1906 char *fields
[XLFD_LAST
];
1908 /* Numeric values for those fields that interest us. See
1909 split_font_name for which these are. */
1910 int numeric
[XLFD_LAST
];
1912 /* If the original name matches one of Vface_font_rescale_alist,
1913 the value is the corresponding rescale ratio. Otherwise, the
1915 double rescale_ratio
;
1917 /* Lower value mean higher priority. */
1918 int registry_priority
;
1921 /* The frame in effect when sorting font names. Set temporarily in
1922 sort_fonts so that it is available in font comparison functions. */
1924 static struct frame
*font_frame
;
1926 /* Order by which font selection chooses fonts. The default values
1927 mean `first, find a best match for the font width, then for the
1928 font height, then for weight, then for slant.' This variable can be
1929 set via set-face-font-sort-order. */
1932 static int font_sort_order
[4] = {
1933 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1936 static int font_sort_order
[4];
1939 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1940 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1941 is a pointer to the matching table entry or null if no table entry
1944 static struct table_entry
*
1945 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1946 struct table_entry
*table
;
1948 struct font_name
*font
;
1951 /* Function split_font_name converts fields to lower-case, so there
1952 is no need to use xstrlwr or xstricmp here. */
1953 char *s
= font
->fields
[field_index
];
1954 int low
, mid
, high
, cmp
;
1961 mid
= (low
+ high
) / 2;
1962 cmp
= strcmp (table
[mid
].name
, s
);
1976 /* Return a numeric representation for font name field
1977 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1978 has DIM entries. Value is the numeric value found or DFLT if no
1979 table entry matches. This function is used to translate weight,
1980 slant, and swidth names of XLFD font names to numeric values. */
1983 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1984 struct table_entry
*table
;
1986 struct font_name
*font
;
1990 struct table_entry
*p
;
1991 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1992 return p
? p
->numeric
: dflt
;
1996 /* Return a symbolic representation for font name field
1997 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1998 has DIM entries. Value is the symbolic value found or DFLT if no
1999 table entry matches. This function is used to translate weight,
2000 slant, and swidth names of XLFD font names to symbols. */
2002 static INLINE Lisp_Object
2003 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2004 struct table_entry
*table
;
2006 struct font_name
*font
;
2010 struct table_entry
*p
;
2011 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2012 return p
? *p
->symbol
: dflt
;
2016 /* Return a numeric value for the slant of the font given by FONT. */
2019 xlfd_numeric_slant (font
)
2020 struct font_name
*font
;
2022 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2023 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2027 /* Return a symbol representing the weight of the font given by FONT. */
2029 static INLINE Lisp_Object
2030 xlfd_symbolic_slant (font
)
2031 struct font_name
*font
;
2033 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2034 font
, XLFD_SLANT
, Qnormal
);
2038 /* Return a numeric value for the weight of the font given by FONT. */
2041 xlfd_numeric_weight (font
)
2042 struct font_name
*font
;
2044 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2045 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2049 /* Return a symbol representing the slant of the font given by FONT. */
2051 static INLINE Lisp_Object
2052 xlfd_symbolic_weight (font
)
2053 struct font_name
*font
;
2055 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2056 font
, XLFD_WEIGHT
, Qnormal
);
2060 /* Return a numeric value for the swidth of the font whose XLFD font
2061 name fields are found in FONT. */
2064 xlfd_numeric_swidth (font
)
2065 struct font_name
*font
;
2067 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2068 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2072 /* Return a symbolic value for the swidth of FONT. */
2074 static INLINE Lisp_Object
2075 xlfd_symbolic_swidth (font
)
2076 struct font_name
*font
;
2078 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2079 font
, XLFD_SWIDTH
, Qnormal
);
2083 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2084 entries. Value is a pointer to the matching table entry or null if
2085 no element of TABLE contains SYMBOL. */
2087 static struct table_entry
*
2088 face_value (table
, dim
, symbol
)
2089 struct table_entry
*table
;
2095 xassert (SYMBOLP (symbol
));
2097 for (i
= 0; i
< dim
; ++i
)
2098 if (EQ (*table
[i
].symbol
, symbol
))
2101 return i
< dim
? table
+ i
: NULL
;
2105 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2106 entries. Value is -1 if SYMBOL is not found in TABLE. */
2109 face_numeric_value (table
, dim
, symbol
)
2110 struct table_entry
*table
;
2114 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2115 return p
? p
->numeric
: -1;
2119 /* Return a numeric value representing the weight specified by Lisp
2120 symbol WEIGHT. Value is one of the enumerators of enum
2124 face_numeric_weight (weight
)
2127 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2131 /* Return a numeric value representing the slant specified by Lisp
2132 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2135 face_numeric_slant (slant
)
2138 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2142 /* Return a numeric value representing the swidth specified by Lisp
2143 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2146 face_numeric_swidth (width
)
2149 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2153 split_font_name_into_vector (fontname
)
2154 Lisp_Object fontname
;
2156 struct font_name font
;
2160 font
.name
= LSTRDUPA (fontname
);
2161 if (! split_font_name (NULL
, &font
, 0))
2163 vec
= Fmake_vector (make_number (XLFD_LAST
), Qnil
);
2164 for (i
= 0; i
< XLFD_LAST
; i
++)
2165 if (font
.fields
[i
][0] != '*')
2166 ASET (vec
, i
, build_string (font
.fields
[i
]));
2171 build_font_name_from_vector (vec
)
2174 struct font_name font
;
2175 Lisp_Object fontname
;
2179 for (i
= 0; i
< XLFD_LAST
; i
++)
2181 font
.fields
[i
] = (NILP (AREF (vec
, i
))
2182 ? "*" : (char *) SDATA (AREF (vec
, i
)));
2183 if ((i
== XLFD_FAMILY
|| i
== XLFD_REGISTRY
)
2184 && (p
= strchr (font
.fields
[i
], '-')))
2186 char *p1
= STRDUPA (font
.fields
[i
]);
2188 p1
[p
- font
.fields
[i
]] = '\0';
2189 if (i
== XLFD_FAMILY
)
2191 font
.fields
[XLFD_FOUNDRY
] = p1
;
2192 font
.fields
[XLFD_FAMILY
] = p
+ 1;
2196 font
.fields
[XLFD_REGISTRY
] = p1
;
2197 font
.fields
[XLFD_ENCODING
] = p
+ 1;
2203 p
= build_font_name (&font
);
2204 fontname
= build_string (p
);
2209 #ifdef HAVE_WINDOW_SYSTEM
2211 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2215 struct font_name
*font
;
2217 /* Function split_font_name converts fields to lower-case, so there
2218 is no need to use tolower here. */
2219 return *font
->fields
[XLFD_SPACING
] != 'p';
2223 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2225 The actual height of the font when displayed on F depends on the
2226 resolution of both the font and frame. For example, a 10pt font
2227 designed for a 100dpi display will display larger than 10pt on a
2228 75dpi display. (It's not unusual to use fonts not designed for the
2229 display one is using. For example, some intlfonts are available in
2230 72dpi versions, only.)
2232 Value is the real point size of FONT on frame F, or 0 if it cannot
2235 By side effect, set FONT->numeric[XLFD_PIXEL_SIZE]. */
2238 xlfd_point_size (f
, font
)
2240 struct font_name
*font
;
2242 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2243 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2247 if (*pixel_field
== '[')
2249 /* The pixel size field is `[A B C D]' which specifies
2250 a transformation matrix.
2256 by which all glyphs of the font are transformed. The spec
2257 says that s scalar value N for the pixel size is equivalent
2258 to A = N * resx/resy, B = C = 0, D = N. */
2259 char *start
= pixel_field
+ 1, *end
;
2263 for (i
= 0; i
< 4; ++i
)
2265 matrix
[i
] = strtod (start
, &end
);
2272 pixel
= atoi (pixel_field
);
2274 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel
;
2278 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2284 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2285 of frame F. This function is used to guess a point size of font
2286 when only the pixel height of the font is available. */
2289 pixel_point_size (f
, pixel
)
2293 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2297 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2298 point size of one dot. */
2299 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2300 int_pt
= real_pt
+ 0.5;
2306 /* Return a rescaling ratio of a font of NAME. */
2309 font_rescale_ratio (name
)
2312 Lisp_Object tail
, elt
;
2314 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2317 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2318 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2319 return XFLOAT_DATA (XCDR (elt
));
2325 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2326 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2327 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2328 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2329 zero if the font name doesn't have the format we expect. The
2330 expected format is a font name that starts with a `-' and has
2331 XLFD_LAST fields separated by `-'. */
2334 split_font_name (f
, font
, numeric_p
)
2336 struct font_name
*font
;
2341 double rescale_ratio
;
2344 /* This must be done before splitting the font name. */
2345 rescale_ratio
= font_rescale_ratio (font
->name
);
2347 if (*font
->name
== '-')
2349 char *p
= xstrlwr (font
->name
) + 1;
2351 while (i
< XLFD_LAST
)
2353 font
->fields
[i
] = p
;
2356 /* Pixel and point size may be of the form `[....]'. For
2357 BNF, see XLFD spec, chapter 4. Negative values are
2358 indicated by tilde characters which we replace with
2359 `-' characters, here. */
2361 && (i
- 1 == XLFD_PIXEL_SIZE
2362 || i
- 1 == XLFD_POINT_SIZE
))
2367 for (++p
; *p
&& *p
!= ']'; ++p
)
2371 /* Check that the matrix contains 4 floating point
2373 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2376 if (strtod (start
, &end
) == 0 && start
== end
)
2383 while (*p
&& *p
!= '-')
2393 success_p
= i
== XLFD_LAST
;
2395 /* If requested, and font name was in the expected format,
2396 compute numeric values for some fields. */
2397 if (numeric_p
&& success_p
)
2399 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2400 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2401 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2402 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2403 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2404 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2405 font
->rescale_ratio
= rescale_ratio
;
2408 /* Initialize it to zero. It will be overridden by font_list while
2409 trying alternate registries. */
2410 font
->registry_priority
= 0;
2416 /* Build an XLFD font name from font name fields in FONT. Value is a
2417 pointer to the font name, which is allocated via xmalloc. */
2420 build_font_name (font
)
2421 struct font_name
*font
;
2425 char *font_name
= (char *) xmalloc (size
);
2426 int total_length
= 0;
2428 for (i
= 0; i
< XLFD_LAST
; ++i
)
2430 /* Add 1 because of the leading `-'. */
2431 int len
= strlen (font
->fields
[i
]) + 1;
2433 /* Reallocate font_name if necessary. Add 1 for the final
2435 if (total_length
+ len
+ 1 >= size
)
2437 int new_size
= max (2 * size
, size
+ len
+ 1);
2438 int sz
= new_size
* sizeof *font_name
;
2439 font_name
= (char *) xrealloc (font_name
, sz
);
2443 font_name
[total_length
] = '-';
2444 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2445 total_length
+= len
;
2448 font_name
[total_length
] = 0;
2453 /* Free an array FONTS of N font_name structures. This frees FONTS
2454 itself and all `name' fields in its elements. */
2457 free_font_names (fonts
, n
)
2458 struct font_name
*fonts
;
2462 xfree (fonts
[--n
].name
);
2467 /* Sort vector FONTS of font_name structures which contains NFONTS
2468 elements using qsort and comparison function CMPFN. F is the frame
2469 on which the fonts will be used. The global variable font_frame
2470 is temporarily set to F to make it available in CMPFN. */
2473 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2475 struct font_name
*fonts
;
2477 int (*cmpfn
) P_ ((const void *, const void *));
2480 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2485 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2486 display in x_display_list. FONTS is a pointer to a vector of
2487 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2488 alternative patterns from Valternate_fontname_alist if no fonts are
2489 found matching PATTERN.
2491 For all fonts found, set FONTS[i].name to the name of the font,
2492 allocated via xmalloc, and split font names into fields. Ignore
2493 fonts that we can't parse. Value is the number of fonts found. */
2496 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2499 struct font_name
**pfonts
;
2500 int nfonts
, try_alternatives_p
;
2504 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2505 better to do it the other way around. */
2507 Lisp_Object lpattern
, tem
;
2508 struct font_name
*fonts
= 0;
2509 int num_fonts
= nfonts
;
2512 lpattern
= build_string (pattern
);
2514 /* Get the list of fonts matching PATTERN. */
2517 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2520 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2523 if (nfonts
< 0 && CONSP (lfonts
))
2524 num_fonts
= XFASTINT (Flength (lfonts
));
2526 /* Make a copy of the font names we got from X, and
2527 split them into fields. */
2529 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2531 Lisp_Object elt
, tail
;
2532 const char *name
= SDATA (XCAR (tem
));
2534 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2535 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2539 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2550 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2554 /* Make a copy of the font name. */
2555 fonts
[n
].name
= xstrdup (name
);
2557 if (split_font_name (f
, fonts
+ n
, 1))
2559 if (font_scalable_p (fonts
+ n
)
2560 && !may_use_scalable_font_p (name
))
2563 xfree (fonts
[n
].name
);
2569 xfree (fonts
[n
].name
);
2572 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2573 if (n
== 0 && try_alternatives_p
)
2575 Lisp_Object list
= Valternate_fontname_alist
;
2583 while (CONSP (list
))
2585 Lisp_Object entry
= XCAR (list
);
2587 && STRINGP (XCAR (entry
))
2588 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2595 Lisp_Object patterns
= XCAR (list
);
2598 while (CONSP (patterns
)
2599 /* If list is screwed up, give up. */
2600 && (name
= XCAR (patterns
),
2602 /* Ignore patterns equal to PATTERN because we tried that
2603 already with no success. */
2604 && (strcmp (SDATA (name
), pattern
) == 0
2605 || (n
= x_face_list_fonts (f
, SDATA (name
),
2608 patterns
= XCDR (patterns
);
2616 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2617 using comparison function CMPFN. Value is the number of fonts
2618 found. If value is non-zero, *FONTS is set to a vector of
2619 font_name structures allocated from the heap containing matching
2620 fonts. Each element of *FONTS contains a name member that is also
2621 allocated from the heap. Font names in these structures are split
2622 into fields. Use free_font_names to free such an array. */
2625 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2628 int (*cmpfn
) P_ ((const void *, const void *));
2629 struct font_name
**fonts
;
2633 /* Get the list of fonts matching pattern. 100 should suffice. */
2634 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2635 if (INTEGERP (Vfont_list_limit
))
2636 nfonts
= XINT (Vfont_list_limit
);
2639 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2641 /* Sort the resulting array and return it in *FONTS. If no
2642 fonts were found, make sure to set *FONTS to null. */
2644 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2655 /* Compare two font_name structures *A and *B. Value is analogous to
2656 strcmp. Sort order is given by the global variable
2657 font_sort_order. Font names are sorted so that, everything else
2658 being equal, fonts with a resolution closer to that of the frame on
2659 which they are used are listed first. The global variable
2660 font_frame is the frame on which we operate. */
2663 cmp_font_names (a
, b
)
2666 struct font_name
*x
= (struct font_name
*) a
;
2667 struct font_name
*y
= (struct font_name
*) b
;
2670 /* All strings have been converted to lower-case by split_font_name,
2671 so we can use strcmp here. */
2672 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2677 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2679 int j
= font_sort_order
[i
];
2680 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2685 /* Everything else being equal, we prefer fonts with an
2686 y-resolution closer to that of the frame. */
2687 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2688 int x_resy
= x
->numeric
[XLFD_RESY
];
2689 int y_resy
= y
->numeric
[XLFD_RESY
];
2690 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2698 /* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
2699 is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
2700 family name string or nil. REGISTRY is a registry name string.
2701 Set *FONTS to a vector of font_name structures allocated from the
2702 heap containing the fonts found. Value is the number of fonts
2706 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2708 Lisp_Object pattern
, family
, registry
;
2709 struct font_name
**fonts
;
2711 char *pattern_str
, *family_str
, *registry_str
;
2715 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2716 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2718 pattern_str
= (char *) alloca (strlen (family_str
)
2719 + strlen (registry_str
)
2721 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2722 strcat (pattern_str
, family_str
);
2723 strcat (pattern_str
, "-*-");
2724 strcat (pattern_str
, registry_str
);
2725 if (!index (registry_str
, '-'))
2727 if (registry_str
[strlen (registry_str
) - 1] == '*')
2728 strcat (pattern_str
, "-*");
2730 strcat (pattern_str
, "*-*");
2734 pattern_str
= (char *) SDATA (pattern
);
2736 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2740 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2741 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2742 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2745 static struct font_name
*
2746 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2747 struct font_name
*fonts1
, *fonts2
;
2748 int nfonts1
, nfonts2
;
2750 int new_nfonts
= nfonts1
+ nfonts2
;
2751 struct font_name
*new_fonts
;
2753 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2754 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2755 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2762 /* Get a sorted list of fonts of family FAMILY on frame F.
2764 If PATTERN is non-nil, list fonts matching that pattern.
2766 If REGISTRY is non-nil, it is a list of registry (and encoding)
2767 names. Return fonts with those registries and the alternative
2768 registries from Vface_alternative_font_registry_alist.
2770 If REGISTRY is nil return fonts of any registry.
2772 Set *FONTS to a vector of font_name structures allocated from the
2773 heap containing the fonts found. Value is the number of fonts
2777 font_list (f
, pattern
, family
, registry
, fonts
)
2779 Lisp_Object pattern
, family
, registry
;
2780 struct font_name
**fonts
;
2786 if (NILP (registry
))
2787 return font_list_1 (f
, pattern
, family
, registry
, fonts
);
2789 for (reg_prio
= 0, nfonts
= 0; CONSP (registry
); registry
= XCDR (registry
))
2791 Lisp_Object elt
, alter
;
2793 struct font_name
*fonts2
;
2795 elt
= XCAR (registry
);
2796 alter
= Fassoc (elt
, Vface_alternative_font_registry_alist
);
2798 alter
= Fcons (elt
, Qnil
);
2799 for (; CONSP (alter
); alter
= XCDR (alter
), reg_prio
++)
2801 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
), &fonts2
);
2805 for (i
= 0; i
< nfonts2
; i
++)
2806 fonts2
[i
].registry_priority
= reg_prio
;
2808 *fonts
= concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
);
2820 /* Remove elements from LIST whose cars are `equal'. Called from
2821 x-family-fonts and x-font-family-list to remove duplicate font
2825 remove_duplicates (list
)
2828 Lisp_Object tail
= list
;
2830 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2832 Lisp_Object next
= XCDR (tail
);
2833 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2834 XSETCDR (tail
, XCDR (next
));
2841 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2842 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2843 If FAMILY is omitted or nil, list all families.
2844 Otherwise, FAMILY must be a string, possibly containing wildcards
2846 If FRAME is omitted or nil, use the selected frame.
2847 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2848 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2849 FAMILY is the font family name. POINT-SIZE is the size of the
2850 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2851 width, weight and slant of the font. These symbols are the same as for
2852 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2853 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2854 giving the registry and encoding of the font.
2855 The result list is sorted according to the current setting of
2856 the face font sort order. */)
2858 Lisp_Object family
, frame
;
2860 struct frame
*f
= check_x_frame (frame
);
2861 struct font_name
*fonts
;
2864 struct gcpro gcpro1
;
2867 CHECK_STRING (family
);
2871 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2872 for (i
= nfonts
- 1; i
>= 0; --i
)
2874 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2877 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2878 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2879 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2880 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2881 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2882 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2883 tem
= build_font_name (fonts
+ i
);
2884 ASET (v
, 6, build_string (tem
));
2885 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2886 fonts
[i
].fields
[XLFD_ENCODING
]);
2887 ASET (v
, 7, build_string (tem
));
2890 result
= Fcons (v
, result
);
2893 remove_duplicates (result
);
2894 free_font_names (fonts
, nfonts
);
2900 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2902 doc
: /* Return a list of available font families on FRAME.
2903 If FRAME is omitted or nil, use the selected frame.
2904 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2905 is a font family, and FIXED-P is non-nil if fonts of that family
2906 are fixed-pitch. */)
2910 struct frame
*f
= check_x_frame (frame
);
2912 struct font_name
*fonts
;
2914 struct gcpro gcpro1
;
2915 int count
= SPECPDL_INDEX ();
2917 /* Let's consider all fonts. */
2918 specbind (intern ("font-list-limit"), make_number (-1));
2919 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2923 for (i
= nfonts
- 1; i
>= 0; --i
)
2924 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2925 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2928 remove_duplicates (result
);
2929 free_font_names (fonts
, nfonts
);
2931 return unbind_to (count
, result
);
2935 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2936 doc
: /* Return a list of the names of available fonts matching PATTERN.
2937 If optional arguments FACE and FRAME are specified, return only fonts
2938 the same size as FACE on FRAME.
2939 PATTERN is a string, perhaps with wildcard characters;
2940 the * character matches any substring, and
2941 the ? character matches any single character.
2942 PATTERN is case-insensitive.
2943 FACE is a face name--a symbol.
2945 The return value is a list of strings, suitable as arguments to
2948 Fonts Emacs can't use may or may not be excluded
2949 even if they match PATTERN and FACE.
2950 The optional fourth argument MAXIMUM sets a limit on how many
2951 fonts to match. The first MAXIMUM fonts are reported.
2952 The optional fifth argument WIDTH, if specified, is a number of columns
2953 occupied by a character of a font. In that case, return only fonts
2954 the WIDTH times as wide as FACE on FRAME. */)
2955 (pattern
, face
, frame
, maximum
, width
)
2956 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2963 CHECK_STRING (pattern
);
2969 CHECK_NATNUM (maximum
);
2970 maxnames
= XINT (maximum
);
2974 CHECK_NUMBER (width
);
2976 /* We can't simply call check_x_frame because this function may be
2977 called before any frame is created. */
2978 f
= frame_or_selected_frame (frame
, 2);
2979 if (!FRAME_WINDOW_P (f
))
2981 /* Perhaps we have not yet created any frame. */
2986 /* Determine the width standard for comparison with the fonts we find. */
2992 /* This is of limited utility since it works with character
2993 widths. Keep it for compatibility. --gerd. */
2994 int face_id
= lookup_named_face (f
, face
);
2995 struct face
*face
= (face_id
< 0
2997 : FACE_FROM_ID (f
, face_id
));
3000 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3001 not maximum as on X. Redefine here. */
3003 #define FONT_WIDTH FONT_MAX_WIDTH
3006 if (face
&& face
->font
)
3007 size
= FONT_WIDTH (face
->font
);
3009 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3012 size
*= XINT (width
);
3016 Lisp_Object args
[2];
3018 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3020 /* We don't have to check fontsets. */
3022 args
[1] = list_fontsets (f
, pattern
, size
);
3023 return Fnconc (2, args
);
3027 #endif /* HAVE_WINDOW_SYSTEM */
3031 /***********************************************************************
3033 ***********************************************************************/
3035 /* Access face attributes of face LFACE, a Lisp vector. */
3037 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3038 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3039 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3040 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3041 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3042 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3043 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3044 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3045 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3046 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3047 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3048 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3049 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3050 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3051 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3052 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3053 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3055 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3056 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3058 #define LFACEP(LFACE) \
3060 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3061 && EQ (AREF (LFACE, 0), Qface))
3066 /* Check consistency of Lisp face attribute vector ATTRS. */
3069 check_lface_attrs (attrs
)
3072 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3073 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3074 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3075 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3076 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3077 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3078 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3079 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3080 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3081 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3082 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3083 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3084 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3085 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3086 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3087 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3088 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3089 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3090 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3091 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3092 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3093 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3094 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3095 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3096 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3097 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3098 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3099 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3100 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3101 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3102 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3103 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3104 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3105 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3106 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3107 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3108 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3109 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3110 #ifdef HAVE_WINDOW_SYSTEM
3111 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3112 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3113 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3114 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3115 || NILP (attrs
[LFACE_FONT_INDEX
])
3116 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3117 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3118 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3123 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3131 xassert (LFACEP (lface
));
3132 check_lface_attrs (XVECTOR (lface
)->contents
);
3136 #else /* GLYPH_DEBUG == 0 */
3138 #define check_lface_attrs(attrs) (void) 0
3139 #define check_lface(lface) (void) 0
3141 #endif /* GLYPH_DEBUG == 0 */
3144 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3145 to make it a symvol. If FACE_NAME is an alias for another face,
3146 return that face's name. */
3149 resolve_face_name (face_name
)
3150 Lisp_Object face_name
;
3152 Lisp_Object aliased
;
3154 if (STRINGP (face_name
))
3155 face_name
= intern (SDATA (face_name
));
3157 while (SYMBOLP (face_name
))
3159 aliased
= Fget (face_name
, Qface_alias
);
3163 face_name
= aliased
;
3170 /* Return the face definition of FACE_NAME on frame F. F null means
3171 return the definition for new frames. FACE_NAME may be a string or
3172 a symbol (apparently Emacs 20.2 allowed strings as face names in
3173 face text properties; Ediff uses that). If FACE_NAME is an alias
3174 for another face, return that face's definition. If SIGNAL_P is
3175 non-zero, signal an error if FACE_NAME is not a valid face name.
3176 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3179 static INLINE Lisp_Object
3180 lface_from_face_name (f
, face_name
, signal_p
)
3182 Lisp_Object face_name
;
3187 face_name
= resolve_face_name (face_name
);
3190 lface
= assq_no_quit (face_name
, f
->face_alist
);
3192 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3195 lface
= XCDR (lface
);
3197 signal_error ("Invalid face", face_name
);
3199 check_lface (lface
);
3204 /* Get face attributes of face FACE_NAME from frame-local faces on
3205 frame F. Store the resulting attributes in ATTRS which must point
3206 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3207 is non-zero, signal an error if FACE_NAME does not name a face.
3208 Otherwise, value is zero if FACE_NAME is not a face. */
3211 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3213 Lisp_Object face_name
;
3220 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3223 bcopy (XVECTOR (lface
)->contents
, attrs
,
3224 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3234 /* Non-zero if all attributes in face attribute vector ATTRS are
3235 specified, i.e. are non-nil. */
3238 lface_fully_specified_p (attrs
)
3243 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3244 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3245 && i
!= LFACE_AVGWIDTH_INDEX
&& i
!= LFACE_FONTSET_INDEX
)
3246 if (UNSPECIFIEDP (attrs
[i
]))
3249 return i
== LFACE_VECTOR_SIZE
;
3252 #ifdef HAVE_WINDOW_SYSTEM
3254 /* Set font-related attributes of Lisp face LFACE from the fullname of
3255 the font opened by FONTNAME. If FORCE_P is zero, set only
3256 unspecified attributes of LFACE. The exception is `font'
3257 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3259 If FONTNAME is not available on frame F,
3260 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3261 If the fullname is not in a valid XLFD format,
3262 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3263 in LFACE and return 1.
3264 Otherwise, return 1. */
3267 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3270 Lisp_Object fontname
;
3271 int force_p
, may_fail_p
;
3273 struct font_name font
;
3278 char *font_name
= SDATA (fontname
);
3279 struct font_info
*font_info
;
3281 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3282 fontset
= fs_query_fontset (fontname
, 0);
3284 font_name
= SDATA (fontset_ascii (fontset
));
3285 else if (fontset
== 0)
3292 /* Check if FONT_NAME is surely available on the system. Usually
3293 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3294 returns quickly. But, even if FONT_NAME is not yet cached,
3295 caching it now is not futail because we anyway load the font
3298 font_info
= FS_LOAD_FONT (f
, font_name
);
3308 font
.name
= STRDUPA (font_info
->full_name
);
3309 have_xlfd_p
= split_font_name (f
, &font
, 1);
3311 /* Set attributes only if unspecified, otherwise face defaults for
3312 new frames would never take effect. If we couldn't get a font
3313 name conforming to XLFD, set normal values. */
3315 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3320 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3321 + strlen (font
.fields
[XLFD_FOUNDRY
])
3323 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3324 font
.fields
[XLFD_FAMILY
]);
3325 val
= build_string (buffer
);
3328 val
= build_string ("*");
3329 LFACE_FAMILY (lface
) = val
;
3332 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3335 pt
= xlfd_point_size (f
, &font
);
3337 pt
= pixel_point_size (f
, font_info
->height
* 10);
3339 LFACE_HEIGHT (lface
) = make_number (pt
);
3342 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3343 LFACE_SWIDTH (lface
)
3344 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3346 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3347 LFACE_AVGWIDTH (lface
)
3349 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3352 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3353 LFACE_WEIGHT (lface
)
3354 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3356 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3358 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3362 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3363 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3367 LFACE_FONT (lface
) = fontname
;
3369 = new_fontset_from_font_name (build_string (font_info
->full_name
));
3370 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3375 #endif /* HAVE_WINDOW_SYSTEM */
3378 /* Merges the face height FROM with the face height TO, and returns the
3379 merged height. If FROM is an invalid height, then INVALID is
3380 returned instead. FROM and TO may be either absolute face heights or
3381 `relative' heights; the returned value is always an absolute height
3382 unless both FROM and TO are relative. GCPRO is a lisp value that
3383 will be protected from garbage-collection if this function makes a
3387 merge_face_heights (from
, to
, invalid
, gcpro
)
3388 Lisp_Object from
, to
, invalid
, gcpro
;
3390 Lisp_Object result
= invalid
;
3392 if (INTEGERP (from
))
3393 /* FROM is absolute, just use it as is. */
3395 else if (FLOATP (from
))
3396 /* FROM is a scale, use it to adjust TO. */
3399 /* relative X absolute => absolute */
3400 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3401 else if (FLOATP (to
))
3402 /* relative X relative => relative */
3403 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3405 else if (FUNCTIONP (from
))
3406 /* FROM is a function, which use to adjust TO. */
3408 /* Call function with current height as argument.
3409 From is the new height. */
3410 Lisp_Object args
[2];
3411 struct gcpro gcpro1
;
3417 result
= safe_call (2, args
);
3421 /* Ensure that if TO was absolute, so is the result. */
3422 if (INTEGERP (to
) && !INTEGERP (result
))
3430 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3431 store the resulting attributes in TO, which must be already be
3432 completely specified and contain only absolute attributes. Every
3433 specified attribute of FROM overrides the corresponding attribute of
3434 TO; relative attributes in FROM are merged with the absolute value in
3435 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3436 face inheritance; it should be Qnil when called from other places. */
3439 merge_face_vectors (f
, from
, to
, cycle_check
)
3441 Lisp_Object
*from
, *to
;
3442 Lisp_Object cycle_check
;
3446 /* If FROM inherits from some other faces, merge their attributes into
3447 TO before merging FROM's direct attributes. Note that an :inherit
3448 attribute of `unspecified' is the same as one of nil; we never
3449 merge :inherit attributes, so nil is more correct, but lots of
3450 other code uses `unspecified' as a generic value for face attributes. */
3451 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3452 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3453 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3455 /* If TO specifies a :font attribute, and FROM specifies some
3456 font-related attribute, we need to clear TO's :font attribute
3457 (because it will be inconsistent with whatever FROM specifies, and
3458 FROM takes precedence). */
3459 if (!NILP (to
[LFACE_FONT_INDEX
])
3460 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3461 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3462 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3463 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3464 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3465 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3466 to
[LFACE_FONT_INDEX
] = Qnil
;
3468 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3469 if (!UNSPECIFIEDP (from
[i
]))
3471 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3472 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3477 /* TO is always an absolute face, which should inherit from nothing.
3478 We blindly copy the :inherit attribute above and fix it up here. */
3479 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3483 /* Checks the `cycle check' variable CHECK to see if it indicates that
3484 EL is part of a cycle; CHECK must be either Qnil or a value returned
3485 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3486 elements after which a cycle might be suspected; after that many
3487 elements, this macro begins consing in order to keep more precise
3490 Returns nil if a cycle was detected, otherwise a new value for CHECK
3493 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3494 the caller should make sure that's ok. */
3496 #define CYCLE_CHECK(check, el, suspicious) \
3499 : (INTEGERP (check) \
3500 ? (XFASTINT (check) < (suspicious) \
3501 ? make_number (XFASTINT (check) + 1) \
3502 : Fcons (el, Qnil)) \
3503 : (!NILP (Fmemq ((el), (check))) \
3505 : Fcons ((el), (check)))))
3508 /* Merge face attributes from the face on frame F whose name is
3509 INHERITS, into the vector of face attributes TO; INHERITS may also be
3510 a list of face names, in which case they are applied in order.
3511 CYCLE_CHECK is used to detect loops in face inheritance.
3512 Returns true if any of the inherited attributes are `font-related'. */
3515 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3517 Lisp_Object inherit
;
3519 Lisp_Object cycle_check
;
3521 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3522 /* Inherit from the named face INHERIT. */
3526 /* Make sure we're not in an inheritance loop. */
3527 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3528 if (NILP (cycle_check
))
3529 /* Cycle detected, ignore any further inheritance. */
3532 lface
= lface_from_face_name (f
, inherit
, 0);
3534 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3536 else if (CONSP (inherit
))
3537 /* Handle a list of inherited faces by calling ourselves recursively
3538 on each element. Note that we only do so for symbol elements, so
3539 it's not possible to infinitely recurse. */
3541 while (CONSP (inherit
))
3543 if (SYMBOLP (XCAR (inherit
)))
3544 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3546 /* Check for a circular inheritance list. */
3547 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3548 if (NILP (cycle_check
))
3549 /* Cycle detected. */
3552 inherit
= XCDR (inherit
);
3558 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3559 is a face property, determine the resulting face attributes on
3560 frame F, and store them in TO. PROP may be a single face
3561 specification or a list of such specifications. Each face
3562 specification can be
3564 1. A symbol or string naming a Lisp face.
3566 2. A property list of the form (KEYWORD VALUE ...) where each
3567 KEYWORD is a face attribute name, and value is an appropriate value
3570 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3571 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3572 for compatibility with 20.2.
3574 Face specifications earlier in lists take precedence over later
3578 merge_face_vector_with_property (f
, to
, prop
)
3585 Lisp_Object first
= XCAR (prop
);
3587 if (EQ (first
, Qforeground_color
)
3588 || EQ (first
, Qbackground_color
))
3590 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3591 . COLOR). COLOR must be a string. */
3592 Lisp_Object color_name
= XCDR (prop
);
3593 Lisp_Object color
= first
;
3595 if (STRINGP (color_name
))
3597 if (EQ (color
, Qforeground_color
))
3598 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3600 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3603 add_to_log ("Invalid face color", color_name
, Qnil
);
3605 else if (SYMBOLP (first
)
3606 && *SDATA (SYMBOL_NAME (first
)) == ':')
3608 /* Assume this is the property list form. */
3609 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3611 Lisp_Object keyword
= XCAR (prop
);
3612 Lisp_Object value
= XCAR (XCDR (prop
));
3614 if (EQ (keyword
, QCfamily
))
3616 if (STRINGP (value
))
3617 to
[LFACE_FAMILY_INDEX
] = value
;
3619 add_to_log ("Invalid face font family", value
, Qnil
);
3621 else if (EQ (keyword
, QCheight
))
3623 Lisp_Object new_height
=
3624 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3627 if (NILP (new_height
))
3628 add_to_log ("Invalid face font height", value
, Qnil
);
3630 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3632 else if (EQ (keyword
, QCweight
))
3635 && face_numeric_weight (value
) >= 0)
3636 to
[LFACE_WEIGHT_INDEX
] = value
;
3638 add_to_log ("Invalid face weight", value
, Qnil
);
3640 else if (EQ (keyword
, QCslant
))
3643 && face_numeric_slant (value
) >= 0)
3644 to
[LFACE_SLANT_INDEX
] = value
;
3646 add_to_log ("Invalid face slant", value
, Qnil
);
3648 else if (EQ (keyword
, QCunderline
))
3653 to
[LFACE_UNDERLINE_INDEX
] = value
;
3655 add_to_log ("Invalid face underline", value
, Qnil
);
3657 else if (EQ (keyword
, QCoverline
))
3662 to
[LFACE_OVERLINE_INDEX
] = value
;
3664 add_to_log ("Invalid face overline", value
, Qnil
);
3666 else if (EQ (keyword
, QCstrike_through
))
3671 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3673 add_to_log ("Invalid face strike-through", value
, Qnil
);
3675 else if (EQ (keyword
, QCbox
))
3678 value
= make_number (1);
3679 if (INTEGERP (value
)
3683 to
[LFACE_BOX_INDEX
] = value
;
3685 add_to_log ("Invalid face box", value
, Qnil
);
3687 else if (EQ (keyword
, QCinverse_video
)
3688 || EQ (keyword
, QCreverse_video
))
3690 if (EQ (value
, Qt
) || NILP (value
))
3691 to
[LFACE_INVERSE_INDEX
] = value
;
3693 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3695 else if (EQ (keyword
, QCforeground
))
3697 if (STRINGP (value
))
3698 to
[LFACE_FOREGROUND_INDEX
] = value
;
3700 add_to_log ("Invalid face foreground", value
, Qnil
);
3702 else if (EQ (keyword
, QCbackground
))
3704 if (STRINGP (value
))
3705 to
[LFACE_BACKGROUND_INDEX
] = value
;
3707 add_to_log ("Invalid face background", value
, Qnil
);
3709 else if (EQ (keyword
, QCstipple
))
3711 #ifdef HAVE_X_WINDOWS
3712 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3713 if (!NILP (pixmap_p
))
3714 to
[LFACE_STIPPLE_INDEX
] = value
;
3716 add_to_log ("Invalid face stipple", value
, Qnil
);
3719 else if (EQ (keyword
, QCwidth
))
3722 && face_numeric_swidth (value
) >= 0)
3723 to
[LFACE_SWIDTH_INDEX
] = value
;
3725 add_to_log ("Invalid face width", value
, Qnil
);
3727 else if (EQ (keyword
, QCinherit
))
3729 if (SYMBOLP (value
))
3730 to
[LFACE_INHERIT_INDEX
] = value
;
3734 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3735 if (!SYMBOLP (XCAR (tail
)))
3738 to
[LFACE_INHERIT_INDEX
] = value
;
3740 add_to_log ("Invalid face inherit", value
, Qnil
);
3744 add_to_log ("Invalid attribute %s in face property",
3747 prop
= XCDR (XCDR (prop
));
3752 /* This is a list of face specs. Specifications at the
3753 beginning of the list take precedence over later
3754 specifications, so we have to merge starting with the
3755 last specification. */
3756 Lisp_Object next
= XCDR (prop
);
3758 merge_face_vector_with_property (f
, to
, next
);
3759 merge_face_vector_with_property (f
, to
, first
);
3764 /* PROP ought to be a face name. */
3765 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3767 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3769 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3774 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3775 Sinternal_make_lisp_face
, 1, 2, 0,
3776 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3777 If FACE was not known as a face before, create a new one.
3778 If optional argument FRAME is specified, make a frame-local face
3779 for that frame. Otherwise operate on the global face definition.
3780 Value is a vector of face attributes. */)
3782 Lisp_Object face
, frame
;
3784 Lisp_Object global_lface
, lface
;
3788 CHECK_SYMBOL (face
);
3789 global_lface
= lface_from_face_name (NULL
, face
, 0);
3793 CHECK_LIVE_FRAME (frame
);
3795 lface
= lface_from_face_name (f
, face
, 0);
3798 f
= NULL
, lface
= Qnil
;
3800 /* Add a global definition if there is none. */
3801 if (NILP (global_lface
))
3803 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3805 AREF (global_lface
, 0) = Qface
;
3806 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3807 Vface_new_frame_defaults
);
3809 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3810 face id to Lisp face is given by the vector lface_id_to_name.
3811 The mapping from Lisp face to Lisp face id is given by the
3812 property `face' of the Lisp face name. */
3813 if (next_lface_id
== lface_id_to_name_size
)
3815 int new_size
= max (50, 2 * lface_id_to_name_size
);
3816 int sz
= new_size
* sizeof *lface_id_to_name
;
3817 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3818 lface_id_to_name_size
= new_size
;
3821 lface_id_to_name
[next_lface_id
] = face
;
3822 Fput (face
, Qface
, make_number (next_lface_id
));
3826 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3827 AREF (global_lface
, i
) = Qunspecified
;
3829 /* Add a frame-local definition. */
3834 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3836 AREF (lface
, 0) = Qface
;
3837 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3840 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3841 AREF (lface
, i
) = Qunspecified
;
3844 lface
= global_lface
;
3846 /* Changing a named face means that all realized faces depending on
3847 that face are invalid. Since we cannot tell which realized faces
3848 depend on the face, make sure they are all removed. This is done
3849 by incrementing face_change_count. The next call to
3850 init_iterator will then free realized faces. */
3851 ++face_change_count
;
3852 ++windows_or_buffers_changed
;
3854 xassert (LFACEP (lface
));
3855 check_lface (lface
);
3860 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3861 Sinternal_lisp_face_p
, 1, 2, 0,
3862 doc
: /* Return non-nil if FACE names a face.
3863 If optional second parameter FRAME is non-nil, check for the
3864 existence of a frame-local face with name FACE on that frame.
3865 Otherwise check for the existence of a global face. */)
3867 Lisp_Object face
, frame
;
3873 CHECK_LIVE_FRAME (frame
);
3874 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3877 lface
= lface_from_face_name (NULL
, face
, 0);
3883 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3884 Sinternal_copy_lisp_face
, 4, 4, 0,
3885 doc
: /* Copy face FROM to TO.
3886 If FRAME it t, copy the global face definition of FROM to the
3887 global face definition of TO. Otherwise, copy the frame-local
3888 definition of FROM on FRAME to the frame-local definition of TO
3889 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3892 (from
, to
, frame
, new_frame
)
3893 Lisp_Object from
, to
, frame
, new_frame
;
3895 Lisp_Object lface
, copy
;
3897 CHECK_SYMBOL (from
);
3899 if (NILP (new_frame
))
3904 /* Copy global definition of FROM. We don't make copies of
3905 strings etc. because 20.2 didn't do it either. */
3906 lface
= lface_from_face_name (NULL
, from
, 1);
3907 copy
= Finternal_make_lisp_face (to
, Qnil
);
3911 /* Copy frame-local definition of FROM. */
3912 CHECK_LIVE_FRAME (frame
);
3913 CHECK_LIVE_FRAME (new_frame
);
3914 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3915 copy
= Finternal_make_lisp_face (to
, new_frame
);
3918 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3919 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3921 /* Changing a named face means that all realized faces depending on
3922 that face are invalid. Since we cannot tell which realized faces
3923 depend on the face, make sure they are all removed. This is done
3924 by incrementing face_change_count. The next call to
3925 init_iterator will then free realized faces. */
3926 ++face_change_count
;
3927 ++windows_or_buffers_changed
;
3933 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3934 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3935 doc
: /* Set attribute ATTR of FACE to VALUE.
3936 FRAME being a frame means change the face on that frame.
3937 FRAME nil means change the face of the selected frame.
3938 FRAME t means change the default for new frames.
3939 FRAME 0 means change the face on all frames, and change the default
3941 (face
, attr
, value
, frame
)
3942 Lisp_Object face
, attr
, value
, frame
;
3945 Lisp_Object old_value
= Qnil
;
3946 /* Set 1 if ATTR is QCfont. */
3947 int font_attr_p
= 0;
3948 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3949 int font_related_attr_p
= 0;
3951 CHECK_SYMBOL (face
);
3952 CHECK_SYMBOL (attr
);
3954 face
= resolve_face_name (face
);
3956 /* If FRAME is 0, change face on all frames, and change the
3957 default for new frames. */
3958 if (INTEGERP (frame
) && XINT (frame
) == 0)
3961 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3962 FOR_EACH_FRAME (tail
, frame
)
3963 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3967 /* Set lface to the Lisp attribute vector of FACE. */
3969 lface
= lface_from_face_name (NULL
, face
, 1);
3973 frame
= selected_frame
;
3975 CHECK_LIVE_FRAME (frame
);
3976 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3978 /* If a frame-local face doesn't exist yet, create one. */
3980 lface
= Finternal_make_lisp_face (face
, frame
);
3983 if (EQ (attr
, QCfamily
))
3985 if (!UNSPECIFIEDP (value
))
3987 CHECK_STRING (value
);
3988 if (SCHARS (value
) == 0)
3989 signal_error ("Invalid face family", value
);
3991 old_value
= LFACE_FAMILY (lface
);
3992 LFACE_FAMILY (lface
) = value
;
3993 font_related_attr_p
= 1;
3995 else if (EQ (attr
, QCheight
))
3997 if (!UNSPECIFIEDP (value
))
4001 test
= (EQ (face
, Qdefault
)
4003 /* The default face must have an absolute size,
4004 otherwise, we do a test merge with a random
4005 height to see if VALUE's ok. */
4006 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
4008 if (!INTEGERP (test
) || XINT (test
) <= 0)
4009 signal_error ("Invalid face height", value
);
4012 old_value
= LFACE_HEIGHT (lface
);
4013 LFACE_HEIGHT (lface
) = value
;
4014 font_related_attr_p
= 1;
4016 else if (EQ (attr
, QCweight
))
4018 if (!UNSPECIFIEDP (value
))
4020 CHECK_SYMBOL (value
);
4021 if (face_numeric_weight (value
) < 0)
4022 signal_error ("Invalid face weight", value
);
4024 old_value
= LFACE_WEIGHT (lface
);
4025 LFACE_WEIGHT (lface
) = value
;
4026 font_related_attr_p
= 1;
4028 else if (EQ (attr
, QCslant
))
4030 if (!UNSPECIFIEDP (value
))
4032 CHECK_SYMBOL (value
);
4033 if (face_numeric_slant (value
) < 0)
4034 signal_error ("Invalid face slant", value
);
4036 old_value
= LFACE_SLANT (lface
);
4037 LFACE_SLANT (lface
) = value
;
4038 font_related_attr_p
= 1;
4040 else if (EQ (attr
, QCunderline
))
4042 if (!UNSPECIFIEDP (value
))
4043 if ((SYMBOLP (value
)
4045 && !EQ (value
, Qnil
))
4046 /* Underline color. */
4048 && SCHARS (value
) == 0))
4049 signal_error ("Invalid face underline", value
);
4051 old_value
= LFACE_UNDERLINE (lface
);
4052 LFACE_UNDERLINE (lface
) = value
;
4054 else if (EQ (attr
, QCoverline
))
4056 if (!UNSPECIFIEDP (value
))
4057 if ((SYMBOLP (value
)
4059 && !EQ (value
, Qnil
))
4060 /* Overline color. */
4062 && SCHARS (value
) == 0))
4063 signal_error ("Invalid face overline", value
);
4065 old_value
= LFACE_OVERLINE (lface
);
4066 LFACE_OVERLINE (lface
) = value
;
4068 else if (EQ (attr
, QCstrike_through
))
4070 if (!UNSPECIFIEDP (value
))
4071 if ((SYMBOLP (value
)
4073 && !EQ (value
, Qnil
))
4074 /* Strike-through color. */
4076 && SCHARS (value
) == 0))
4077 signal_error ("Invalid face strike-through", value
);
4079 old_value
= LFACE_STRIKE_THROUGH (lface
);
4080 LFACE_STRIKE_THROUGH (lface
) = value
;
4082 else if (EQ (attr
, QCbox
))
4086 /* Allow t meaning a simple box of width 1 in foreground color
4089 value
= make_number (1);
4091 if (UNSPECIFIEDP (value
))
4093 else if (NILP (value
))
4095 else if (INTEGERP (value
))
4096 valid_p
= XINT (value
) != 0;
4097 else if (STRINGP (value
))
4098 valid_p
= SCHARS (value
) > 0;
4099 else if (CONSP (value
))
4115 if (EQ (k
, QCline_width
))
4117 if (!INTEGERP (v
) || XINT (v
) == 0)
4120 else if (EQ (k
, QCcolor
))
4122 if (!STRINGP (v
) || SCHARS (v
) == 0)
4125 else if (EQ (k
, QCstyle
))
4127 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4134 valid_p
= NILP (tem
);
4140 signal_error ("Invalid face box", value
);
4142 old_value
= LFACE_BOX (lface
);
4143 LFACE_BOX (lface
) = value
;
4145 else if (EQ (attr
, QCinverse_video
)
4146 || EQ (attr
, QCreverse_video
))
4148 if (!UNSPECIFIEDP (value
))
4150 CHECK_SYMBOL (value
);
4151 if (!EQ (value
, Qt
) && !NILP (value
))
4152 signal_error ("Invalid inverse-video face attribute value", value
);
4154 old_value
= LFACE_INVERSE (lface
);
4155 LFACE_INVERSE (lface
) = value
;
4157 else if (EQ (attr
, QCforeground
))
4159 if (!UNSPECIFIEDP (value
))
4161 /* Don't check for valid color names here because it depends
4162 on the frame (display) whether the color will be valid
4163 when the face is realized. */
4164 CHECK_STRING (value
);
4165 if (SCHARS (value
) == 0)
4166 signal_error ("Empty foreground color value", value
);
4168 old_value
= LFACE_FOREGROUND (lface
);
4169 LFACE_FOREGROUND (lface
) = value
;
4171 else if (EQ (attr
, QCbackground
))
4173 if (!UNSPECIFIEDP (value
))
4175 /* Don't check for valid color names here because it depends
4176 on the frame (display) whether the color will be valid
4177 when the face is realized. */
4178 CHECK_STRING (value
);
4179 if (SCHARS (value
) == 0)
4180 signal_error ("Empty background color value", value
);
4182 old_value
= LFACE_BACKGROUND (lface
);
4183 LFACE_BACKGROUND (lface
) = value
;
4185 else if (EQ (attr
, QCstipple
))
4187 #ifdef HAVE_X_WINDOWS
4188 if (!UNSPECIFIEDP (value
)
4190 && NILP (Fbitmap_spec_p (value
)))
4191 signal_error ("Invalid stipple attribute", value
);
4192 old_value
= LFACE_STIPPLE (lface
);
4193 LFACE_STIPPLE (lface
) = value
;
4194 #endif /* HAVE_X_WINDOWS */
4196 else if (EQ (attr
, QCwidth
))
4198 if (!UNSPECIFIEDP (value
))
4200 CHECK_SYMBOL (value
);
4201 if (face_numeric_swidth (value
) < 0)
4202 signal_error ("Invalid face width", value
);
4204 old_value
= LFACE_SWIDTH (lface
);
4205 LFACE_SWIDTH (lface
) = value
;
4206 font_related_attr_p
= 1;
4208 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4210 #ifdef HAVE_WINDOW_SYSTEM
4211 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4213 /* Set font-related attributes of the Lisp face from an XLFD
4219 f
= SELECTED_FRAME ();
4221 f
= check_x_frame (frame
);
4223 if (!UNSPECIFIEDP (value
))
4225 CHECK_STRING (value
);
4227 /* VALUE may be a fontset name or an alias of fontset. In
4228 such a case, use the base fontset name. */
4229 tmp
= Fquery_fontset (value
, Qnil
);
4232 else if (EQ (attr
, QCfontset
))
4233 signal_error ("Invalid fontset name", value
);
4235 if (EQ (attr
, QCfont
))
4237 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4238 signal_error ("Invalid font or fontset name", value
);
4241 LFACE_FONTSET (lface
) = value
;
4246 #endif /* HAVE_WINDOW_SYSTEM */
4248 else if (EQ (attr
, QCinherit
))
4251 if (SYMBOLP (value
))
4254 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4255 if (!SYMBOLP (XCAR (tail
)))
4258 LFACE_INHERIT (lface
) = value
;
4260 signal_error ("Invalid face inheritance", value
);
4262 else if (EQ (attr
, QCbold
))
4264 old_value
= LFACE_WEIGHT (lface
);
4265 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4266 font_related_attr_p
= 1;
4268 else if (EQ (attr
, QCitalic
))
4270 old_value
= LFACE_SLANT (lface
);
4271 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4272 font_related_attr_p
= 1;
4275 signal_error ("Invalid face attribute name", attr
);
4277 if (font_related_attr_p
4278 && !UNSPECIFIEDP (value
))
4279 /* If a font-related attribute other than QCfont is specified, the
4280 original `font' attribute nor that of default face is useless
4281 to determine a new font. Thus, we set it to nil so that font
4282 selection mechanism doesn't use it. */
4283 LFACE_FONT (lface
) = Qnil
;
4285 /* Changing a named face means that all realized faces depending on
4286 that face are invalid. Since we cannot tell which realized faces
4287 depend on the face, make sure they are all removed. This is done
4288 by incrementing face_change_count. The next call to
4289 init_iterator will then free realized faces. */
4291 && (EQ (attr
, QCfont
)
4292 || EQ (attr
, QCfontset
)
4293 || NILP (Fequal (old_value
, value
))))
4295 ++face_change_count
;
4296 ++windows_or_buffers_changed
;
4299 if (!UNSPECIFIEDP (value
)
4300 && NILP (Fequal (old_value
, value
)))
4306 if (EQ (face
, Qdefault
))
4308 #ifdef HAVE_WINDOW_SYSTEM
4309 /* Changed font-related attributes of the `default' face are
4310 reflected in changed `font' frame parameters. */
4312 && (font_related_attr_p
|| font_attr_p
)
4313 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4314 set_font_frame_param (frame
, lface
);
4316 #endif /* HAVE_WINDOW_SYSTEM */
4318 if (EQ (attr
, QCforeground
))
4319 param
= Qforeground_color
;
4320 else if (EQ (attr
, QCbackground
))
4321 param
= Qbackground_color
;
4323 #ifdef HAVE_WINDOW_SYSTEM
4325 else if (EQ (face
, Qscroll_bar
))
4327 /* Changing the colors of `scroll-bar' sets frame parameters
4328 `scroll-bar-foreground' and `scroll-bar-background'. */
4329 if (EQ (attr
, QCforeground
))
4330 param
= Qscroll_bar_foreground
;
4331 else if (EQ (attr
, QCbackground
))
4332 param
= Qscroll_bar_background
;
4334 #endif /* not WINDOWSNT */
4335 else if (EQ (face
, Qborder
))
4337 /* Changing background color of `border' sets frame parameter
4339 if (EQ (attr
, QCbackground
))
4340 param
= Qborder_color
;
4342 else if (EQ (face
, Qcursor
))
4344 /* Changing background color of `cursor' sets frame parameter
4346 if (EQ (attr
, QCbackground
))
4347 param
= Qcursor_color
;
4349 else if (EQ (face
, Qmouse
))
4351 /* Changing background color of `mouse' sets frame parameter
4353 if (EQ (attr
, QCbackground
))
4354 param
= Qmouse_color
;
4356 #endif /* HAVE_WINDOW_SYSTEM */
4357 else if (EQ (face
, Qmenu
))
4359 /* Indicate that we have to update the menu bar when
4360 realizing faces on FRAME. FRAME t change the
4361 default for new frames. We do this by setting
4362 setting the flag in new face caches */
4365 struct frame
*f
= XFRAME (frame
);
4366 if (FRAME_FACE_CACHE (f
) == NULL
)
4367 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4368 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4371 menu_face_changed_default
= 1;
4377 /* Update `default-frame-alist', which is used for new frames. */
4379 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4382 /* Update the current frame's parameters. */
4385 cons
= XCAR (Vparam_value_alist
);
4386 XSETCAR (cons
, param
);
4387 XSETCDR (cons
, value
);
4388 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4397 #ifdef HAVE_WINDOW_SYSTEM
4399 /* Set the `font' frame parameter of FRAME determined from `default'
4400 face attributes LFACE. If a font name is explicitely
4401 specfied in LFACE, use it as is. Otherwise, determine a font name
4402 from the other font-related atrributes of LFACE. In that case, if
4403 there's no matching font, signals an error. */
4406 set_font_frame_param (frame
, lface
)
4407 Lisp_Object frame
, lface
;
4409 struct frame
*f
= XFRAME (frame
);
4411 if (FRAME_WINDOW_P (f
))
4413 Lisp_Object font_name
;
4416 if (STRINGP (LFACE_FONT (lface
)))
4417 font_name
= LFACE_FONT (lface
);
4420 /* Choose a font name that reflects LFACE's attributes and has
4421 the registry and encoding pattern specified in the default
4422 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4423 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
, NULL
);
4425 error ("No font matches the specified attribute");
4426 font_name
= build_string (font
);
4430 f
->default_face_done_p
= 0;
4431 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4436 /* Update the corresponding face when frame parameter PARAM on frame F
4437 has been assigned the value NEW_VALUE. */
4440 update_face_from_frame_parameter (f
, param
, new_value
)
4442 Lisp_Object param
, new_value
;
4446 /* If there are no faces yet, give up. This is the case when called
4447 from Fx_create_frame, and we do the necessary things later in
4448 face-set-after-frame-defaults. */
4449 if (NILP (f
->face_alist
))
4452 /* Changing a named face means that all realized faces depending on
4453 that face are invalid. Since we cannot tell which realized faces
4454 depend on the face, make sure they are all removed. This is done
4455 by incrementing face_change_count. The next call to
4456 init_iterator will then free realized faces. */
4457 ++face_change_count
;
4458 ++windows_or_buffers_changed
;
4460 if (EQ (param
, Qforeground_color
))
4462 lface
= lface_from_face_name (f
, Qdefault
, 1);
4463 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4464 ? new_value
: Qunspecified
);
4465 realize_basic_faces (f
);
4467 else if (EQ (param
, Qbackground_color
))
4471 /* Changing the background color might change the background
4472 mode, so that we have to load new defface specs. Call
4473 frame-update-face-colors to do that. */
4474 XSETFRAME (frame
, f
);
4475 call1 (Qframe_update_face_colors
, frame
);
4477 lface
= lface_from_face_name (f
, Qdefault
, 1);
4478 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4479 ? new_value
: Qunspecified
);
4480 realize_basic_faces (f
);
4482 if (EQ (param
, Qborder_color
))
4484 lface
= lface_from_face_name (f
, Qborder
, 1);
4485 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4486 ? new_value
: Qunspecified
);
4488 else if (EQ (param
, Qcursor_color
))
4490 lface
= lface_from_face_name (f
, Qcursor
, 1);
4491 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4492 ? new_value
: Qunspecified
);
4494 else if (EQ (param
, Qmouse_color
))
4496 lface
= lface_from_face_name (f
, Qmouse
, 1);
4497 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4498 ? new_value
: Qunspecified
);
4503 /* Get the value of X resource RESOURCE, class CLASS for the display
4504 of frame FRAME. This is here because ordinary `x-get-resource'
4505 doesn't take a frame argument. */
4507 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4508 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4509 (resource
, class, frame
)
4510 Lisp_Object resource
, class, frame
;
4512 Lisp_Object value
= Qnil
;
4513 CHECK_STRING (resource
);
4514 CHECK_STRING (class);
4515 CHECK_LIVE_FRAME (frame
);
4517 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4518 resource
, class, Qnil
, Qnil
);
4524 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4525 If VALUE is "on" or "true", return t. If VALUE is "off" or
4526 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4527 error; if SIGNAL_P is zero, return 0. */
4530 face_boolean_x_resource_value (value
, signal_p
)
4534 Lisp_Object result
= make_number (0);
4536 xassert (STRINGP (value
));
4538 if (xstricmp (SDATA (value
), "on") == 0
4539 || xstricmp (SDATA (value
), "true") == 0)
4541 else if (xstricmp (SDATA (value
), "off") == 0
4542 || xstricmp (SDATA (value
), "false") == 0)
4544 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4545 result
= Qunspecified
;
4547 signal_error ("Invalid face attribute value from X resource", value
);
4553 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4554 Finternal_set_lisp_face_attribute_from_resource
,
4555 Sinternal_set_lisp_face_attribute_from_resource
,
4556 3, 4, 0, doc
: /* */)
4557 (face
, attr
, value
, frame
)
4558 Lisp_Object face
, attr
, value
, frame
;
4560 CHECK_SYMBOL (face
);
4561 CHECK_SYMBOL (attr
);
4562 CHECK_STRING (value
);
4564 if (xstricmp (SDATA (value
), "unspecified") == 0)
4565 value
= Qunspecified
;
4566 else if (EQ (attr
, QCheight
))
4568 value
= Fstring_to_number (value
, make_number (10));
4569 if (XINT (value
) <= 0)
4570 signal_error ("Invalid face height from X resource", value
);
4572 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4573 value
= face_boolean_x_resource_value (value
, 1);
4574 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4575 value
= intern (SDATA (value
));
4576 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4577 value
= face_boolean_x_resource_value (value
, 1);
4578 else if (EQ (attr
, QCunderline
)
4579 || EQ (attr
, QCoverline
)
4580 || EQ (attr
, QCstrike_through
))
4582 Lisp_Object boolean_value
;
4584 /* If the result of face_boolean_x_resource_value is t or nil,
4585 VALUE does NOT specify a color. */
4586 boolean_value
= face_boolean_x_resource_value (value
, 0);
4587 if (SYMBOLP (boolean_value
))
4588 value
= boolean_value
;
4590 else if (EQ (attr
, QCbox
))
4591 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4593 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4596 #endif /* HAVE_WINDOW_SYSTEM */
4599 /***********************************************************************
4601 ***********************************************************************/
4603 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4605 /* Make menus on frame F appear as specified by the `menu' face. */
4608 x_update_menu_appearance (f
)
4611 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4615 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4619 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4620 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4621 const char *myname
= SDATA (Vx_resource_name
);
4624 const char *popup_path
= "popup_menu";
4626 const char *popup_path
= "menu.popup";
4629 if (STRINGP (LFACE_FOREGROUND (lface
)))
4631 sprintf (line
, "%s.%s*foreground: %s",
4633 SDATA (LFACE_FOREGROUND (lface
)));
4634 XrmPutLineResource (&rdb
, line
);
4635 sprintf (line
, "%s.pane.menubar*foreground: %s",
4636 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4637 XrmPutLineResource (&rdb
, line
);
4641 if (STRINGP (LFACE_BACKGROUND (lface
)))
4643 sprintf (line
, "%s.%s*background: %s",
4645 SDATA (LFACE_BACKGROUND (lface
)));
4646 XrmPutLineResource (&rdb
, line
);
4647 sprintf (line
, "%s.pane.menubar*background: %s",
4648 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4649 XrmPutLineResource (&rdb
, line
);
4654 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4655 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4656 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4657 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4658 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4659 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4662 const char *suffix
= "List";
4664 const char *suffix
= "";
4666 sprintf (line
, "%s.pane.menubar*font%s: %s",
4667 myname
, suffix
, face
->font_name
);
4668 XrmPutLineResource (&rdb
, line
);
4669 sprintf (line
, "%s.%s*font%s: %s",
4670 myname
, popup_path
, suffix
, face
->font_name
);
4671 XrmPutLineResource (&rdb
, line
);
4675 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4676 free_frame_menubar (f
);
4680 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4683 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4684 Sface_attribute_relative_p
,
4686 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4688 Lisp_Object attribute
, value
;
4690 if (EQ (value
, Qunspecified
))
4692 else if (EQ (attribute
, QCheight
))
4693 return INTEGERP (value
) ? Qnil
: Qt
;
4698 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4700 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4701 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4702 the result will be absolute, otherwise it will be relative. */)
4703 (attribute
, value1
, value2
)
4704 Lisp_Object attribute
, value1
, value2
;
4706 if (EQ (value1
, Qunspecified
))
4708 else if (EQ (attribute
, QCheight
))
4709 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4715 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4716 Sinternal_get_lisp_face_attribute
,
4718 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4719 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4720 face attribute name, signal an error.
4721 If the optional argument FRAME is given, report on face FACE in that
4722 frame. If FRAME is t, report on the defaults for face FACE (for new
4723 frames). If FRAME is omitted or nil, use the selected frame. */)
4724 (symbol
, keyword
, frame
)
4725 Lisp_Object symbol
, keyword
, frame
;
4727 Lisp_Object lface
, value
= Qnil
;
4729 CHECK_SYMBOL (symbol
);
4730 CHECK_SYMBOL (keyword
);
4733 lface
= lface_from_face_name (NULL
, symbol
, 1);
4737 frame
= selected_frame
;
4738 CHECK_LIVE_FRAME (frame
);
4739 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4742 if (EQ (keyword
, QCfamily
))
4743 value
= LFACE_FAMILY (lface
);
4744 else if (EQ (keyword
, QCheight
))
4745 value
= LFACE_HEIGHT (lface
);
4746 else if (EQ (keyword
, QCweight
))
4747 value
= LFACE_WEIGHT (lface
);
4748 else if (EQ (keyword
, QCslant
))
4749 value
= LFACE_SLANT (lface
);
4750 else if (EQ (keyword
, QCunderline
))
4751 value
= LFACE_UNDERLINE (lface
);
4752 else if (EQ (keyword
, QCoverline
))
4753 value
= LFACE_OVERLINE (lface
);
4754 else if (EQ (keyword
, QCstrike_through
))
4755 value
= LFACE_STRIKE_THROUGH (lface
);
4756 else if (EQ (keyword
, QCbox
))
4757 value
= LFACE_BOX (lface
);
4758 else if (EQ (keyword
, QCinverse_video
)
4759 || EQ (keyword
, QCreverse_video
))
4760 value
= LFACE_INVERSE (lface
);
4761 else if (EQ (keyword
, QCforeground
))
4762 value
= LFACE_FOREGROUND (lface
);
4763 else if (EQ (keyword
, QCbackground
))
4764 value
= LFACE_BACKGROUND (lface
);
4765 else if (EQ (keyword
, QCstipple
))
4766 value
= LFACE_STIPPLE (lface
);
4767 else if (EQ (keyword
, QCwidth
))
4768 value
= LFACE_SWIDTH (lface
);
4769 else if (EQ (keyword
, QCinherit
))
4770 value
= LFACE_INHERIT (lface
);
4771 else if (EQ (keyword
, QCfont
))
4772 value
= LFACE_FONT (lface
);
4773 else if (EQ (keyword
, QCfontset
))
4774 value
= LFACE_FONTSET (lface
);
4776 signal_error ("Invalid face attribute name", keyword
);
4782 DEFUN ("internal-lisp-face-attribute-values",
4783 Finternal_lisp_face_attribute_values
,
4784 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4785 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4786 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4790 Lisp_Object result
= Qnil
;
4792 CHECK_SYMBOL (attr
);
4794 if (EQ (attr
, QCweight
)
4795 || EQ (attr
, QCslant
)
4796 || EQ (attr
, QCwidth
))
4798 /* Extract permissible symbols from tables. */
4799 struct table_entry
*table
;
4802 if (EQ (attr
, QCweight
))
4803 table
= weight_table
, dim
= DIM (weight_table
);
4804 else if (EQ (attr
, QCslant
))
4805 table
= slant_table
, dim
= DIM (slant_table
);
4807 table
= swidth_table
, dim
= DIM (swidth_table
);
4809 for (i
= 0; i
< dim
; ++i
)
4811 Lisp_Object symbol
= *table
[i
].symbol
;
4812 Lisp_Object tail
= result
;
4815 && !EQ (XCAR (tail
), symbol
))
4819 result
= Fcons (symbol
, result
);
4822 else if (EQ (attr
, QCunderline
))
4823 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4824 else if (EQ (attr
, QCoverline
))
4825 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4826 else if (EQ (attr
, QCstrike_through
))
4827 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4828 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4829 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4835 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4836 Sinternal_merge_in_global_face
, 2, 2, 0,
4837 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4838 Default face attributes override any local face attributes. */)
4840 Lisp_Object face
, frame
;
4843 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4845 CHECK_LIVE_FRAME (frame
);
4846 global_lface
= lface_from_face_name (NULL
, face
, 1);
4847 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4848 if (NILP (local_lface
))
4849 local_lface
= Finternal_make_lisp_face (face
, frame
);
4851 /* Make every specified global attribute override the local one.
4852 BEWARE!! This is only used from `face-set-after-frame-default' where
4853 the local frame is defined from default specs in `face-defface-spec'
4854 and those should be overridden by global settings. Hence the strange
4855 "global before local" priority. */
4856 lvec
= XVECTOR (local_lface
)->contents
;
4857 gvec
= XVECTOR (global_lface
)->contents
;
4858 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4859 if (! UNSPECIFIEDP (gvec
[i
]))
4866 /* The following function is implemented for compatibility with 20.2.
4867 The function is used in x-resolve-fonts when it is asked to
4868 return fonts with the same size as the font of a face. This is
4869 done in fontset.el. */
4871 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 3, 0,
4872 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4873 The font name is, by default, for ASCII characters.
4874 If the optional argument FRAME is given, report on face FACE in that frame.
4875 If FRAME is t, report on the defaults for face FACE (for new frames).
4876 The font default for a face is either nil, or a list
4877 of the form (bold), (italic) or (bold italic).
4878 If FRAME is omitted or nil, use the selected frame. And, in this case,
4879 if the optional third argument CHARACTER is given,
4880 return the font name used for CHARACTER. */)
4881 (face
, frame
, character
)
4882 Lisp_Object face
, frame
, character
;
4886 Lisp_Object result
= Qnil
;
4887 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4889 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4890 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4891 result
= Fcons (Qbold
, result
);
4893 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4894 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4895 result
= Fcons (Qitalic
, result
);
4901 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4902 int face_id
= lookup_named_face (f
, face
);
4903 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4907 if (NILP (character
))
4908 return build_string (face
->font_name
);
4909 CHECK_CHARACTER (character
);
4910 face_id
= FACE_FOR_CHAR (f
, face
, XINT (character
), -1, Qnil
);
4911 face
= FACE_FROM_ID (f
, face_id
);
4912 return (face
->font
&& face
->font_name
4913 ? build_string (face
->font_name
)
4919 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4920 all attributes are `equal'. Tries to be fast because this function
4921 is called quite often. */
4924 lface_equal_p (v1
, v2
)
4925 Lisp_Object
*v1
, *v2
;
4929 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4931 Lisp_Object a
= v1
[i
];
4932 Lisp_Object b
= v2
[i
];
4934 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4935 and the other is specified. */
4936 equal_p
= XTYPE (a
) == XTYPE (b
);
4945 equal_p
= ((SBYTES (a
)
4947 && bcmp (SDATA (a
), SDATA (b
),
4957 equal_p
= !NILP (Fequal (a
, b
));
4967 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4968 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4969 doc
: /* True if FACE1 and FACE2 are equal.
4970 If the optional argument FRAME is given, report on face FACE in that frame.
4971 If FRAME is t, report on the defaults for face FACE (for new frames).
4972 If FRAME is omitted or nil, use the selected frame. */)
4973 (face1
, face2
, frame
)
4974 Lisp_Object face1
, face2
, frame
;
4977 Lisp_Object lface1
, lface2
;
4979 lface1
= lface_from_face_name (NULL
, face1
, 1);
4980 lface2
= lface_from_face_name (NULL
, face2
, 1);
4981 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4982 XVECTOR (lface2
)->contents
);
4983 return equal_p
? Qt
: Qnil
;
4987 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4988 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4989 doc
: /* True if FACE has no attribute specified.
4990 If the optional argument FRAME is given, report on face FACE in that frame.
4991 If FRAME is t, report on the defaults for face FACE (for new frames).
4992 If FRAME is omitted or nil, use the selected frame. */)
4994 Lisp_Object face
, frame
;
5001 frame
= selected_frame
;
5002 CHECK_LIVE_FRAME (frame
);
5006 lface
= lface_from_face_name (NULL
, face
, 1);
5008 lface
= lface_from_face_name (f
, face
, 1);
5010 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5011 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5014 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5018 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5020 doc
: /* Return an alist of frame-local faces defined on FRAME.
5021 For internal use only. */)
5025 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5026 return f
->face_alist
;
5030 /* Return a hash code for Lisp string STRING with case ignored. Used
5031 below in computing a hash value for a Lisp face. */
5033 static INLINE
unsigned
5034 hash_string_case_insensitive (string
)
5037 const unsigned char *s
;
5039 xassert (STRINGP (string
));
5040 for (s
= SDATA (string
); *s
; ++s
)
5041 hash
= (hash
<< 1) ^ tolower (*s
);
5046 /* Return a hash code for face attribute vector V. */
5048 static INLINE
unsigned
5052 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5053 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5054 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5055 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5056 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5057 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5058 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5062 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5063 considering charsets/registries). They do if they specify the same
5064 family, point size, weight, width, slant, font, and fontset. Both
5065 LFACE1 and LFACE2 must be fully-specified. */
5068 lface_same_font_attributes_p (lface1
, lface2
)
5069 Lisp_Object
*lface1
, *lface2
;
5071 xassert (lface_fully_specified_p (lface1
)
5072 && lface_fully_specified_p (lface2
));
5073 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5074 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5075 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5076 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5077 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5078 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5079 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5080 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5081 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5082 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5083 && ! xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5084 SDATA (lface2
[LFACE_FONT_INDEX
]))))
5085 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5086 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5087 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5088 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
5089 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
5095 /***********************************************************************
5097 ***********************************************************************/
5099 /* Allocate and return a new realized face for Lisp face attribute
5102 static struct face
*
5103 make_realized_face (attr
)
5106 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5107 bzero (face
, sizeof *face
);
5108 face
->ascii_face
= face
;
5109 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5114 /* Free realized face FACE, including its X resources. FACE may
5118 free_realized_face (f
, face
)
5124 #ifdef HAVE_WINDOW_SYSTEM
5125 if (FRAME_WINDOW_P (f
))
5127 /* Free fontset of FACE if it is ASCII face. */
5128 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5129 free_face_fontset (f
, face
);
5132 x_free_gc (f
, face
->gc
);
5136 free_face_colors (f
, face
);
5137 x_destroy_bitmap (f
, face
->stipple
);
5139 #endif /* HAVE_WINDOW_SYSTEM */
5146 /* Prepare face FACE for subsequent display on frame F. This
5147 allocated GCs if they haven't been allocated yet or have been freed
5148 by clearing the face cache. */
5151 prepare_face_for_display (f
, face
)
5155 #ifdef HAVE_WINDOW_SYSTEM
5156 xassert (FRAME_WINDOW_P (f
));
5161 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5163 xgcv
.foreground
= face
->foreground
;
5164 xgcv
.background
= face
->background
;
5165 #ifdef HAVE_X_WINDOWS
5166 xgcv
.graphics_exposures
= False
;
5168 /* The font of FACE may be null if we couldn't load it. */
5171 #ifdef HAVE_X_WINDOWS
5172 xgcv
.font
= face
->font
->fid
;
5175 xgcv
.font
= face
->font
;
5178 xgcv
.font
= face
->font
;
5184 #ifdef HAVE_X_WINDOWS
5187 xgcv
.fill_style
= FillOpaqueStippled
;
5188 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5189 mask
|= GCFillStyle
| GCStipple
;
5192 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5195 #endif /* HAVE_WINDOW_SYSTEM */
5199 /* Returns the `distance' between the colors X and Y. */
5202 color_distance (x
, y
)
5205 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5206 Quoting from that paper:
5208 This formula has results that are very close to L*u*v* (with the
5209 modified lightness curve) and, more importantly, it is a more even
5210 algorithm: it does not have a range of colours where it suddenly
5211 gives far from optimal results.
5213 See <http://www.compuphase.com/cmetric.htm> for more info. */
5215 long r
= (x
->red
- y
->red
) >> 8;
5216 long g
= (x
->green
- y
->green
) >> 8;
5217 long b
= (x
->blue
- y
->blue
) >> 8;
5218 long r_mean
= (x
->red
+ y
->red
) >> 9;
5221 (((512 + r_mean
) * r
* r
) >> 8)
5223 + (((767 - r_mean
) * b
* b
) >> 8);
5227 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5228 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5229 COLOR1 and COLOR2 may be either strings containing the color name,
5230 or lists of the form (RED GREEN BLUE).
5231 If FRAME is unspecified or nil, the current frame is used. */)
5232 (color1
, color2
, frame
)
5233 Lisp_Object color1
, color2
, frame
;
5236 XColor cdef1
, cdef2
;
5239 frame
= selected_frame
;
5240 CHECK_LIVE_FRAME (frame
);
5243 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5244 || !STRINGP (color1
)
5245 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5246 signal_error ("Invalid color", color1
);
5247 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5248 || !STRINGP (color2
)
5249 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5250 signal_error ("Invalid color", color2
);
5252 return make_number (color_distance (&cdef1
, &cdef2
));
5256 /***********************************************************************
5257 Face capability testing for ttys
5258 ***********************************************************************/
5261 /* If the distance (as returned by color_distance) between two colors is
5262 less than this, then they are considered the same, for determining
5263 whether a color is supported or not. The range of values is 0-65535. */
5265 #define TTY_SAME_COLOR_THRESHOLD 10000
5268 DEFUN ("tty-supports-face-attributes-p",
5269 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5271 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5272 The optional argument FRAME is the frame on which to test; if it is nil
5273 or unspecified, then the current frame is used. If FRAME is not a tty
5274 frame, then nil is returned.
5276 The definition of `supported' is somewhat heuristic, but basically means
5277 that a face containing all the attributes in ATTRIBUTES, when merged
5278 with the default face for display, can be represented in a way that's
5280 \(1) different in appearance than the default face, and
5281 \(2) `close in spirit' to what the attributes specify, if not exact.
5283 Point (2) implies that a `:weight black' attribute will be satisified
5284 by any terminal that can display bold, and a `:foreground "yellow"' as
5285 long as the terminal can display a yellowish color, but `:slant italic'
5286 will _not_ be satisified by the tty display code's automatic
5287 substitution of a `dim' face for italic. */)
5289 Lisp_Object attributes
, frame
;
5293 Lisp_Object val
, fg
, bg
;
5294 XColor fg_tty_color
, fg_std_color
;
5295 XColor bg_tty_color
, bg_std_color
;
5296 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5297 unsigned test_caps
= 0;
5300 frame
= selected_frame
;
5301 CHECK_LIVE_FRAME (frame
);
5304 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5305 attrs
[i
] = Qunspecified
;
5306 merge_face_vector_with_property (f
, attrs
, attributes
);
5308 /* This function only works on ttys. */
5309 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5312 /* First check some easy-to-check stuff; ttys support none of the
5313 following attributes, so we can just return nil if any are requested. */
5316 val
= attrs
[LFACE_STIPPLE_INDEX
];
5317 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5321 val
= attrs
[LFACE_HEIGHT_INDEX
];
5322 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5326 val
= attrs
[LFACE_SWIDTH_INDEX
];
5327 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5328 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5332 val
= attrs
[LFACE_OVERLINE_INDEX
];
5333 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5336 /* strike-through */
5337 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5338 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5342 val
= attrs
[LFACE_BOX_INDEX
];
5343 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5346 /* slant (italics/oblique); We consider any non-default value
5347 unsupportable on ttys, even though the face code actually `fakes'
5348 them using a dim attribute if possible. This is because the faked
5349 result is too different from what the face specifies. */
5350 val
= attrs
[LFACE_SLANT_INDEX
];
5351 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5352 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5356 /* Test for terminal `capabilities' (non-color character attributes). */
5358 /* font weight (bold/dim) */
5359 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5362 if (weight
> XLFD_WEIGHT_MEDIUM
)
5363 test_caps
= TTY_CAP_BOLD
;
5364 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5365 test_caps
= TTY_CAP_DIM
;
5369 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5370 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5373 return Qnil
; /* ttys don't support colored underlines */
5375 test_caps
|= TTY_CAP_UNDERLINE
;
5379 val
= attrs
[LFACE_INVERSE_INDEX
];
5380 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5381 test_caps
|= TTY_CAP_INVERSE
;
5384 /* Color testing. */
5386 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5387 we use them when calling `tty_capable_p' below, even if the face
5388 specifies no colors. */
5389 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5390 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5392 /* Check if foreground color is close enough. */
5393 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5396 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5398 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5399 > TTY_SAME_COLOR_THRESHOLD
)
5403 /* Check if background color is close enough. */
5404 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5407 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5409 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5410 > TTY_SAME_COLOR_THRESHOLD
)
5414 /* If both foreground and background are requested, see if the
5415 distance between them is OK. We just check to see if the distance
5416 between the tty's foreground and background is close enough to the
5417 distance between the standard foreground and background. */
5418 if (STRINGP (fg
) && STRINGP (bg
))
5421 = (color_distance (&fg_std_color
, &bg_std_color
)
5422 - color_distance (&fg_tty_color
, &bg_tty_color
));
5423 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5424 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5429 /* See if the capabilities we selected above are supported, with the
5431 if (test_caps
!= 0 &&
5432 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5436 /* Hmmm, everything checks out, this terminal must support this face. */
5442 /***********************************************************************
5444 ***********************************************************************/
5446 /* Return a new face cache for frame F. */
5448 static struct face_cache
*
5452 struct face_cache
*c
;
5455 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5456 bzero (c
, sizeof *c
);
5457 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5458 c
->buckets
= (struct face
**) xmalloc (size
);
5459 bzero (c
->buckets
, size
);
5461 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5463 c
->menu_face_changed_p
= menu_face_changed_default
;
5468 /* Clear out all graphics contexts for all realized faces, except for
5469 the basic faces. This should be done from time to time just to avoid
5470 keeping too many graphics contexts that are no longer needed. */
5474 struct face_cache
*c
;
5476 if (c
&& FRAME_WINDOW_P (c
->f
))
5478 #ifdef HAVE_WINDOW_SYSTEM
5480 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5482 struct face
*face
= c
->faces_by_id
[i
];
5483 if (face
&& face
->gc
)
5485 x_free_gc (c
->f
, face
->gc
);
5489 #endif /* HAVE_WINDOW_SYSTEM */
5494 /* Free all realized faces in face cache C, including basic faces. C
5495 may be null. If faces are freed, make sure the frame's current
5496 matrix is marked invalid, so that a display caused by an expose
5497 event doesn't try to use faces we destroyed. */
5500 free_realized_faces (c
)
5501 struct face_cache
*c
;
5506 struct frame
*f
= c
->f
;
5508 /* We must block input here because we can't process X events
5509 safely while only some faces are freed, or when the frame's
5510 current matrix still references freed faces. */
5513 for (i
= 0; i
< c
->used
; ++i
)
5515 free_realized_face (f
, c
->faces_by_id
[i
]);
5516 c
->faces_by_id
[i
] = NULL
;
5520 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5521 bzero (c
->buckets
, size
);
5523 /* Must do a thorough redisplay the next time. Mark current
5524 matrices as invalid because they will reference faces freed
5525 above. This function is also called when a frame is
5526 destroyed. In this case, the root window of F is nil. */
5527 if (WINDOWP (f
->root_window
))
5529 clear_current_matrices (f
);
5530 ++windows_or_buffers_changed
;
5538 /* Free all realized faces that are using FONTSET on frame F. */
5541 free_realized_faces_for_fontset (f
, fontset
)
5545 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5549 /* We must block input here because we can't process X events safely
5550 while only some faces are freed, or when the frame's current
5551 matrix still references freed faces. */
5554 for (i
= 0; i
< cache
->used
; i
++)
5556 face
= cache
->faces_by_id
[i
];
5558 && face
->fontset
== fontset
)
5560 uncache_face (cache
, face
);
5561 free_realized_face (f
, face
);
5565 /* Must do a thorough redisplay the next time. Mark current
5566 matrices as invalid because they will reference faces freed
5567 above. This function is also called when a frame is destroyed.
5568 In this case, the root window of F is nil. */
5569 if (WINDOWP (f
->root_window
))
5571 clear_current_matrices (f
);
5572 ++windows_or_buffers_changed
;
5579 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5580 This is done after attributes of a named face have been changed,
5581 because we can't tell which realized faces depend on that face. */
5584 free_all_realized_faces (frame
)
5590 FOR_EACH_FRAME (rest
, frame
)
5591 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5594 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5598 /* Free face cache C and faces in it, including their X resources. */
5602 struct face_cache
*c
;
5606 free_realized_faces (c
);
5608 xfree (c
->faces_by_id
);
5614 /* Cache realized face FACE in face cache C. HASH is the hash value
5615 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5616 FACE), insert the new face to the beginning of the collision list
5617 of the face hash table of C. Otherwise, add the new face to the
5618 end of the collision list. This way, lookup_face can quickly find
5619 that a requested face is not cached. */
5622 cache_face (c
, face
, hash
)
5623 struct face_cache
*c
;
5627 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5631 if (face
->ascii_face
!= face
)
5633 struct face
*last
= c
->buckets
[i
];
5644 c
->buckets
[i
] = face
;
5645 face
->prev
= face
->next
= NULL
;
5651 face
->next
= c
->buckets
[i
];
5653 face
->next
->prev
= face
;
5654 c
->buckets
[i
] = face
;
5657 /* Find a free slot in C->faces_by_id and use the index of the free
5658 slot as FACE->id. */
5659 for (i
= 0; i
< c
->used
; ++i
)
5660 if (c
->faces_by_id
[i
] == NULL
)
5664 /* Maybe enlarge C->faces_by_id. */
5665 if (i
== c
->used
&& c
->used
== c
->size
)
5667 int new_size
= 2 * c
->size
;
5668 int sz
= new_size
* sizeof *c
->faces_by_id
;
5669 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5674 /* Check that FACE got a unique id. */
5679 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5680 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5686 #endif /* GLYPH_DEBUG */
5688 c
->faces_by_id
[i
] = face
;
5694 /* Remove face FACE from cache C. */
5697 uncache_face (c
, face
)
5698 struct face_cache
*c
;
5701 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5704 face
->prev
->next
= face
->next
;
5706 c
->buckets
[i
] = face
->next
;
5709 face
->next
->prev
= face
->prev
;
5711 c
->faces_by_id
[face
->id
] = NULL
;
5712 if (face
->id
== c
->used
)
5717 /* Look up a realized face with face attributes ATTR in the face cache
5718 of frame F. The face will be used to display ASCII characters.
5719 Value is the ID of the face found. If no suitable face is found,
5720 realize a new one. */
5723 lookup_face (f
, attr
)
5727 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5732 xassert (cache
!= NULL
);
5733 check_lface_attrs (attr
);
5735 /* Look up ATTR in the face cache. */
5736 hash
= lface_hash (attr
);
5737 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5739 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5741 if (face
->ascii_face
!= face
)
5743 /* There's no more ASCII face. */
5747 if (face
->hash
== hash
5748 && lface_equal_p (face
->lface
, attr
))
5752 /* If not found, realize a new face. */
5754 face
= realize_face (cache
, attr
, -1);
5757 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5758 #endif /* GLYPH_DEBUG */
5764 /* Look up a realized face that has the same attributes as BASE_FACE
5765 except for the font in the face cache of frame F. If FONT_ID is
5766 not negative, it is an ID number of an already opened font that is
5767 used by the face. If FONT_ID is negative, the face has no font.
5768 Value is the ID of the face found. If no suitable face is found,
5769 realize a new one. */
5772 lookup_non_ascii_face (f
, font_id
, base_face
)
5775 struct face
*base_face
;
5777 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5782 xassert (cache
!= NULL
);
5783 base_face
= base_face
->ascii_face
;
5784 hash
= lface_hash (base_face
->lface
);
5785 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5787 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5789 if (face
->ascii_face
== face
)
5791 if (face
->ascii_face
== base_face
5792 && face
->font_info_id
== font_id
)
5796 /* If not found, realize a new face. */
5798 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5801 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5802 #endif /* GLYPH_DEBUG */
5807 /* Return the face id of the realized face for named face SYMBOL on
5808 frame F suitable for displaying ASCII characters. Value is -1 if
5809 the face couldn't be determined, which might happen if the default
5810 face isn't realized and cannot be realized. */
5813 lookup_named_face (f
, symbol
)
5817 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5818 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5819 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5821 if (default_face
== NULL
)
5823 if (!realize_basic_faces (f
))
5825 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5828 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5829 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5830 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5831 return lookup_face (f
, attrs
);
5835 /* Return the ID of the realized ASCII face of Lisp face with ID
5836 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5839 ascii_face_of_lisp_face (f
, lface_id
)
5845 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5847 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5848 face_id
= lookup_named_face (f
, face_name
);
5857 /* Return a face for charset ASCII that is like the face with id
5858 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5859 STEPS < 0 means larger. Value is the id of the face. */
5862 smaller_face (f
, face_id
, steps
)
5866 #ifdef HAVE_WINDOW_SYSTEM
5868 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5869 int pt
, last_pt
, last_height
;
5872 struct face
*new_face
;
5874 /* If not called for an X frame, just return the original face. */
5875 if (FRAME_TERMCAP_P (f
))
5878 /* Try in increments of 1/2 pt. */
5879 delta
= steps
< 0 ? 5 : -5;
5880 steps
= abs (steps
);
5882 face
= FACE_FROM_ID (f
, face_id
);
5883 bcopy (face
->lface
, attrs
, sizeof attrs
);
5884 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5885 new_face_id
= face_id
;
5886 last_height
= FONT_HEIGHT (face
->font
);
5890 /* Give up if we cannot find a font within 10pt. */
5891 && abs (last_pt
- pt
) < 100)
5893 /* Look up a face for a slightly smaller/larger font. */
5895 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5896 new_face_id
= lookup_face (f
, attrs
);
5897 new_face
= FACE_FROM_ID (f
, new_face_id
);
5899 /* If height changes, count that as one step. */
5900 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5901 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5904 last_height
= FONT_HEIGHT (new_face
->font
);
5911 #else /* not HAVE_WINDOW_SYSTEM */
5915 #endif /* not HAVE_WINDOW_SYSTEM */
5919 /* Return a face for charset ASCII that is like the face with id
5920 FACE_ID on frame F, but has height HEIGHT. */
5923 face_with_height (f
, face_id
, height
)
5928 #ifdef HAVE_WINDOW_SYSTEM
5930 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5932 if (FRAME_TERMCAP_P (f
)
5936 face
= FACE_FROM_ID (f
, face_id
);
5937 bcopy (face
->lface
, attrs
, sizeof attrs
);
5938 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5939 face_id
= lookup_face (f
, attrs
);
5940 #endif /* HAVE_WINDOW_SYSTEM */
5946 /* Return the face id of the realized face for named face SYMBOL on
5947 frame F suitable for displaying ASCII characters, and use
5948 attributes of the face FACE_ID for attributes that aren't
5949 completely specified by SYMBOL. This is like lookup_named_face,
5950 except that the default attributes come from FACE_ID, not from the
5951 default face. FACE_ID is assumed to be already realized. */
5954 lookup_derived_face (f
, symbol
, face_id
)
5959 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5960 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5961 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5966 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5967 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5968 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5969 return lookup_face (f
, attrs
);
5972 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5973 Sface_attributes_as_vector
, 1, 1, 0,
5974 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5979 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5981 merge_face_vector_with_property (XFRAME (selected_frame
),
5982 XVECTOR (lface
)->contents
,
5989 /***********************************************************************
5991 ***********************************************************************/
5993 DEFUN ("internal-set-font-selection-order",
5994 Finternal_set_font_selection_order
,
5995 Sinternal_set_font_selection_order
, 1, 1, 0,
5996 doc
: /* Set font selection order for face font selection to ORDER.
5997 ORDER must be a list of length 4 containing the symbols `:width',
5998 `:height', `:weight', and `:slant'. Face attributes appearing
5999 first in ORDER are matched first, e.g. if `:height' appears before
6000 `:weight' in ORDER, font selection first tries to find a font with
6001 a suitable height, and then tries to match the font weight.
6008 int indices
[DIM (font_sort_order
)];
6011 bzero (indices
, sizeof indices
);
6015 CONSP (list
) && i
< DIM (indices
);
6016 list
= XCDR (list
), ++i
)
6018 Lisp_Object attr
= XCAR (list
);
6021 if (EQ (attr
, QCwidth
))
6023 else if (EQ (attr
, QCheight
))
6024 xlfd
= XLFD_POINT_SIZE
;
6025 else if (EQ (attr
, QCweight
))
6027 else if (EQ (attr
, QCslant
))
6032 if (indices
[i
] != 0)
6037 if (!NILP (list
) || i
!= DIM (indices
))
6038 signal_error ("Invalid font sort order", order
);
6039 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6040 if (indices
[i
] == 0)
6041 signal_error ("Invalid font sort order", order
);
6043 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6045 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6046 free_all_realized_faces (Qnil
);
6053 DEFUN ("internal-set-alternative-font-family-alist",
6054 Finternal_set_alternative_font_family_alist
,
6055 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6056 doc
: /* Define alternative font families to try in face font selection.
6057 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6058 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6059 be found. Value is ALIST. */)
6064 Vface_alternative_font_family_alist
= alist
;
6065 free_all_realized_faces (Qnil
);
6070 DEFUN ("internal-set-alternative-font-registry-alist",
6071 Finternal_set_alternative_font_registry_alist
,
6072 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6073 doc
: /* Define alternative font registries to try in face font selection.
6074 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6075 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6076 be found. Value is ALIST. */)
6081 Vface_alternative_font_registry_alist
= alist
;
6082 free_all_realized_faces (Qnil
);
6087 #ifdef HAVE_WINDOW_SYSTEM
6089 /* Value is non-zero if FONT is the name of a scalable font. The
6090 X11R6 XLFD spec says that point size, pixel size, and average width
6091 are zero for scalable fonts. Intlfonts contain at least one
6092 scalable font ("*-muleindian-1") for which this isn't true, so we
6093 just test average width. */
6096 font_scalable_p (font
)
6097 struct font_name
*font
;
6099 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6100 return (*s
== '0' && *(s
+ 1) == '\0')
6102 /* Windows implementation of XLFD is slightly broken for backward
6103 compatibility with previous broken versions, so test for
6104 wildcards as well as 0. */
6111 /* Ignore the difference of font point size less than this value. */
6113 #define FONT_POINT_SIZE_QUANTUM 5
6115 /* Value is non-zero if FONT1 is a better match for font attributes
6116 VALUES than FONT2. VALUES is an array of face attribute values in
6117 font sort order. COMPARE_PT_P zero means don't compare point
6118 sizes. AVGWIDTH, if not zero, is a specified font average width
6122 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6124 struct font_name
*font1
, *font2
;
6125 int compare_pt_p
, avgwidth
;
6129 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6131 int xlfd_idx
= font_sort_order
[i
];
6133 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6137 if (xlfd_idx
== XLFD_POINT_SIZE
)
6139 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6140 / font1
->rescale_ratio
));
6141 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6142 / font2
->rescale_ratio
));
6143 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6148 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6149 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6152 if (delta1
> delta2
)
6154 else if (delta1
< delta2
)
6158 /* The difference may be equal because, e.g., the face
6159 specifies `italic' but we have only `regular' and
6160 `oblique'. Prefer `oblique' in this case. */
6161 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6162 && font1
->numeric
[xlfd_idx
] > values
[i
]
6163 && font2
->numeric
[xlfd_idx
] < values
[i
])
6171 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6172 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6173 if (delta1
> delta2
)
6175 else if (delta1
< delta2
)
6179 return font1
->registry_priority
< font2
->registry_priority
;
6183 /* Value is non-zero if FONT is an exact match for face attributes in
6184 SPECIFIED. SPECIFIED is an array of face attribute values in font
6185 sort order. AVGWIDTH, if non-zero, is an average width to compare
6189 exact_face_match_p (specified
, font
, avgwidth
)
6191 struct font_name
*font
;
6196 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6197 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6200 return (i
== DIM (font_sort_order
)
6202 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6206 /* Value is the name of a scaled font, generated from scalable font
6207 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6208 Value is allocated from heap. */
6211 build_scalable_font_name (f
, font
, specified_pt
)
6213 struct font_name
*font
;
6216 char pixel_size
[20];
6218 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6221 if (font
->numeric
[XLFD_PIXEL_SIZE
] != 0
6222 || font
->numeric
[XLFD_POINT_SIZE
] != 0)
6223 /* This is a scalable font but is requested for a specific size.
6224 We should not change that size. */
6225 return build_font_name (font
);
6227 /* If scalable font is for a specific resolution, compute
6228 the point size we must specify from the resolution of
6229 the display and the specified resolution of the font. */
6230 if (font
->numeric
[XLFD_RESY
] != 0)
6232 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6233 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6238 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6240 /* We may need a font of the different size. */
6241 pixel_value
*= font
->rescale_ratio
;
6243 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6244 font of the specified PIXEL_SIZE. */
6246 { /* Set point size of the font. */
6247 char point_size
[20];
6248 sprintf (point_size
, "%d", (int) pt
);
6249 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6250 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6254 /* Set pixel size. */
6255 sprintf (pixel_size
, "%d", pixel_value
);
6256 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6257 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6259 /* If font doesn't specify its resolution, use the
6260 resolution of the display. */
6261 if (font
->numeric
[XLFD_RESY
] == 0)
6264 sprintf (buffer
, "%d", (int) resy
);
6265 font
->fields
[XLFD_RESY
] = buffer
;
6266 font
->numeric
[XLFD_RESY
] = resy
;
6269 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6272 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6273 sprintf (buffer
, "%d", resx
);
6274 font
->fields
[XLFD_RESX
] = buffer
;
6275 font
->numeric
[XLFD_RESX
] = resx
;
6278 return build_font_name (font
);
6282 /* Value is non-zero if we are allowed to use scalable font FONT. We
6283 can't run a Lisp function here since this function may be called
6284 with input blocked. */
6287 may_use_scalable_font_p (font
)
6290 if (EQ (Vscalable_fonts_allowed
, Qt
))
6292 else if (CONSP (Vscalable_fonts_allowed
))
6294 Lisp_Object tail
, regexp
;
6296 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6298 regexp
= XCAR (tail
);
6299 if (STRINGP (regexp
)
6300 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6310 /* Return the name of the best matching font for face attributes ATTRS
6311 in the array of font_name structures FONTS which contains NFONTS
6312 elements. WIDTH_RATIO is a factor with which to multiply average
6313 widths if ATTRS specifies such a width.
6315 Value is a font name which is allocated from the heap. FONTS is
6316 freed by this function.
6318 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6319 indicate whether the resulting font should be drawn using overstrike
6320 to simulate bold-face. */
6323 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6326 struct font_name
*fonts
;
6329 int *needs_overstrike
;
6332 struct font_name
*best
;
6335 int exact_p
, avgwidth
;
6340 /* Make specified font attributes available in `specified',
6341 indexed by sort order. */
6342 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6344 int xlfd_idx
= font_sort_order
[i
];
6346 if (xlfd_idx
== XLFD_SWIDTH
)
6347 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6348 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6349 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6350 else if (xlfd_idx
== XLFD_WEIGHT
)
6351 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6352 else if (xlfd_idx
== XLFD_SLANT
)
6353 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6358 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6360 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6364 if (needs_overstrike
)
6365 *needs_overstrike
= 0;
6367 /* Start with the first non-scalable font in the list. */
6368 for (i
= 0; i
< nfonts
; ++i
)
6369 if (!font_scalable_p (fonts
+ i
))
6372 /* Find the best match among the non-scalable fonts. */
6377 for (i
= 1; i
< nfonts
; ++i
)
6378 if (!font_scalable_p (fonts
+ i
)
6379 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6383 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6391 /* Unless we found an exact match among non-scalable fonts, see if
6392 we can find a better match among scalable fonts. */
6395 /* A scalable font is better if
6397 1. its weight, slant, swidth attributes are better, or.
6399 2. the best non-scalable font doesn't have the required
6400 point size, and the scalable fonts weight, slant, swidth
6403 int non_scalable_has_exact_height_p
;
6405 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6406 non_scalable_has_exact_height_p
= 1;
6408 non_scalable_has_exact_height_p
= 0;
6410 for (i
= 0; i
< nfonts
; ++i
)
6411 if (font_scalable_p (fonts
+ i
))
6414 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6415 || (!non_scalable_has_exact_height_p
6416 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6420 if (needs_overstrike
)
6422 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6423 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6425 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6427 /* We want a bold font, but didn't get one; try to use
6428 overstriking instead to simulate bold-face. However,
6429 don't overstrike an already-bold fontn unless the
6430 desired weight grossly exceeds the available weight. */
6431 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6432 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6434 *needs_overstrike
= 1;
6439 if (font_scalable_p (best
))
6440 font_name
= build_scalable_font_name (f
, best
, pt
);
6442 font_name
= build_font_name (best
);
6444 /* Free font_name structures. */
6445 free_font_names (fonts
, nfonts
);
6451 /* Get a list of matching fonts on frame F, considering FAMILY
6452 and alternative font families from Vface_alternative_font_registry_alist.
6454 FAMILY is the font family whose alternatives are considered.
6456 REGISTRY, if a string, specifies a font registry and encoding to
6457 match. A value of nil means include fonts of any registry and
6460 Return in *FONTS a pointer to a vector of font_name structures for
6461 the fonts matched. Value is the number of fonts found. */
6464 try_alternative_families (f
, family
, registry
, fonts
)
6466 Lisp_Object family
, registry
;
6467 struct font_name
**fonts
;
6472 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6475 /* Try alternative font families. */
6476 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6479 for (alter
= XCDR (alter
);
6480 CONSP (alter
) && nfonts
== 0;
6481 alter
= XCDR (alter
))
6483 if (STRINGP (XCAR (alter
)))
6484 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6488 /* Try all scalable fonts before giving up. */
6489 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6491 int count
= SPECPDL_INDEX ();
6492 specbind (Qscalable_fonts_allowed
, Qt
);
6493 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6494 unbind_to (count
, Qnil
);
6501 /* Get a list of matching fonts on frame F.
6503 PATTERN, if a string, specifies a font name pattern to match while
6504 ignoring FAMILY and REGISTRY.
6506 FAMILY, if a list, specifies a list of font families to try.
6508 REGISTRY, if a list, specifies a list of font registries and
6511 Return in *FONTS a pointer to a vector of font_name structures for
6512 the fonts matched. Value is the number of fonts found. */
6515 try_font_list (f
, pattern
, family
, registry
, fonts
)
6517 Lisp_Object pattern
, family
, registry
;
6518 struct font_name
**fonts
;
6522 if (STRINGP (pattern
))
6524 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6525 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6527 int count
= SPECPDL_INDEX ();
6528 specbind (Qscalable_fonts_allowed
, Qt
);
6529 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6530 unbind_to (count
, Qnil
);
6538 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6540 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6541 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6543 /* Try font family of the default face or "fixed". */
6544 if (nfonts
== 0 && !NILP (family
))
6546 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6548 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6550 family
= build_string ("fixed");
6551 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6554 /* Try any family with the given registry. */
6555 if (nfonts
== 0 && !NILP (family
))
6556 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6563 /* Return the fontset id of the base fontset name or alias name given
6564 by the fontset attribute of ATTRS. Value is -1 if the fontset
6565 attribute of ATTRS doesn't name a fontset. */
6568 face_fontset (attrs
)
6573 name
= attrs
[LFACE_FONTSET_INDEX
];
6574 if (!STRINGP (name
))
6576 return fs_query_fontset (name
, 0);
6580 /* Choose a name of font to use on frame F to display characters with
6581 Lisp face attributes specified by ATTRS. The font name is
6582 determined by the font-related attributes in ATTRS and FONT-SPEC
6585 When we are choosing a font for ASCII characters, FONT-SPEC is
6586 always nil. Otherwise FONT-SPEC is a list
6587 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6588 or a string specifying a font name pattern.
6590 If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
6591 indicate whether the resulting font should be drawn using
6592 overstrike to simulate bold-face.
6594 Value is the font name which is allocated from the heap and must be
6595 freed by the caller. */
6598 choose_face_font (f
, attrs
, font_spec
, needs_overstrike
)
6601 Lisp_Object font_spec
;
6602 int *needs_overstrike
;
6604 Lisp_Object pattern
, family
, adstyle
, registry
;
6605 char *font_name
= NULL
;
6606 struct font_name
*fonts
;
6609 if (needs_overstrike
)
6610 *needs_overstrike
= 0;
6612 /* If we are choosing an ASCII font and a font name is explicitly
6613 specified in ATTRS, return it. */
6614 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6615 return xstrdup (SDATA (attrs
[LFACE_FONT_INDEX
]));
6617 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6620 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6622 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6623 ADSTYLE is not used in the font selector for the moment. */
6624 if (VECTORP (font_spec
))
6627 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6628 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6629 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6630 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6632 else if (STRINGP (font_spec
))
6634 pattern
= font_spec
;
6641 /* We are choosing an ASCII font. By default, use the registry
6642 name "iso8859-1". But, if the registry name of the ASCII
6643 font specified in the fontset of ATTRS is not "iso8859-1"
6644 (e.g "iso10646-1"), use also that name with higher
6646 int fontset
= face_fontset (attrs
);
6649 struct font_name font
;
6653 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
6655 ascii
= fontset_ascii (fontset
);
6656 len
= SBYTES (ascii
);
6658 || strcmp (SDATA (ascii
) + len
- 9, "iso8859-1"))
6660 font
.name
= LSTRDUPA (ascii
);
6661 /* Check if the name is in XLFD. */
6662 if (split_font_name (f
, &font
, 0))
6664 font
.fields
[XLFD_ENCODING
][-1] = '-';
6665 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
6671 /* Get a list of fonts matching that pattern and choose the
6672 best match for the specified face attributes from it. */
6673 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6674 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
),
6679 #endif /* HAVE_WINDOW_SYSTEM */
6683 /***********************************************************************
6685 ***********************************************************************/
6687 /* Realize basic faces on frame F. Value is zero if frame parameters
6688 of F don't contain enough information needed to realize the default
6692 realize_basic_faces (f
)
6696 int count
= SPECPDL_INDEX ();
6698 /* Block input here so that we won't be surprised by an X expose
6699 event, for instance, without having the faces set up. */
6701 specbind (Qscalable_fonts_allowed
, Qt
);
6703 if (realize_default_face (f
))
6705 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6706 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6707 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6708 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6709 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6710 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6711 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6712 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6713 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6714 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6716 /* Reflect changes in the `menu' face in menu bars. */
6717 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6719 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6720 #ifdef USE_X_TOOLKIT
6721 x_update_menu_appearance (f
);
6728 unbind_to (count
, Qnil
);
6734 /* Realize the default face on frame F. If the face is not fully
6735 specified, make it fully-specified. Attributes of the default face
6736 that are not explicitly specified are taken from frame parameters. */
6739 realize_default_face (f
)
6742 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6744 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6745 Lisp_Object frame_font
;
6748 /* If the `default' face is not yet known, create it. */
6749 lface
= lface_from_face_name (f
, Qdefault
, 0);
6753 XSETFRAME (frame
, f
);
6754 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6758 #ifdef HAVE_WINDOW_SYSTEM
6759 if (FRAME_WINDOW_P (f
))
6761 /* Set frame_font to the value of the `font' frame parameter. */
6762 frame_font
= Fassq (Qfont
, f
->param_alist
);
6763 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6764 frame_font
= XCDR (frame_font
);
6765 set_lface_from_font_name (f
, lface
, frame_font
,
6766 f
->default_face_done_p
, 1);
6767 f
->default_face_done_p
= 1;
6769 #endif /* HAVE_WINDOW_SYSTEM */
6771 if (!FRAME_WINDOW_P (f
))
6773 LFACE_FAMILY (lface
) = build_string ("default");
6774 LFACE_SWIDTH (lface
) = Qnormal
;
6775 LFACE_HEIGHT (lface
) = make_number (1);
6776 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6777 LFACE_WEIGHT (lface
) = Qnormal
;
6778 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6779 LFACE_SLANT (lface
) = Qnormal
;
6780 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6783 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6784 LFACE_UNDERLINE (lface
) = Qnil
;
6786 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6787 LFACE_OVERLINE (lface
) = Qnil
;
6789 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6790 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6792 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6793 LFACE_BOX (lface
) = Qnil
;
6795 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6796 LFACE_INVERSE (lface
) = Qnil
;
6798 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6800 /* This function is called so early that colors are not yet
6801 set in the frame parameter list. */
6802 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6804 if (CONSP (color
) && STRINGP (XCDR (color
)))
6805 LFACE_FOREGROUND (lface
) = XCDR (color
);
6806 else if (FRAME_WINDOW_P (f
))
6808 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6809 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6814 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6816 /* This function is called so early that colors are not yet
6817 set in the frame parameter list. */
6818 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6819 if (CONSP (color
) && STRINGP (XCDR (color
)))
6820 LFACE_BACKGROUND (lface
) = XCDR (color
);
6821 else if (FRAME_WINDOW_P (f
))
6823 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6824 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6829 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6830 LFACE_STIPPLE (lface
) = Qnil
;
6832 /* Realize the face; it must be fully-specified now. */
6833 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6834 check_lface (lface
);
6835 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6836 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6841 /* Realize basic faces other than the default face in face cache C.
6842 SYMBOL is the face name, ID is the face id the realized face must
6843 have. The default face must have been realized already. */
6846 realize_named_face (f
, symbol
, id
)
6851 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6852 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6853 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6854 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6855 struct face
*new_face
;
6857 /* The default face must exist and be fully specified. */
6858 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6859 check_lface_attrs (attrs
);
6860 xassert (lface_fully_specified_p (attrs
));
6862 /* If SYMBOL isn't know as a face, create it. */
6866 XSETFRAME (frame
, f
);
6867 lface
= Finternal_make_lisp_face (symbol
, frame
);
6870 /* Merge SYMBOL's face with the default face. */
6871 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6872 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6874 /* Realize the face. */
6875 new_face
= realize_face (c
, attrs
, id
);
6879 /* Realize the fully-specified face with attributes ATTRS in face
6880 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6881 non-negative, it is an ID of face to remove before caching the new
6882 face. Value is a pointer to the newly created realized face. */
6884 static struct face
*
6885 realize_face (cache
, attrs
, former_face_id
)
6886 struct face_cache
*cache
;
6892 /* LFACE must be fully specified. */
6893 xassert (cache
!= NULL
);
6894 check_lface_attrs (attrs
);
6896 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6898 /* Remove the former face. */
6899 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6900 uncache_face (cache
, former_face
);
6901 free_realized_face (cache
->f
, former_face
);
6904 if (FRAME_WINDOW_P (cache
->f
))
6905 face
= realize_x_face (cache
, attrs
);
6906 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6907 face
= realize_tty_face (cache
, attrs
);
6911 /* Insert the new face. */
6912 cache_face (cache
, face
, lface_hash (attrs
));
6917 /* Realize the fully-specified face that has the same attributes as
6918 BASE_FACE except for the font on frame F. If FONT_ID is not
6919 negative, it is an ID number of an already opened font that should
6920 be used by the face. If FONT_ID is negative, the face has no font,
6921 i.e., characters are displayed by empty boxes. */
6923 static struct face
*
6924 realize_non_ascii_face (f
, font_id
, base_face
)
6927 struct face
*base_face
;
6929 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6931 struct font_info
*font_info
;
6933 face
= (struct face
*) xmalloc (sizeof *face
);
6937 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6938 face
->colors_copied_bitwise_p
= 1;
6940 face
->font_info_id
= font_id
;
6943 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6944 face
->font
= font_info
->font
;
6945 face
->font_name
= font_info
->full_name
;
6950 face
->font_name
= NULL
;
6955 cache_face (cache
, face
, face
->hash
);
6961 /* Realize the fully-specified face with attributes ATTRS in face
6962 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6963 the new face doesn't share font with the default face, a fontname
6964 is allocated from the heap and set in `font_name' of the new face,
6965 but it is not yet loaded here. Value is a pointer to the newly
6966 created realized face. */
6968 static struct face
*
6969 realize_x_face (cache
, attrs
)
6970 struct face_cache
*cache
;
6973 #ifdef HAVE_WINDOW_SYSTEM
6974 struct face
*face
, *default_face
;
6976 Lisp_Object stipple
, overline
, strike_through
, box
;
6978 xassert (FRAME_WINDOW_P (cache
->f
));
6980 /* Allocate a new realized face. */
6981 face
= make_realized_face (attrs
);
6982 face
->ascii_face
= face
;
6986 /* Determine the font to use. Most of the time, the font will be
6987 the same as the font of the default face, so try that first. */
6988 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6990 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6992 face
->font
= default_face
->font
;
6993 face
->font_info_id
= default_face
->font_info_id
;
6994 face
->font_name
= default_face
->font_name
;
6996 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
7000 /* If the face attribute ATTRS specifies a fontset, use it as
7001 the base of a new realized fontset. Otherwise, use the same
7002 base fontset as of the default face. The base determines
7003 registry and encoding of a font. It may also determine
7004 foundry and family. The other fields of font name pattern
7005 are constructed from ATTRS. */
7006 int fontset
= face_fontset (attrs
);
7008 /* If we are realizing the default face, ATTRS should specify a
7009 fontset. In other words, if FONTSET is -1, we are not
7010 realizing the default face, thus the default face should have
7011 already been realized. */
7013 fontset
= default_face
->fontset
;
7016 load_face_font (f
, face
);
7017 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
7020 /* Load colors, and set remaining attributes. */
7022 load_face_colors (f
, face
, attrs
);
7025 box
= attrs
[LFACE_BOX_INDEX
];
7028 /* A simple box of line width 1 drawn in color given by
7030 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7032 face
->box
= FACE_SIMPLE_BOX
;
7033 face
->box_line_width
= 1;
7035 else if (INTEGERP (box
))
7037 /* Simple box of specified line width in foreground color of the
7039 xassert (XINT (box
) != 0);
7040 face
->box
= FACE_SIMPLE_BOX
;
7041 face
->box_line_width
= XINT (box
);
7042 face
->box_color
= face
->foreground
;
7043 face
->box_color_defaulted_p
= 1;
7045 else if (CONSP (box
))
7047 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7048 being one of `raised' or `sunken'. */
7049 face
->box
= FACE_SIMPLE_BOX
;
7050 face
->box_color
= face
->foreground
;
7051 face
->box_color_defaulted_p
= 1;
7052 face
->box_line_width
= 1;
7056 Lisp_Object keyword
, value
;
7058 keyword
= XCAR (box
);
7066 if (EQ (keyword
, QCline_width
))
7068 if (INTEGERP (value
) && XINT (value
) != 0)
7069 face
->box_line_width
= XINT (value
);
7071 else if (EQ (keyword
, QCcolor
))
7073 if (STRINGP (value
))
7075 face
->box_color
= load_color (f
, face
, value
,
7077 face
->use_box_color_for_shadows_p
= 1;
7080 else if (EQ (keyword
, QCstyle
))
7082 if (EQ (value
, Qreleased_button
))
7083 face
->box
= FACE_RAISED_BOX
;
7084 else if (EQ (value
, Qpressed_button
))
7085 face
->box
= FACE_SUNKEN_BOX
;
7090 /* Text underline, overline, strike-through. */
7092 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7094 /* Use default color (same as foreground color). */
7095 face
->underline_p
= 1;
7096 face
->underline_defaulted_p
= 1;
7097 face
->underline_color
= 0;
7099 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7101 /* Use specified color. */
7102 face
->underline_p
= 1;
7103 face
->underline_defaulted_p
= 0;
7104 face
->underline_color
7105 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7106 LFACE_UNDERLINE_INDEX
);
7108 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7110 face
->underline_p
= 0;
7111 face
->underline_defaulted_p
= 0;
7112 face
->underline_color
= 0;
7115 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7116 if (STRINGP (overline
))
7118 face
->overline_color
7119 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7120 LFACE_OVERLINE_INDEX
);
7121 face
->overline_p
= 1;
7123 else if (EQ (overline
, Qt
))
7125 face
->overline_color
= face
->foreground
;
7126 face
->overline_color_defaulted_p
= 1;
7127 face
->overline_p
= 1;
7130 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7131 if (STRINGP (strike_through
))
7133 face
->strike_through_color
7134 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7135 LFACE_STRIKE_THROUGH_INDEX
);
7136 face
->strike_through_p
= 1;
7138 else if (EQ (strike_through
, Qt
))
7140 face
->strike_through_color
= face
->foreground
;
7141 face
->strike_through_color_defaulted_p
= 1;
7142 face
->strike_through_p
= 1;
7145 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7146 if (!NILP (stipple
))
7147 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7150 #endif /* HAVE_WINDOW_SYSTEM */
7154 /* Map a specified color of face FACE on frame F to a tty color index.
7155 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7156 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7157 default foreground/background colors. */
7160 map_tty_color (f
, face
, idx
, defaulted
)
7163 enum lface_attribute_index idx
;
7166 Lisp_Object frame
, color
, def
;
7167 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7168 unsigned long default_pixel
, default_other_pixel
, pixel
;
7170 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7174 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7175 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7179 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7180 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7183 XSETFRAME (frame
, f
);
7184 color
= face
->lface
[idx
];
7188 && CONSP (Vtty_defined_color_alist
)
7189 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7192 /* Associations in tty-defined-color-alist are of the form
7193 (NAME INDEX R G B). We need the INDEX part. */
7194 pixel
= XINT (XCAR (XCDR (def
)));
7197 if (pixel
== default_pixel
&& STRINGP (color
))
7199 pixel
= load_color (f
, face
, color
, idx
);
7201 #if defined (MSDOS) || defined (WINDOWSNT)
7202 /* If the foreground of the default face is the default color,
7203 use the foreground color defined by the frame. */
7205 if (FRAME_MSDOS_P (f
))
7208 if (pixel
== default_pixel
7209 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7212 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7214 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7215 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7218 else if (pixel
== default_other_pixel
)
7221 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7223 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7224 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7230 #endif /* MSDOS or WINDOWSNT */
7234 face
->foreground
= pixel
;
7236 face
->background
= pixel
;
7240 /* Realize the fully-specified face with attributes ATTRS in face
7241 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
7242 Value is a pointer to the newly created realized face. */
7244 static struct face
*
7245 realize_tty_face (cache
, attrs
)
7246 struct face_cache
*cache
;
7251 int face_colors_defaulted
= 0;
7252 struct frame
*f
= cache
->f
;
7254 /* Frame must be a termcap frame. */
7255 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7257 /* Allocate a new realized face. */
7258 face
= make_realized_face (attrs
);
7259 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7261 /* Map face attributes to TTY appearances. We map slant to
7262 dimmed text because we want italic text to appear differently
7263 and because dimmed text is probably used infrequently. */
7264 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7265 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7267 if (weight
> XLFD_WEIGHT_MEDIUM
)
7268 face
->tty_bold_p
= 1;
7269 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7270 face
->tty_dim_p
= 1;
7271 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7272 face
->tty_underline_p
= 1;
7273 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7274 face
->tty_reverse_p
= 1;
7276 /* Map color names to color indices. */
7277 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7278 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7280 /* Swap colors if face is inverse-video. If the colors are taken
7281 from the frame colors, they are already inverted, since the
7282 frame-creation function calls x-handle-reverse-video. */
7283 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7285 unsigned long tem
= face
->foreground
;
7286 face
->foreground
= face
->background
;
7287 face
->background
= tem
;
7290 if (tty_suppress_bold_inverse_default_colors_p
7292 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7293 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7294 face
->tty_bold_p
= 0;
7300 DEFUN ("tty-suppress-bold-inverse-default-colors",
7301 Ftty_suppress_bold_inverse_default_colors
,
7302 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7303 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7304 SUPPRESS non-nil means suppress it.
7305 This affects bold faces on TTYs whose foreground is the default background
7306 color of the display and whose background is the default foreground color.
7307 For such faces, the bold face attribute is ignored if this variable
7310 Lisp_Object suppress
;
7312 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7313 ++face_change_count
;
7319 /***********************************************************************
7321 ***********************************************************************/
7323 /* Return the ID of the face to use to display character CH with face
7324 property PROP on frame F in current_buffer. */
7327 compute_char_face (f
, ch
, prop
)
7334 if (NILP (current_buffer
->enable_multibyte_characters
))
7339 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7340 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7344 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7345 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7346 bcopy (face
->lface
, attrs
, sizeof attrs
);
7347 merge_face_vector_with_property (f
, attrs
, prop
);
7348 face_id
= lookup_face (f
, attrs
);
7349 if (! ASCII_CHAR_P (ch
))
7351 face
= FACE_FROM_ID (f
, face_id
);
7352 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7359 /* Return the face ID associated with buffer position POS for
7360 displaying ASCII characters. Return in *ENDPTR the position at
7361 which a different face is needed, as far as text properties and
7362 overlays are concerned. W is a window displaying current_buffer.
7364 REGION_BEG, REGION_END delimit the region, so it can be
7367 LIMIT is a position not to scan beyond. That is to limit the time
7368 this function can take.
7370 If MOUSE is non-zero, use the character's mouse-face, not its face.
7372 The face returned is suitable for displaying ASCII characters. */
7375 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7376 endptr
, limit
, mouse
)
7379 int region_beg
, region_end
;
7384 struct frame
*f
= XFRAME (w
->frame
);
7385 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7386 Lisp_Object prop
, position
;
7388 Lisp_Object
*overlay_vec
;
7391 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7392 Lisp_Object limit1
, end
;
7393 struct face
*default_face
;
7395 /* W must display the current buffer. We could write this function
7396 to use the frame and buffer of W, but right now it doesn't. */
7397 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7399 XSETFRAME (frame
, f
);
7400 XSETFASTINT (position
, pos
);
7403 if (pos
< region_beg
&& region_beg
< endpos
)
7404 endpos
= region_beg
;
7406 /* Get the `face' or `mouse_face' text property at POS, and
7407 determine the next position at which the property changes. */
7408 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7409 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7410 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7412 endpos
= XINT (end
);
7414 /* Look at properties from overlays. */
7419 /* First try with room for 40 overlays. */
7421 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7422 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7423 &next_overlay
, NULL
, 0);
7425 /* If there are more than 40, make enough space for all, and try
7427 if (noverlays
> len
)
7430 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7431 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7432 &next_overlay
, NULL
, 0);
7435 if (next_overlay
< endpos
)
7436 endpos
= next_overlay
;
7441 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7443 /* Optimize common cases where we can use the default face. */
7446 && !(pos
>= region_beg
&& pos
< region_end
))
7447 return DEFAULT_FACE_ID
;
7449 /* Begin with attributes from the default face. */
7450 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7452 /* Merge in attributes specified via text properties. */
7454 merge_face_vector_with_property (f
, attrs
, prop
);
7456 /* Now merge the overlay data. */
7457 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7458 for (i
= 0; i
< noverlays
; i
++)
7463 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7465 merge_face_vector_with_property (f
, attrs
, prop
);
7467 oend
= OVERLAY_END (overlay_vec
[i
]);
7468 oendpos
= OVERLAY_POSITION (oend
);
7469 if (oendpos
< endpos
)
7473 /* If in the region, merge in the region face. */
7474 if (pos
>= region_beg
&& pos
< region_end
)
7476 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7477 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7479 if (region_end
< endpos
)
7480 endpos
= region_end
;
7485 /* Look up a realized face with the given face attributes,
7486 or realize a new one for ASCII characters. */
7487 return lookup_face (f
, attrs
);
7491 /* Compute the face at character position POS in Lisp string STRING on
7492 window W, for ASCII characters.
7494 If STRING is an overlay string, it comes from position BUFPOS in
7495 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7496 not an overlay string. W must display the current buffer.
7497 REGION_BEG and REGION_END give the start and end positions of the
7498 region; both are -1 if no region is visible.
7500 BASE_FACE_ID is the id of a face to merge with. For strings coming
7501 from overlays or the `display' property it is the face at BUFPOS.
7503 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7505 Set *ENDPTR to the next position where to check for faces in
7506 STRING; -1 if the face is constant from POS to the end of the
7509 Value is the id of the face to use. The face returned is suitable
7510 for displaying ASCII characters. */
7513 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7514 region_end
, endptr
, base_face_id
, mouse_p
)
7518 int region_beg
, region_end
;
7520 enum face_id base_face_id
;
7523 Lisp_Object prop
, position
, end
, limit
;
7524 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7525 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7526 struct face
*base_face
;
7527 int multibyte_p
= STRING_MULTIBYTE (string
);
7528 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7530 /* Get the value of the face property at the current position within
7531 STRING. Value is nil if there is no face property. */
7532 XSETFASTINT (position
, pos
);
7533 prop
= Fget_text_property (position
, prop_name
, string
);
7535 /* Get the next position at which to check for faces. Value of end
7536 is nil if face is constant all the way to the end of the string.
7537 Otherwise it is a string position where to check faces next.
7538 Limit is the maximum position up to which to check for property
7539 changes in Fnext_single_property_change. Strings are usually
7540 short, so set the limit to the end of the string. */
7541 XSETFASTINT (limit
, SCHARS (string
));
7542 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7544 *endptr
= XFASTINT (end
);
7548 base_face
= FACE_FROM_ID (f
, base_face_id
);
7549 xassert (base_face
);
7551 /* Optimize the default case that there is no face property and we
7552 are not in the region. */
7554 && (base_face_id
!= DEFAULT_FACE_ID
7555 /* BUFPOS <= 0 means STRING is not an overlay string, so
7556 that the region doesn't have to be taken into account. */
7558 || bufpos
< region_beg
7559 || bufpos
>= region_end
)
7561 /* We can't realize faces for different charsets differently
7562 if we don't have fonts, so we can stop here if not working
7563 on a window-system frame. */
7564 || !FRAME_WINDOW_P (f
)
7565 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7566 return base_face
->id
;
7568 /* Begin with attributes from the base face. */
7569 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7571 /* Merge in attributes specified via text properties. */
7573 merge_face_vector_with_property (f
, attrs
, prop
);
7575 /* If in the region, merge in the region face. */
7577 && bufpos
>= region_beg
7578 && bufpos
< region_end
)
7580 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7581 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7584 /* Look up a realized face with the given face attributes,
7585 or realize a new one for ASCII characters. */
7586 return lookup_face (f
, attrs
);
7591 /***********************************************************************
7593 ***********************************************************************/
7597 /* Print the contents of the realized face FACE to stderr. */
7600 dump_realized_face (face
)
7603 fprintf (stderr
, "ID: %d\n", face
->id
);
7604 #ifdef HAVE_X_WINDOWS
7605 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7607 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7609 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7610 fprintf (stderr
, "background: 0x%lx (%s)\n",
7612 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7613 fprintf (stderr
, "font_name: %s (%s)\n",
7615 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7616 #ifdef HAVE_X_WINDOWS
7617 fprintf (stderr
, "font = %p\n", face
->font
);
7619 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7620 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7621 fprintf (stderr
, "underline: %d (%s)\n",
7623 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7624 fprintf (stderr
, "hash: %d\n", face
->hash
);
7628 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7636 fprintf (stderr
, "font selection order: ");
7637 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7638 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7639 fprintf (stderr
, "\n");
7641 fprintf (stderr
, "alternative fonts: ");
7642 debug_print (Vface_alternative_font_family_alist
);
7643 fprintf (stderr
, "\n");
7645 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7646 Fdump_face (make_number (i
));
7652 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7654 error ("Not a valid face");
7655 dump_realized_face (face
);
7662 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7663 0, 0, 0, doc
: /* */)
7666 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7667 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7668 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7672 #endif /* GLYPH_DEBUG != 0 */
7676 /***********************************************************************
7678 ***********************************************************************/
7683 Qface
= intern ("face");
7685 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7686 staticpro (&Qbitmap_spec_p
);
7687 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7688 staticpro (&Qframe_update_face_colors
);
7690 /* Lisp face attribute keywords. */
7691 QCfamily
= intern (":family");
7692 staticpro (&QCfamily
);
7693 QCheight
= intern (":height");
7694 staticpro (&QCheight
);
7695 QCweight
= intern (":weight");
7696 staticpro (&QCweight
);
7697 QCslant
= intern (":slant");
7698 staticpro (&QCslant
);
7699 QCunderline
= intern (":underline");
7700 staticpro (&QCunderline
);
7701 QCinverse_video
= intern (":inverse-video");
7702 staticpro (&QCinverse_video
);
7703 QCreverse_video
= intern (":reverse-video");
7704 staticpro (&QCreverse_video
);
7705 QCforeground
= intern (":foreground");
7706 staticpro (&QCforeground
);
7707 QCbackground
= intern (":background");
7708 staticpro (&QCbackground
);
7709 QCstipple
= intern (":stipple");;
7710 staticpro (&QCstipple
);
7711 QCwidth
= intern (":width");
7712 staticpro (&QCwidth
);
7713 QCfont
= intern (":font");
7714 staticpro (&QCfont
);
7715 QCfontset
= intern (":fontset");
7716 staticpro (&QCfontset
);
7717 QCbold
= intern (":bold");
7718 staticpro (&QCbold
);
7719 QCitalic
= intern (":italic");
7720 staticpro (&QCitalic
);
7721 QCoverline
= intern (":overline");
7722 staticpro (&QCoverline
);
7723 QCstrike_through
= intern (":strike-through");
7724 staticpro (&QCstrike_through
);
7725 QCbox
= intern (":box");
7727 QCinherit
= intern (":inherit");
7728 staticpro (&QCinherit
);
7730 /* Symbols used for Lisp face attribute values. */
7731 QCcolor
= intern (":color");
7732 staticpro (&QCcolor
);
7733 QCline_width
= intern (":line-width");
7734 staticpro (&QCline_width
);
7735 QCstyle
= intern (":style");
7736 staticpro (&QCstyle
);
7737 Qreleased_button
= intern ("released-button");
7738 staticpro (&Qreleased_button
);
7739 Qpressed_button
= intern ("pressed-button");
7740 staticpro (&Qpressed_button
);
7741 Qnormal
= intern ("normal");
7742 staticpro (&Qnormal
);
7743 Qultra_light
= intern ("ultra-light");
7744 staticpro (&Qultra_light
);
7745 Qextra_light
= intern ("extra-light");
7746 staticpro (&Qextra_light
);
7747 Qlight
= intern ("light");
7748 staticpro (&Qlight
);
7749 Qsemi_light
= intern ("semi-light");
7750 staticpro (&Qsemi_light
);
7751 Qsemi_bold
= intern ("semi-bold");
7752 staticpro (&Qsemi_bold
);
7753 Qbold
= intern ("bold");
7755 Qextra_bold
= intern ("extra-bold");
7756 staticpro (&Qextra_bold
);
7757 Qultra_bold
= intern ("ultra-bold");
7758 staticpro (&Qultra_bold
);
7759 Qoblique
= intern ("oblique");
7760 staticpro (&Qoblique
);
7761 Qitalic
= intern ("italic");
7762 staticpro (&Qitalic
);
7763 Qreverse_oblique
= intern ("reverse-oblique");
7764 staticpro (&Qreverse_oblique
);
7765 Qreverse_italic
= intern ("reverse-italic");
7766 staticpro (&Qreverse_italic
);
7767 Qultra_condensed
= intern ("ultra-condensed");
7768 staticpro (&Qultra_condensed
);
7769 Qextra_condensed
= intern ("extra-condensed");
7770 staticpro (&Qextra_condensed
);
7771 Qcondensed
= intern ("condensed");
7772 staticpro (&Qcondensed
);
7773 Qsemi_condensed
= intern ("semi-condensed");
7774 staticpro (&Qsemi_condensed
);
7775 Qsemi_expanded
= intern ("semi-expanded");
7776 staticpro (&Qsemi_expanded
);
7777 Qexpanded
= intern ("expanded");
7778 staticpro (&Qexpanded
);
7779 Qextra_expanded
= intern ("extra-expanded");
7780 staticpro (&Qextra_expanded
);
7781 Qultra_expanded
= intern ("ultra-expanded");
7782 staticpro (&Qultra_expanded
);
7783 Qbackground_color
= intern ("background-color");
7784 staticpro (&Qbackground_color
);
7785 Qforeground_color
= intern ("foreground-color");
7786 staticpro (&Qforeground_color
);
7787 Qunspecified
= intern ("unspecified");
7788 staticpro (&Qunspecified
);
7790 Qface_alias
= intern ("face-alias");
7791 staticpro (&Qface_alias
);
7792 Qdefault
= intern ("default");
7793 staticpro (&Qdefault
);
7794 Qtool_bar
= intern ("tool-bar");
7795 staticpro (&Qtool_bar
);
7796 Qregion
= intern ("region");
7797 staticpro (&Qregion
);
7798 Qfringe
= intern ("fringe");
7799 staticpro (&Qfringe
);
7800 Qheader_line
= intern ("header-line");
7801 staticpro (&Qheader_line
);
7802 Qscroll_bar
= intern ("scroll-bar");
7803 staticpro (&Qscroll_bar
);
7804 Qmenu
= intern ("menu");
7806 Qcursor
= intern ("cursor");
7807 staticpro (&Qcursor
);
7808 Qborder
= intern ("border");
7809 staticpro (&Qborder
);
7810 Qmouse
= intern ("mouse");
7811 staticpro (&Qmouse
);
7812 Qmode_line_inactive
= intern ("mode-line-inactive");
7813 staticpro (&Qmode_line_inactive
);
7814 Qtty_color_desc
= intern ("tty-color-desc");
7815 staticpro (&Qtty_color_desc
);
7816 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7817 staticpro (&Qtty_color_standard_values
);
7818 Qtty_color_by_index
= intern ("tty-color-by-index");
7819 staticpro (&Qtty_color_by_index
);
7820 Qtty_color_alist
= intern ("tty-color-alist");
7821 staticpro (&Qtty_color_alist
);
7822 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7823 staticpro (&Qscalable_fonts_allowed
);
7825 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7826 staticpro (&Vparam_value_alist
);
7827 Vface_alternative_font_family_alist
= Qnil
;
7828 staticpro (&Vface_alternative_font_family_alist
);
7829 Vface_alternative_font_registry_alist
= Qnil
;
7830 staticpro (&Vface_alternative_font_registry_alist
);
7832 defsubr (&Sinternal_make_lisp_face
);
7833 defsubr (&Sinternal_lisp_face_p
);
7834 defsubr (&Sinternal_set_lisp_face_attribute
);
7835 #ifdef HAVE_WINDOW_SYSTEM
7836 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7838 defsubr (&Scolor_gray_p
);
7839 defsubr (&Scolor_supported_p
);
7840 defsubr (&Sface_attribute_relative_p
);
7841 defsubr (&Smerge_face_attribute
);
7842 defsubr (&Sinternal_get_lisp_face_attribute
);
7843 defsubr (&Sinternal_lisp_face_attribute_values
);
7844 defsubr (&Sinternal_lisp_face_equal_p
);
7845 defsubr (&Sinternal_lisp_face_empty_p
);
7846 defsubr (&Sinternal_copy_lisp_face
);
7847 defsubr (&Sinternal_merge_in_global_face
);
7848 defsubr (&Sface_font
);
7849 defsubr (&Sframe_face_alist
);
7850 defsubr (&Stty_supports_face_attributes_p
);
7851 defsubr (&Scolor_distance
);
7852 defsubr (&Sinternal_set_font_selection_order
);
7853 defsubr (&Sinternal_set_alternative_font_family_alist
);
7854 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7855 defsubr (&Sface_attributes_as_vector
);
7857 defsubr (&Sdump_face
);
7858 defsubr (&Sshow_face_resources
);
7859 #endif /* GLYPH_DEBUG */
7860 defsubr (&Sclear_face_cache
);
7861 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7863 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7864 defsubr (&Sdump_colors
);
7867 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7868 doc
: /* *Limit for font matching.
7869 If an integer > 0, font matching functions won't load more than
7870 that number of fonts when searching for a matching font. */);
7871 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7873 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7874 doc
: /* List of global face definitions (for internal use only.) */);
7875 Vface_new_frame_defaults
= Qnil
;
7877 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7878 doc
: /* *Default stipple pattern used on monochrome displays.
7879 This stipple pattern is used on monochrome displays
7880 instead of shades of gray for a face background color.
7881 See `set-face-stipple' for possible values for this variable. */);
7882 Vface_default_stipple
= build_string ("gray3");
7884 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7885 doc
: /* An alist of defined terminal colors and their RGB values. */);
7886 Vtty_defined_color_alist
= Qnil
;
7888 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7889 doc
: /* Allowed scalable fonts.
7890 A value of nil means don't allow any scalable fonts.
7891 A value of t means allow any scalable font.
7892 Otherwise, value must be a list of regular expressions. A font may be
7893 scaled if its name matches a regular expression in the list.
7894 Note that if value is nil, a scalable font might still be used, if no
7895 other font of the appropriate family and registry is available. */);
7896 Vscalable_fonts_allowed
= Qnil
;
7898 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7899 doc
: /* List of ignored fonts.
7900 Each element is a regular expression that matches names of fonts to
7902 Vface_ignored_fonts
= Qnil
;
7904 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7905 doc
: /* Alist of fonts vs the rescaling factors.
7906 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7907 FONT-NAME-PATTERN is a regular expression matching a font name, and
7908 RESCALE-RATIO is a floating point number to specify how much larger
7909 \(or smaller) font we should use. For instance, if a face requests
7910 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7911 Vface_font_rescale_alist
= Qnil
;
7913 #ifdef HAVE_WINDOW_SYSTEM
7914 defsubr (&Sbitmap_spec_p
);
7915 defsubr (&Sx_list_fonts
);
7916 defsubr (&Sinternal_face_x_get_resource
);
7917 defsubr (&Sx_family_fonts
);
7918 defsubr (&Sx_font_family_list
);
7919 #endif /* HAVE_WINDOW_SYSTEM */