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
2236 xlfd_point_size (f
, font
)
2238 struct font_name
*font
;
2240 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2241 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2245 if (*pixel_field
== '[')
2247 /* The pixel size field is `[A B C D]' which specifies
2248 a transformation matrix.
2254 by which all glyphs of the font are transformed. The spec
2255 says that s scalar value N for the pixel size is equivalent
2256 to A = N * resx/resy, B = C = 0, D = N. */
2257 char *start
= pixel_field
+ 1, *end
;
2261 for (i
= 0; i
< 4; ++i
)
2263 matrix
[i
] = strtod (start
, &end
);
2270 pixel
= atoi (pixel_field
);
2275 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2281 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2282 of frame F. This function is used to guess a point size of font
2283 when only the pixel height of the font is available. */
2286 pixel_point_size (f
, pixel
)
2290 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2294 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2295 point size of one dot. */
2296 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2297 int_pt
= real_pt
+ 0.5;
2303 /* Return a rescaling ratio of a font of NAME. */
2306 font_rescale_ratio (name
)
2309 Lisp_Object tail
, elt
;
2311 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2314 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2315 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2316 return XFLOAT_DATA (XCDR (elt
));
2322 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2323 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2324 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2325 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2326 zero if the font name doesn't have the format we expect. The
2327 expected format is a font name that starts with a `-' and has
2328 XLFD_LAST fields separated by `-'. */
2331 split_font_name (f
, font
, numeric_p
)
2333 struct font_name
*font
;
2338 double rescale_ratio
;
2341 /* This must be done before splitting the font name. */
2342 rescale_ratio
= font_rescale_ratio (font
->name
);
2344 if (*font
->name
== '-')
2346 char *p
= xstrlwr (font
->name
) + 1;
2348 while (i
< XLFD_LAST
)
2350 font
->fields
[i
] = p
;
2353 /* Pixel and point size may be of the form `[....]'. For
2354 BNF, see XLFD spec, chapter 4. Negative values are
2355 indicated by tilde characters which we replace with
2356 `-' characters, here. */
2358 && (i
- 1 == XLFD_PIXEL_SIZE
2359 || i
- 1 == XLFD_POINT_SIZE
))
2364 for (++p
; *p
&& *p
!= ']'; ++p
)
2368 /* Check that the matrix contains 4 floating point
2370 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2373 if (strtod (start
, &end
) == 0 && start
== end
)
2380 while (*p
&& *p
!= '-')
2390 success_p
= i
== XLFD_LAST
;
2392 /* If requested, and font name was in the expected format,
2393 compute numeric values for some fields. */
2394 if (numeric_p
&& success_p
)
2396 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2397 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2398 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2399 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2400 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2401 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2402 font
->rescale_ratio
= rescale_ratio
;
2405 /* Initialize it to zero. It will be overridden by font_list while
2406 trying alternate registries. */
2407 font
->registry_priority
= 0;
2413 /* Build an XLFD font name from font name fields in FONT. Value is a
2414 pointer to the font name, which is allocated via xmalloc. */
2417 build_font_name (font
)
2418 struct font_name
*font
;
2422 char *font_name
= (char *) xmalloc (size
);
2423 int total_length
= 0;
2425 for (i
= 0; i
< XLFD_LAST
; ++i
)
2427 /* Add 1 because of the leading `-'. */
2428 int len
= strlen (font
->fields
[i
]) + 1;
2430 /* Reallocate font_name if necessary. Add 1 for the final
2432 if (total_length
+ len
+ 1 >= size
)
2434 int new_size
= max (2 * size
, size
+ len
+ 1);
2435 int sz
= new_size
* sizeof *font_name
;
2436 font_name
= (char *) xrealloc (font_name
, sz
);
2440 font_name
[total_length
] = '-';
2441 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2442 total_length
+= len
;
2445 font_name
[total_length
] = 0;
2450 /* Free an array FONTS of N font_name structures. This frees FONTS
2451 itself and all `name' fields in its elements. */
2454 free_font_names (fonts
, n
)
2455 struct font_name
*fonts
;
2459 xfree (fonts
[--n
].name
);
2464 /* Sort vector FONTS of font_name structures which contains NFONTS
2465 elements using qsort and comparison function CMPFN. F is the frame
2466 on which the fonts will be used. The global variable font_frame
2467 is temporarily set to F to make it available in CMPFN. */
2470 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2472 struct font_name
*fonts
;
2474 int (*cmpfn
) P_ ((const void *, const void *));
2477 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2482 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2483 display in x_display_list. FONTS is a pointer to a vector of
2484 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2485 alternative patterns from Valternate_fontname_alist if no fonts are
2486 found matching PATTERN.
2488 For all fonts found, set FONTS[i].name to the name of the font,
2489 allocated via xmalloc, and split font names into fields. Ignore
2490 fonts that we can't parse. Value is the number of fonts found. */
2493 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2496 struct font_name
**pfonts
;
2497 int nfonts
, try_alternatives_p
;
2501 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2502 better to do it the other way around. */
2504 Lisp_Object lpattern
, tem
;
2505 struct font_name
*fonts
= 0;
2506 int num_fonts
= nfonts
;
2509 lpattern
= build_string (pattern
);
2511 /* Get the list of fonts matching PATTERN. */
2514 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2517 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2520 if (nfonts
< 0 && CONSP (lfonts
))
2521 num_fonts
= XFASTINT (Flength (lfonts
));
2523 /* Make a copy of the font names we got from X, and
2524 split them into fields. */
2526 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2528 Lisp_Object elt
, tail
;
2529 const char *name
= SDATA (XCAR (tem
));
2531 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2532 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2536 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2547 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2551 /* Make a copy of the font name. */
2552 fonts
[n
].name
= xstrdup (name
);
2554 if (split_font_name (f
, fonts
+ n
, 1))
2556 if (font_scalable_p (fonts
+ n
)
2557 && !may_use_scalable_font_p (name
))
2560 xfree (fonts
[n
].name
);
2566 xfree (fonts
[n
].name
);
2569 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2570 if (n
== 0 && try_alternatives_p
)
2572 Lisp_Object list
= Valternate_fontname_alist
;
2580 while (CONSP (list
))
2582 Lisp_Object entry
= XCAR (list
);
2584 && STRINGP (XCAR (entry
))
2585 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2592 Lisp_Object patterns
= XCAR (list
);
2595 while (CONSP (patterns
)
2596 /* If list is screwed up, give up. */
2597 && (name
= XCAR (patterns
),
2599 /* Ignore patterns equal to PATTERN because we tried that
2600 already with no success. */
2601 && (strcmp (SDATA (name
), pattern
) == 0
2602 || (n
= x_face_list_fonts (f
, SDATA (name
),
2605 patterns
= XCDR (patterns
);
2613 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2614 using comparison function CMPFN. Value is the number of fonts
2615 found. If value is non-zero, *FONTS is set to a vector of
2616 font_name structures allocated from the heap containing matching
2617 fonts. Each element of *FONTS contains a name member that is also
2618 allocated from the heap. Font names in these structures are split
2619 into fields. Use free_font_names to free such an array. */
2622 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2625 int (*cmpfn
) P_ ((const void *, const void *));
2626 struct font_name
**fonts
;
2630 /* Get the list of fonts matching pattern. 100 should suffice. */
2631 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2632 if (INTEGERP (Vfont_list_limit
))
2633 nfonts
= XINT (Vfont_list_limit
);
2636 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2638 /* Sort the resulting array and return it in *FONTS. If no
2639 fonts were found, make sure to set *FONTS to null. */
2641 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2652 /* Compare two font_name structures *A and *B. Value is analogous to
2653 strcmp. Sort order is given by the global variable
2654 font_sort_order. Font names are sorted so that, everything else
2655 being equal, fonts with a resolution closer to that of the frame on
2656 which they are used are listed first. The global variable
2657 font_frame is the frame on which we operate. */
2660 cmp_font_names (a
, b
)
2663 struct font_name
*x
= (struct font_name
*) a
;
2664 struct font_name
*y
= (struct font_name
*) b
;
2667 /* All strings have been converted to lower-case by split_font_name,
2668 so we can use strcmp here. */
2669 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2674 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2676 int j
= font_sort_order
[i
];
2677 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2682 /* Everything else being equal, we prefer fonts with an
2683 y-resolution closer to that of the frame. */
2684 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2685 int x_resy
= x
->numeric
[XLFD_RESY
];
2686 int y_resy
= y
->numeric
[XLFD_RESY
];
2687 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2695 /* Get a sorted list of fonts matching PATTERN on frame F. If PATTERN
2696 is nil, list fonts matching FAMILY and REGISTRY. FAMILY is a
2697 family name string or nil. REGISTRY is a registry name string.
2698 Set *FONTS to a vector of font_name structures allocated from the
2699 heap containing the fonts found. Value is the number of fonts
2703 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2705 Lisp_Object pattern
, family
, registry
;
2706 struct font_name
**fonts
;
2708 char *pattern_str
, *family_str
, *registry_str
;
2712 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2713 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2715 pattern_str
= (char *) alloca (strlen (family_str
)
2716 + strlen (registry_str
)
2718 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2719 strcat (pattern_str
, family_str
);
2720 strcat (pattern_str
, "-*-");
2721 strcat (pattern_str
, registry_str
);
2722 if (!index (registry_str
, '-'))
2724 if (registry_str
[strlen (registry_str
) - 1] == '*')
2725 strcat (pattern_str
, "-*");
2727 strcat (pattern_str
, "*-*");
2731 pattern_str
= (char *) SDATA (pattern
);
2733 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2737 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2738 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2739 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2742 static struct font_name
*
2743 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2744 struct font_name
*fonts1
, *fonts2
;
2745 int nfonts1
, nfonts2
;
2747 int new_nfonts
= nfonts1
+ nfonts2
;
2748 struct font_name
*new_fonts
;
2750 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2751 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2752 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2759 /* Get a sorted list of fonts of family FAMILY on frame F.
2761 If PATTERN is non-nil, list fonts matching that pattern.
2763 If REGISTRY is non-nil, it is a list of registry (and encoding)
2764 names. Return fonts with those registries and the alternative
2765 registries from Vface_alternative_font_registry_alist.
2767 If REGISTRY is nil return fonts of any registry.
2769 Set *FONTS to a vector of font_name structures allocated from the
2770 heap containing the fonts found. Value is the number of fonts
2774 font_list (f
, pattern
, family
, registry
, fonts
)
2776 Lisp_Object pattern
, family
, registry
;
2777 struct font_name
**fonts
;
2783 if (NILP (registry
))
2784 return font_list_1 (f
, pattern
, family
, registry
, fonts
);
2786 for (reg_prio
= 0, nfonts
= 0; CONSP (registry
); registry
= XCDR (registry
))
2788 Lisp_Object elt
, alter
;
2790 struct font_name
*fonts2
;
2792 elt
= XCAR (registry
);
2793 alter
= Fassoc (elt
, Vface_alternative_font_registry_alist
);
2795 alter
= Fcons (elt
, Qnil
);
2796 for (; CONSP (alter
); alter
= XCDR (alter
), reg_prio
++)
2798 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
), &fonts2
);
2802 for (i
= 0; i
< nfonts2
; i
++)
2803 fonts2
[i
].registry_priority
= reg_prio
;
2805 *fonts
= concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
);
2817 /* Remove elements from LIST whose cars are `equal'. Called from
2818 x-family-fonts and x-font-family-list to remove duplicate font
2822 remove_duplicates (list
)
2825 Lisp_Object tail
= list
;
2827 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2829 Lisp_Object next
= XCDR (tail
);
2830 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2831 XSETCDR (tail
, XCDR (next
));
2838 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2839 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2840 If FAMILY is omitted or nil, list all families.
2841 Otherwise, FAMILY must be a string, possibly containing wildcards
2843 If FRAME is omitted or nil, use the selected frame.
2844 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2845 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2846 FAMILY is the font family name. POINT-SIZE is the size of the
2847 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2848 width, weight and slant of the font. These symbols are the same as for
2849 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2850 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2851 giving the registry and encoding of the font.
2852 The result list is sorted according to the current setting of
2853 the face font sort order. */)
2855 Lisp_Object family
, frame
;
2857 struct frame
*f
= check_x_frame (frame
);
2858 struct font_name
*fonts
;
2861 struct gcpro gcpro1
;
2864 CHECK_STRING (family
);
2868 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2869 for (i
= nfonts
- 1; i
>= 0; --i
)
2871 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2874 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2875 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2876 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2877 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2878 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2879 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2880 tem
= build_font_name (fonts
+ i
);
2881 ASET (v
, 6, build_string (tem
));
2882 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2883 fonts
[i
].fields
[XLFD_ENCODING
]);
2884 ASET (v
, 7, build_string (tem
));
2887 result
= Fcons (v
, result
);
2890 remove_duplicates (result
);
2891 free_font_names (fonts
, nfonts
);
2897 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2899 doc
: /* Return a list of available font families on FRAME.
2900 If FRAME is omitted or nil, use the selected frame.
2901 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2902 is a font family, and FIXED-P is non-nil if fonts of that family
2903 are fixed-pitch. */)
2907 struct frame
*f
= check_x_frame (frame
);
2909 struct font_name
*fonts
;
2911 struct gcpro gcpro1
;
2912 int count
= SPECPDL_INDEX ();
2914 /* Let's consider all fonts. */
2915 specbind (intern ("font-list-limit"), make_number (-1));
2916 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2920 for (i
= nfonts
- 1; i
>= 0; --i
)
2921 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2922 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2925 remove_duplicates (result
);
2926 free_font_names (fonts
, nfonts
);
2928 return unbind_to (count
, result
);
2932 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2933 doc
: /* Return a list of the names of available fonts matching PATTERN.
2934 If optional arguments FACE and FRAME are specified, return only fonts
2935 the same size as FACE on FRAME.
2936 PATTERN is a string, perhaps with wildcard characters;
2937 the * character matches any substring, and
2938 the ? character matches any single character.
2939 PATTERN is case-insensitive.
2940 FACE is a face name--a symbol.
2942 The return value is a list of strings, suitable as arguments to
2945 Fonts Emacs can't use may or may not be excluded
2946 even if they match PATTERN and FACE.
2947 The optional fourth argument MAXIMUM sets a limit on how many
2948 fonts to match. The first MAXIMUM fonts are reported.
2949 The optional fifth argument WIDTH, if specified, is a number of columns
2950 occupied by a character of a font. In that case, return only fonts
2951 the WIDTH times as wide as FACE on FRAME. */)
2952 (pattern
, face
, frame
, maximum
, width
)
2953 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2960 CHECK_STRING (pattern
);
2966 CHECK_NATNUM (maximum
);
2967 maxnames
= XINT (maximum
);
2971 CHECK_NUMBER (width
);
2973 /* We can't simply call check_x_frame because this function may be
2974 called before any frame is created. */
2975 f
= frame_or_selected_frame (frame
, 2);
2976 if (!FRAME_WINDOW_P (f
))
2978 /* Perhaps we have not yet created any frame. */
2983 /* Determine the width standard for comparison with the fonts we find. */
2989 /* This is of limited utility since it works with character
2990 widths. Keep it for compatibility. --gerd. */
2991 int face_id
= lookup_named_face (f
, face
);
2992 struct face
*face
= (face_id
< 0
2994 : FACE_FROM_ID (f
, face_id
));
2997 /* For historic reasons, FONT_WIDTH refers to average width on W32,
2998 not maximum as on X. Redefine here. */
3000 #define FONT_WIDTH FONT_MAX_WIDTH
3003 if (face
&& face
->font
)
3004 size
= FONT_WIDTH (face
->font
);
3006 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3009 size
*= XINT (width
);
3013 Lisp_Object args
[2];
3015 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3017 /* We don't have to check fontsets. */
3019 args
[1] = list_fontsets (f
, pattern
, size
);
3020 return Fnconc (2, args
);
3024 #endif /* HAVE_WINDOW_SYSTEM */
3028 /***********************************************************************
3030 ***********************************************************************/
3032 /* Access face attributes of face LFACE, a Lisp vector. */
3034 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3035 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3036 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3037 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3038 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3039 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3040 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3041 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3042 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3043 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3044 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3045 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3046 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3047 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3048 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3049 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3050 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3052 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3053 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3055 #define LFACEP(LFACE) \
3057 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3058 && EQ (AREF (LFACE, 0), Qface))
3063 /* Check consistency of Lisp face attribute vector ATTRS. */
3066 check_lface_attrs (attrs
)
3069 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3070 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3071 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3072 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3073 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3074 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3075 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3076 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3077 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3078 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3079 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3080 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3081 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3082 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3083 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3084 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3085 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3086 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3087 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3088 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3089 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3090 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3091 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3092 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3093 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3094 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3095 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3096 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3097 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3098 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3099 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3100 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3101 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3102 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3103 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3104 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3105 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3106 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3107 #ifdef HAVE_WINDOW_SYSTEM
3108 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3109 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3110 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3111 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3112 || NILP (attrs
[LFACE_FONT_INDEX
])
3113 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3114 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3115 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3120 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3128 xassert (LFACEP (lface
));
3129 check_lface_attrs (XVECTOR (lface
)->contents
);
3133 #else /* GLYPH_DEBUG == 0 */
3135 #define check_lface_attrs(attrs) (void) 0
3136 #define check_lface(lface) (void) 0
3138 #endif /* GLYPH_DEBUG == 0 */
3141 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3142 to make it a symvol. If FACE_NAME is an alias for another face,
3143 return that face's name. */
3146 resolve_face_name (face_name
)
3147 Lisp_Object face_name
;
3149 Lisp_Object aliased
;
3151 if (STRINGP (face_name
))
3152 face_name
= intern (SDATA (face_name
));
3154 while (SYMBOLP (face_name
))
3156 aliased
= Fget (face_name
, Qface_alias
);
3160 face_name
= aliased
;
3167 /* Return the face definition of FACE_NAME on frame F. F null means
3168 return the definition for new frames. FACE_NAME may be a string or
3169 a symbol (apparently Emacs 20.2 allowed strings as face names in
3170 face text properties; Ediff uses that). If FACE_NAME is an alias
3171 for another face, return that face's definition. If SIGNAL_P is
3172 non-zero, signal an error if FACE_NAME is not a valid face name.
3173 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3176 static INLINE Lisp_Object
3177 lface_from_face_name (f
, face_name
, signal_p
)
3179 Lisp_Object face_name
;
3184 face_name
= resolve_face_name (face_name
);
3187 lface
= assq_no_quit (face_name
, f
->face_alist
);
3189 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3192 lface
= XCDR (lface
);
3194 signal_error ("Invalid face", face_name
);
3196 check_lface (lface
);
3201 /* Get face attributes of face FACE_NAME from frame-local faces on
3202 frame F. Store the resulting attributes in ATTRS which must point
3203 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3204 is non-zero, signal an error if FACE_NAME does not name a face.
3205 Otherwise, value is zero if FACE_NAME is not a face. */
3208 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3210 Lisp_Object face_name
;
3217 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3220 bcopy (XVECTOR (lface
)->contents
, attrs
,
3221 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3231 /* Non-zero if all attributes in face attribute vector ATTRS are
3232 specified, i.e. are non-nil. */
3235 lface_fully_specified_p (attrs
)
3240 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3241 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3242 && i
!= LFACE_AVGWIDTH_INDEX
&& i
!= LFACE_FONTSET_INDEX
)
3243 if (UNSPECIFIEDP (attrs
[i
]))
3246 return i
== LFACE_VECTOR_SIZE
;
3249 #ifdef HAVE_WINDOW_SYSTEM
3251 /* Set font-related attributes of Lisp face LFACE from the fullname of
3252 the font opened by FONTNAME. If FORCE_P is zero, set only
3253 unspecified attributes of LFACE. The exception is `font'
3254 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3256 If FONTNAME is not available on frame F,
3257 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3258 If the fullname is not in a valid XLFD format,
3259 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3260 in LFACE and return 1.
3261 Otherwise, return 1. */
3264 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3267 Lisp_Object fontname
;
3268 int force_p
, may_fail_p
;
3270 struct font_name font
;
3275 char *font_name
= SDATA (fontname
);
3276 struct font_info
*font_info
;
3278 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3279 fontset
= fs_query_fontset (fontname
, 0);
3281 font_name
= SDATA (fontset_ascii (fontset
));
3282 else if (fontset
== 0)
3289 /* Check if FONT_NAME is surely available on the system. Usually
3290 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3291 returns quickly. But, even if FONT_NAME is not yet cached,
3292 caching it now is not futail because we anyway load the font
3295 font_info
= FS_LOAD_FONT (f
, font_name
);
3305 font
.name
= STRDUPA (font_info
->full_name
);
3306 have_xlfd_p
= split_font_name (f
, &font
, 1);
3308 /* Set attributes only if unspecified, otherwise face defaults for
3309 new frames would never take effect. If we couldn't get a font
3310 name conforming to XLFD, set normal values. */
3312 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3317 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3318 + strlen (font
.fields
[XLFD_FOUNDRY
])
3320 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3321 font
.fields
[XLFD_FAMILY
]);
3322 val
= build_string (buffer
);
3325 val
= build_string ("*");
3326 LFACE_FAMILY (lface
) = val
;
3329 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3332 pt
= xlfd_point_size (f
, &font
);
3334 pt
= pixel_point_size (f
, font_info
->height
* 10);
3336 LFACE_HEIGHT (lface
) = make_number (pt
);
3339 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3340 LFACE_SWIDTH (lface
)
3341 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3343 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3344 LFACE_AVGWIDTH (lface
)
3346 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3349 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3350 LFACE_WEIGHT (lface
)
3351 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3353 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3355 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3359 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3360 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3363 LFACE_FONT (lface
) = fontname
;
3367 #endif /* HAVE_WINDOW_SYSTEM */
3370 /* Merges the face height FROM with the face height TO, and returns the
3371 merged height. If FROM is an invalid height, then INVALID is
3372 returned instead. FROM and TO may be either absolute face heights or
3373 `relative' heights; the returned value is always an absolute height
3374 unless both FROM and TO are relative. GCPRO is a lisp value that
3375 will be protected from garbage-collection if this function makes a
3379 merge_face_heights (from
, to
, invalid
, gcpro
)
3380 Lisp_Object from
, to
, invalid
, gcpro
;
3382 Lisp_Object result
= invalid
;
3384 if (INTEGERP (from
))
3385 /* FROM is absolute, just use it as is. */
3387 else if (FLOATP (from
))
3388 /* FROM is a scale, use it to adjust TO. */
3391 /* relative X absolute => absolute */
3392 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3393 else if (FLOATP (to
))
3394 /* relative X relative => relative */
3395 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3397 else if (FUNCTIONP (from
))
3398 /* FROM is a function, which use to adjust TO. */
3400 /* Call function with current height as argument.
3401 From is the new height. */
3402 Lisp_Object args
[2];
3403 struct gcpro gcpro1
;
3409 result
= safe_call (2, args
);
3413 /* Ensure that if TO was absolute, so is the result. */
3414 if (INTEGERP (to
) && !INTEGERP (result
))
3422 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3423 store the resulting attributes in TO, which must be already be
3424 completely specified and contain only absolute attributes. Every
3425 specified attribute of FROM overrides the corresponding attribute of
3426 TO; relative attributes in FROM are merged with the absolute value in
3427 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3428 face inheritance; it should be Qnil when called from other places. */
3431 merge_face_vectors (f
, from
, to
, cycle_check
)
3433 Lisp_Object
*from
, *to
;
3434 Lisp_Object cycle_check
;
3438 /* If FROM inherits from some other faces, merge their attributes into
3439 TO before merging FROM's direct attributes. Note that an :inherit
3440 attribute of `unspecified' is the same as one of nil; we never
3441 merge :inherit attributes, so nil is more correct, but lots of
3442 other code uses `unspecified' as a generic value for face attributes. */
3443 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3444 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3445 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3447 /* If TO specifies a :font attribute, and FROM specifies some
3448 font-related attribute, we need to clear TO's :font attribute
3449 (because it will be inconsistent with whatever FROM specifies, and
3450 FROM takes precedence). */
3451 if (!NILP (to
[LFACE_FONT_INDEX
])
3452 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3453 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3454 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3455 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3456 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3457 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3458 to
[LFACE_FONT_INDEX
] = Qnil
;
3460 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3461 if (!UNSPECIFIEDP (from
[i
]))
3463 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3464 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3469 /* TO is always an absolute face, which should inherit from nothing.
3470 We blindly copy the :inherit attribute above and fix it up here. */
3471 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3475 /* Checks the `cycle check' variable CHECK to see if it indicates that
3476 EL is part of a cycle; CHECK must be either Qnil or a value returned
3477 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3478 elements after which a cycle might be suspected; after that many
3479 elements, this macro begins consing in order to keep more precise
3482 Returns nil if a cycle was detected, otherwise a new value for CHECK
3485 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3486 the caller should make sure that's ok. */
3488 #define CYCLE_CHECK(check, el, suspicious) \
3491 : (INTEGERP (check) \
3492 ? (XFASTINT (check) < (suspicious) \
3493 ? make_number (XFASTINT (check) + 1) \
3494 : Fcons (el, Qnil)) \
3495 : (!NILP (Fmemq ((el), (check))) \
3497 : Fcons ((el), (check)))))
3500 /* Merge face attributes from the face on frame F whose name is
3501 INHERITS, into the vector of face attributes TO; INHERITS may also be
3502 a list of face names, in which case they are applied in order.
3503 CYCLE_CHECK is used to detect loops in face inheritance.
3504 Returns true if any of the inherited attributes are `font-related'. */
3507 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3509 Lisp_Object inherit
;
3511 Lisp_Object cycle_check
;
3513 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3514 /* Inherit from the named face INHERIT. */
3518 /* Make sure we're not in an inheritance loop. */
3519 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3520 if (NILP (cycle_check
))
3521 /* Cycle detected, ignore any further inheritance. */
3524 lface
= lface_from_face_name (f
, inherit
, 0);
3526 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3528 else if (CONSP (inherit
))
3529 /* Handle a list of inherited faces by calling ourselves recursively
3530 on each element. Note that we only do so for symbol elements, so
3531 it's not possible to infinitely recurse. */
3533 while (CONSP (inherit
))
3535 if (SYMBOLP (XCAR (inherit
)))
3536 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3538 /* Check for a circular inheritance list. */
3539 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3540 if (NILP (cycle_check
))
3541 /* Cycle detected. */
3544 inherit
= XCDR (inherit
);
3550 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3551 is a face property, determine the resulting face attributes on
3552 frame F, and store them in TO. PROP may be a single face
3553 specification or a list of such specifications. Each face
3554 specification can be
3556 1. A symbol or string naming a Lisp face.
3558 2. A property list of the form (KEYWORD VALUE ...) where each
3559 KEYWORD is a face attribute name, and value is an appropriate value
3562 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3563 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3564 for compatibility with 20.2.
3566 Face specifications earlier in lists take precedence over later
3570 merge_face_vector_with_property (f
, to
, prop
)
3577 Lisp_Object first
= XCAR (prop
);
3579 if (EQ (first
, Qforeground_color
)
3580 || EQ (first
, Qbackground_color
))
3582 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3583 . COLOR). COLOR must be a string. */
3584 Lisp_Object color_name
= XCDR (prop
);
3585 Lisp_Object color
= first
;
3587 if (STRINGP (color_name
))
3589 if (EQ (color
, Qforeground_color
))
3590 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3592 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3595 add_to_log ("Invalid face color", color_name
, Qnil
);
3597 else if (SYMBOLP (first
)
3598 && *SDATA (SYMBOL_NAME (first
)) == ':')
3600 /* Assume this is the property list form. */
3601 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3603 Lisp_Object keyword
= XCAR (prop
);
3604 Lisp_Object value
= XCAR (XCDR (prop
));
3606 if (EQ (keyword
, QCfamily
))
3608 if (STRINGP (value
))
3609 to
[LFACE_FAMILY_INDEX
] = value
;
3611 add_to_log ("Invalid face font family", value
, Qnil
);
3613 else if (EQ (keyword
, QCheight
))
3615 Lisp_Object new_height
=
3616 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3619 if (NILP (new_height
))
3620 add_to_log ("Invalid face font height", value
, Qnil
);
3622 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3624 else if (EQ (keyword
, QCweight
))
3627 && face_numeric_weight (value
) >= 0)
3628 to
[LFACE_WEIGHT_INDEX
] = value
;
3630 add_to_log ("Invalid face weight", value
, Qnil
);
3632 else if (EQ (keyword
, QCslant
))
3635 && face_numeric_slant (value
) >= 0)
3636 to
[LFACE_SLANT_INDEX
] = value
;
3638 add_to_log ("Invalid face slant", value
, Qnil
);
3640 else if (EQ (keyword
, QCunderline
))
3645 to
[LFACE_UNDERLINE_INDEX
] = value
;
3647 add_to_log ("Invalid face underline", value
, Qnil
);
3649 else if (EQ (keyword
, QCoverline
))
3654 to
[LFACE_OVERLINE_INDEX
] = value
;
3656 add_to_log ("Invalid face overline", value
, Qnil
);
3658 else if (EQ (keyword
, QCstrike_through
))
3663 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3665 add_to_log ("Invalid face strike-through", value
, Qnil
);
3667 else if (EQ (keyword
, QCbox
))
3670 value
= make_number (1);
3671 if (INTEGERP (value
)
3675 to
[LFACE_BOX_INDEX
] = value
;
3677 add_to_log ("Invalid face box", value
, Qnil
);
3679 else if (EQ (keyword
, QCinverse_video
)
3680 || EQ (keyword
, QCreverse_video
))
3682 if (EQ (value
, Qt
) || NILP (value
))
3683 to
[LFACE_INVERSE_INDEX
] = value
;
3685 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3687 else if (EQ (keyword
, QCforeground
))
3689 if (STRINGP (value
))
3690 to
[LFACE_FOREGROUND_INDEX
] = value
;
3692 add_to_log ("Invalid face foreground", value
, Qnil
);
3694 else if (EQ (keyword
, QCbackground
))
3696 if (STRINGP (value
))
3697 to
[LFACE_BACKGROUND_INDEX
] = value
;
3699 add_to_log ("Invalid face background", value
, Qnil
);
3701 else if (EQ (keyword
, QCstipple
))
3703 #ifdef HAVE_X_WINDOWS
3704 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3705 if (!NILP (pixmap_p
))
3706 to
[LFACE_STIPPLE_INDEX
] = value
;
3708 add_to_log ("Invalid face stipple", value
, Qnil
);
3711 else if (EQ (keyword
, QCwidth
))
3714 && face_numeric_swidth (value
) >= 0)
3715 to
[LFACE_SWIDTH_INDEX
] = value
;
3717 add_to_log ("Invalid face width", value
, Qnil
);
3719 else if (EQ (keyword
, QCinherit
))
3721 if (SYMBOLP (value
))
3722 to
[LFACE_INHERIT_INDEX
] = value
;
3726 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3727 if (!SYMBOLP (XCAR (tail
)))
3730 to
[LFACE_INHERIT_INDEX
] = value
;
3732 add_to_log ("Invalid face inherit", value
, Qnil
);
3736 add_to_log ("Invalid attribute %s in face property",
3739 prop
= XCDR (XCDR (prop
));
3744 /* This is a list of face specs. Specifications at the
3745 beginning of the list take precedence over later
3746 specifications, so we have to merge starting with the
3747 last specification. */
3748 Lisp_Object next
= XCDR (prop
);
3750 merge_face_vector_with_property (f
, to
, next
);
3751 merge_face_vector_with_property (f
, to
, first
);
3756 /* PROP ought to be a face name. */
3757 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3759 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3761 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3766 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3767 Sinternal_make_lisp_face
, 1, 2, 0,
3768 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3769 If FACE was not known as a face before, create a new one.
3770 If optional argument FRAME is specified, make a frame-local face
3771 for that frame. Otherwise operate on the global face definition.
3772 Value is a vector of face attributes. */)
3774 Lisp_Object face
, frame
;
3776 Lisp_Object global_lface
, lface
;
3780 CHECK_SYMBOL (face
);
3781 global_lface
= lface_from_face_name (NULL
, face
, 0);
3785 CHECK_LIVE_FRAME (frame
);
3787 lface
= lface_from_face_name (f
, face
, 0);
3790 f
= NULL
, lface
= Qnil
;
3792 /* Add a global definition if there is none. */
3793 if (NILP (global_lface
))
3795 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3797 AREF (global_lface
, 0) = Qface
;
3798 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3799 Vface_new_frame_defaults
);
3801 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3802 face id to Lisp face is given by the vector lface_id_to_name.
3803 The mapping from Lisp face to Lisp face id is given by the
3804 property `face' of the Lisp face name. */
3805 if (next_lface_id
== lface_id_to_name_size
)
3807 int new_size
= max (50, 2 * lface_id_to_name_size
);
3808 int sz
= new_size
* sizeof *lface_id_to_name
;
3809 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3810 lface_id_to_name_size
= new_size
;
3813 lface_id_to_name
[next_lface_id
] = face
;
3814 Fput (face
, Qface
, make_number (next_lface_id
));
3818 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3819 AREF (global_lface
, i
) = Qunspecified
;
3821 /* Add a frame-local definition. */
3826 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3828 AREF (lface
, 0) = Qface
;
3829 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3832 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3833 AREF (lface
, i
) = Qunspecified
;
3836 lface
= global_lface
;
3838 /* Changing a named face means that all realized faces depending on
3839 that face are invalid. Since we cannot tell which realized faces
3840 depend on the face, make sure they are all removed. This is done
3841 by incrementing face_change_count. The next call to
3842 init_iterator will then free realized faces. */
3843 ++face_change_count
;
3844 ++windows_or_buffers_changed
;
3846 xassert (LFACEP (lface
));
3847 check_lface (lface
);
3852 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3853 Sinternal_lisp_face_p
, 1, 2, 0,
3854 doc
: /* Return non-nil if FACE names a face.
3855 If optional second parameter FRAME is non-nil, check for the
3856 existence of a frame-local face with name FACE on that frame.
3857 Otherwise check for the existence of a global face. */)
3859 Lisp_Object face
, frame
;
3865 CHECK_LIVE_FRAME (frame
);
3866 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3869 lface
= lface_from_face_name (NULL
, face
, 0);
3875 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3876 Sinternal_copy_lisp_face
, 4, 4, 0,
3877 doc
: /* Copy face FROM to TO.
3878 If FRAME it t, copy the global face definition of FROM to the
3879 global face definition of TO. Otherwise, copy the frame-local
3880 definition of FROM on FRAME to the frame-local definition of TO
3881 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3884 (from
, to
, frame
, new_frame
)
3885 Lisp_Object from
, to
, frame
, new_frame
;
3887 Lisp_Object lface
, copy
;
3889 CHECK_SYMBOL (from
);
3891 if (NILP (new_frame
))
3896 /* Copy global definition of FROM. We don't make copies of
3897 strings etc. because 20.2 didn't do it either. */
3898 lface
= lface_from_face_name (NULL
, from
, 1);
3899 copy
= Finternal_make_lisp_face (to
, Qnil
);
3903 /* Copy frame-local definition of FROM. */
3904 CHECK_LIVE_FRAME (frame
);
3905 CHECK_LIVE_FRAME (new_frame
);
3906 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3907 copy
= Finternal_make_lisp_face (to
, new_frame
);
3910 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3911 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3913 /* Changing a named face means that all realized faces depending on
3914 that face are invalid. Since we cannot tell which realized faces
3915 depend on the face, make sure they are all removed. This is done
3916 by incrementing face_change_count. The next call to
3917 init_iterator will then free realized faces. */
3918 ++face_change_count
;
3919 ++windows_or_buffers_changed
;
3925 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3926 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3927 doc
: /* Set attribute ATTR of FACE to VALUE.
3928 FRAME being a frame means change the face on that frame.
3929 FRAME nil means change the face of the selected frame.
3930 FRAME t means change the default for new frames.
3931 FRAME 0 means change the face on all frames, and change the default
3933 (face
, attr
, value
, frame
)
3934 Lisp_Object face
, attr
, value
, frame
;
3937 Lisp_Object old_value
= Qnil
;
3938 /* Set 1 if ATTR is QCfont. */
3939 int font_attr_p
= 0;
3940 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3941 int font_related_attr_p
= 0;
3943 CHECK_SYMBOL (face
);
3944 CHECK_SYMBOL (attr
);
3946 face
= resolve_face_name (face
);
3948 /* If FRAME is 0, change face on all frames, and change the
3949 default for new frames. */
3950 if (INTEGERP (frame
) && XINT (frame
) == 0)
3953 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3954 FOR_EACH_FRAME (tail
, frame
)
3955 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3959 /* Set lface to the Lisp attribute vector of FACE. */
3961 lface
= lface_from_face_name (NULL
, face
, 1);
3965 frame
= selected_frame
;
3967 CHECK_LIVE_FRAME (frame
);
3968 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3970 /* If a frame-local face doesn't exist yet, create one. */
3972 lface
= Finternal_make_lisp_face (face
, frame
);
3975 if (EQ (attr
, QCfamily
))
3977 if (!UNSPECIFIEDP (value
))
3979 CHECK_STRING (value
);
3980 if (SCHARS (value
) == 0)
3981 signal_error ("Invalid face family", value
);
3983 old_value
= LFACE_FAMILY (lface
);
3984 LFACE_FAMILY (lface
) = value
;
3985 font_related_attr_p
= 1;
3987 else if (EQ (attr
, QCheight
))
3989 if (!UNSPECIFIEDP (value
))
3993 test
= (EQ (face
, Qdefault
)
3995 /* The default face must have an absolute size,
3996 otherwise, we do a test merge with a random
3997 height to see if VALUE's ok. */
3998 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
4000 if (!INTEGERP (test
) || XINT (test
) <= 0)
4001 signal_error ("Invalid face height", value
);
4004 old_value
= LFACE_HEIGHT (lface
);
4005 LFACE_HEIGHT (lface
) = value
;
4006 font_related_attr_p
= 1;
4008 else if (EQ (attr
, QCweight
))
4010 if (!UNSPECIFIEDP (value
))
4012 CHECK_SYMBOL (value
);
4013 if (face_numeric_weight (value
) < 0)
4014 signal_error ("Invalid face weight", value
);
4016 old_value
= LFACE_WEIGHT (lface
);
4017 LFACE_WEIGHT (lface
) = value
;
4018 font_related_attr_p
= 1;
4020 else if (EQ (attr
, QCslant
))
4022 if (!UNSPECIFIEDP (value
))
4024 CHECK_SYMBOL (value
);
4025 if (face_numeric_slant (value
) < 0)
4026 signal_error ("Invalid face slant", value
);
4028 old_value
= LFACE_SLANT (lface
);
4029 LFACE_SLANT (lface
) = value
;
4030 font_related_attr_p
= 1;
4032 else if (EQ (attr
, QCunderline
))
4034 if (!UNSPECIFIEDP (value
))
4035 if ((SYMBOLP (value
)
4037 && !EQ (value
, Qnil
))
4038 /* Underline color. */
4040 && SCHARS (value
) == 0))
4041 signal_error ("Invalid face underline", value
);
4043 old_value
= LFACE_UNDERLINE (lface
);
4044 LFACE_UNDERLINE (lface
) = value
;
4046 else if (EQ (attr
, QCoverline
))
4048 if (!UNSPECIFIEDP (value
))
4049 if ((SYMBOLP (value
)
4051 && !EQ (value
, Qnil
))
4052 /* Overline color. */
4054 && SCHARS (value
) == 0))
4055 signal_error ("Invalid face overline", value
);
4057 old_value
= LFACE_OVERLINE (lface
);
4058 LFACE_OVERLINE (lface
) = value
;
4060 else if (EQ (attr
, QCstrike_through
))
4062 if (!UNSPECIFIEDP (value
))
4063 if ((SYMBOLP (value
)
4065 && !EQ (value
, Qnil
))
4066 /* Strike-through color. */
4068 && SCHARS (value
) == 0))
4069 signal_error ("Invalid face strike-through", value
);
4071 old_value
= LFACE_STRIKE_THROUGH (lface
);
4072 LFACE_STRIKE_THROUGH (lface
) = value
;
4074 else if (EQ (attr
, QCbox
))
4078 /* Allow t meaning a simple box of width 1 in foreground color
4081 value
= make_number (1);
4083 if (UNSPECIFIEDP (value
))
4085 else if (NILP (value
))
4087 else if (INTEGERP (value
))
4088 valid_p
= XINT (value
) != 0;
4089 else if (STRINGP (value
))
4090 valid_p
= SCHARS (value
) > 0;
4091 else if (CONSP (value
))
4107 if (EQ (k
, QCline_width
))
4109 if (!INTEGERP (v
) || XINT (v
) == 0)
4112 else if (EQ (k
, QCcolor
))
4114 if (!STRINGP (v
) || SCHARS (v
) == 0)
4117 else if (EQ (k
, QCstyle
))
4119 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4126 valid_p
= NILP (tem
);
4132 signal_error ("Invalid face box", value
);
4134 old_value
= LFACE_BOX (lface
);
4135 LFACE_BOX (lface
) = value
;
4137 else if (EQ (attr
, QCinverse_video
)
4138 || EQ (attr
, QCreverse_video
))
4140 if (!UNSPECIFIEDP (value
))
4142 CHECK_SYMBOL (value
);
4143 if (!EQ (value
, Qt
) && !NILP (value
))
4144 signal_error ("Invalid inverse-video face attribute value", value
);
4146 old_value
= LFACE_INVERSE (lface
);
4147 LFACE_INVERSE (lface
) = value
;
4149 else if (EQ (attr
, QCforeground
))
4151 if (!UNSPECIFIEDP (value
))
4153 /* Don't check for valid color names here because it depends
4154 on the frame (display) whether the color will be valid
4155 when the face is realized. */
4156 CHECK_STRING (value
);
4157 if (SCHARS (value
) == 0)
4158 signal_error ("Empty foreground color value", value
);
4160 old_value
= LFACE_FOREGROUND (lface
);
4161 LFACE_FOREGROUND (lface
) = value
;
4163 else if (EQ (attr
, QCbackground
))
4165 if (!UNSPECIFIEDP (value
))
4167 /* Don't check for valid color names here because it depends
4168 on the frame (display) whether the color will be valid
4169 when the face is realized. */
4170 CHECK_STRING (value
);
4171 if (SCHARS (value
) == 0)
4172 signal_error ("Empty background color value", value
);
4174 old_value
= LFACE_BACKGROUND (lface
);
4175 LFACE_BACKGROUND (lface
) = value
;
4177 else if (EQ (attr
, QCstipple
))
4179 #ifdef HAVE_X_WINDOWS
4180 if (!UNSPECIFIEDP (value
)
4182 && NILP (Fbitmap_spec_p (value
)))
4183 signal_error ("Invalid stipple attribute", value
);
4184 old_value
= LFACE_STIPPLE (lface
);
4185 LFACE_STIPPLE (lface
) = value
;
4186 #endif /* HAVE_X_WINDOWS */
4188 else if (EQ (attr
, QCwidth
))
4190 if (!UNSPECIFIEDP (value
))
4192 CHECK_SYMBOL (value
);
4193 if (face_numeric_swidth (value
) < 0)
4194 signal_error ("Invalid face width", value
);
4196 old_value
= LFACE_SWIDTH (lface
);
4197 LFACE_SWIDTH (lface
) = value
;
4198 font_related_attr_p
= 1;
4200 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4202 #ifdef HAVE_WINDOW_SYSTEM
4203 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4205 /* Set font-related attributes of the Lisp face from an XLFD
4211 f
= SELECTED_FRAME ();
4213 f
= check_x_frame (frame
);
4215 if (!UNSPECIFIEDP (value
))
4217 CHECK_STRING (value
);
4219 /* VALUE may be a fontset name or an alias of fontset. In
4220 such a case, use the base fontset name. */
4221 tmp
= Fquery_fontset (value
, Qnil
);
4224 else if (EQ (attr
, QCfontset
))
4225 signal_error ("Invalid fontset name", value
);
4227 if (EQ (attr
, QCfont
))
4229 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4230 signal_error ("Invalid font or fontset name", value
);
4233 LFACE_FONTSET (lface
) = value
;
4238 #endif /* HAVE_WINDOW_SYSTEM */
4240 else if (EQ (attr
, QCinherit
))
4243 if (SYMBOLP (value
))
4246 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4247 if (!SYMBOLP (XCAR (tail
)))
4250 LFACE_INHERIT (lface
) = value
;
4252 signal_error ("Invalid face inheritance", value
);
4254 else if (EQ (attr
, QCbold
))
4256 old_value
= LFACE_WEIGHT (lface
);
4257 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4258 font_related_attr_p
= 1;
4260 else if (EQ (attr
, QCitalic
))
4262 old_value
= LFACE_SLANT (lface
);
4263 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4264 font_related_attr_p
= 1;
4267 signal_error ("Invalid face attribute name", attr
);
4269 if (font_related_attr_p
4270 && !UNSPECIFIEDP (value
))
4271 /* If a font-related attribute other than QCfont is specified, the
4272 original `font' attribute nor that of default face is useless
4273 to determine a new font. Thus, we set it to nil so that font
4274 selection mechanism doesn't use it. */
4275 LFACE_FONT (lface
) = Qnil
;
4277 /* Changing a named face means that all realized faces depending on
4278 that face are invalid. Since we cannot tell which realized faces
4279 depend on the face, make sure they are all removed. This is done
4280 by incrementing face_change_count. The next call to
4281 init_iterator will then free realized faces. */
4283 && (EQ (attr
, QCfont
)
4284 || EQ (attr
, QCfontset
)
4285 || NILP (Fequal (old_value
, value
))))
4287 ++face_change_count
;
4288 ++windows_or_buffers_changed
;
4291 if (!UNSPECIFIEDP (value
)
4292 && NILP (Fequal (old_value
, value
)))
4298 if (EQ (face
, Qdefault
))
4300 #ifdef HAVE_WINDOW_SYSTEM
4301 /* Changed font-related attributes of the `default' face are
4302 reflected in changed `font' frame parameters. */
4304 && (font_related_attr_p
|| font_attr_p
)
4305 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4306 set_font_frame_param (frame
, lface
);
4308 #endif /* HAVE_WINDOW_SYSTEM */
4310 if (EQ (attr
, QCforeground
))
4311 param
= Qforeground_color
;
4312 else if (EQ (attr
, QCbackground
))
4313 param
= Qbackground_color
;
4315 #ifdef HAVE_WINDOW_SYSTEM
4317 else if (EQ (face
, Qscroll_bar
))
4319 /* Changing the colors of `scroll-bar' sets frame parameters
4320 `scroll-bar-foreground' and `scroll-bar-background'. */
4321 if (EQ (attr
, QCforeground
))
4322 param
= Qscroll_bar_foreground
;
4323 else if (EQ (attr
, QCbackground
))
4324 param
= Qscroll_bar_background
;
4326 #endif /* not WINDOWSNT */
4327 else if (EQ (face
, Qborder
))
4329 /* Changing background color of `border' sets frame parameter
4331 if (EQ (attr
, QCbackground
))
4332 param
= Qborder_color
;
4334 else if (EQ (face
, Qcursor
))
4336 /* Changing background color of `cursor' sets frame parameter
4338 if (EQ (attr
, QCbackground
))
4339 param
= Qcursor_color
;
4341 else if (EQ (face
, Qmouse
))
4343 /* Changing background color of `mouse' sets frame parameter
4345 if (EQ (attr
, QCbackground
))
4346 param
= Qmouse_color
;
4348 #endif /* HAVE_WINDOW_SYSTEM */
4349 else if (EQ (face
, Qmenu
))
4351 /* Indicate that we have to update the menu bar when
4352 realizing faces on FRAME. FRAME t change the
4353 default for new frames. We do this by setting
4354 setting the flag in new face caches */
4357 struct frame
*f
= XFRAME (frame
);
4358 if (FRAME_FACE_CACHE (f
) == NULL
)
4359 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4360 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4363 menu_face_changed_default
= 1;
4369 /* Update `default-frame-alist', which is used for new frames. */
4371 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4374 /* Update the current frame's parameters. */
4377 cons
= XCAR (Vparam_value_alist
);
4378 XSETCAR (cons
, param
);
4379 XSETCDR (cons
, value
);
4380 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4389 #ifdef HAVE_WINDOW_SYSTEM
4391 /* Set the `font' frame parameter of FRAME determined from `default'
4392 face attributes LFACE. If a font name is explicitely
4393 specfied in LFACE, use it as is. Otherwise, determine a font name
4394 from the other font-related atrributes of LFACE. In that case, if
4395 there's no matching font, signals an error. */
4398 set_font_frame_param (frame
, lface
)
4399 Lisp_Object frame
, lface
;
4401 struct frame
*f
= XFRAME (frame
);
4403 if (FRAME_WINDOW_P (f
))
4405 Lisp_Object font_name
;
4408 if (STRINGP (LFACE_FONT (lface
)))
4409 font_name
= LFACE_FONT (lface
);
4412 /* Choose a font name that reflects LFACE's attributes and has
4413 the registry and encoding pattern specified in the default
4414 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4415 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
, NULL
);
4417 error ("No font matches the specified attribute");
4418 font_name
= build_string (font
);
4422 f
->default_face_done_p
= 0;
4423 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4428 /* Update the corresponding face when frame parameter PARAM on frame F
4429 has been assigned the value NEW_VALUE. */
4432 update_face_from_frame_parameter (f
, param
, new_value
)
4434 Lisp_Object param
, new_value
;
4438 /* If there are no faces yet, give up. This is the case when called
4439 from Fx_create_frame, and we do the necessary things later in
4440 face-set-after-frame-defaults. */
4441 if (NILP (f
->face_alist
))
4444 /* Changing a named face means that all realized faces depending on
4445 that face are invalid. Since we cannot tell which realized faces
4446 depend on the face, make sure they are all removed. This is done
4447 by incrementing face_change_count. The next call to
4448 init_iterator will then free realized faces. */
4449 ++face_change_count
;
4450 ++windows_or_buffers_changed
;
4452 if (EQ (param
, Qforeground_color
))
4454 lface
= lface_from_face_name (f
, Qdefault
, 1);
4455 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4456 ? new_value
: Qunspecified
);
4457 realize_basic_faces (f
);
4459 else if (EQ (param
, Qbackground_color
))
4463 /* Changing the background color might change the background
4464 mode, so that we have to load new defface specs. Call
4465 frame-update-face-colors to do that. */
4466 XSETFRAME (frame
, f
);
4467 call1 (Qframe_update_face_colors
, frame
);
4469 lface
= lface_from_face_name (f
, Qdefault
, 1);
4470 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4471 ? new_value
: Qunspecified
);
4472 realize_basic_faces (f
);
4474 if (EQ (param
, Qborder_color
))
4476 lface
= lface_from_face_name (f
, Qborder
, 1);
4477 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4478 ? new_value
: Qunspecified
);
4480 else if (EQ (param
, Qcursor_color
))
4482 lface
= lface_from_face_name (f
, Qcursor
, 1);
4483 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4484 ? new_value
: Qunspecified
);
4486 else if (EQ (param
, Qmouse_color
))
4488 lface
= lface_from_face_name (f
, Qmouse
, 1);
4489 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4490 ? new_value
: Qunspecified
);
4495 /* Get the value of X resource RESOURCE, class CLASS for the display
4496 of frame FRAME. This is here because ordinary `x-get-resource'
4497 doesn't take a frame argument. */
4499 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4500 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4501 (resource
, class, frame
)
4502 Lisp_Object resource
, class, frame
;
4504 Lisp_Object value
= Qnil
;
4505 CHECK_STRING (resource
);
4506 CHECK_STRING (class);
4507 CHECK_LIVE_FRAME (frame
);
4509 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4510 resource
, class, Qnil
, Qnil
);
4516 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4517 If VALUE is "on" or "true", return t. If VALUE is "off" or
4518 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4519 error; if SIGNAL_P is zero, return 0. */
4522 face_boolean_x_resource_value (value
, signal_p
)
4526 Lisp_Object result
= make_number (0);
4528 xassert (STRINGP (value
));
4530 if (xstricmp (SDATA (value
), "on") == 0
4531 || xstricmp (SDATA (value
), "true") == 0)
4533 else if (xstricmp (SDATA (value
), "off") == 0
4534 || xstricmp (SDATA (value
), "false") == 0)
4536 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4537 result
= Qunspecified
;
4539 signal_error ("Invalid face attribute value from X resource", value
);
4545 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4546 Finternal_set_lisp_face_attribute_from_resource
,
4547 Sinternal_set_lisp_face_attribute_from_resource
,
4548 3, 4, 0, doc
: /* */)
4549 (face
, attr
, value
, frame
)
4550 Lisp_Object face
, attr
, value
, frame
;
4552 CHECK_SYMBOL (face
);
4553 CHECK_SYMBOL (attr
);
4554 CHECK_STRING (value
);
4556 if (xstricmp (SDATA (value
), "unspecified") == 0)
4557 value
= Qunspecified
;
4558 else if (EQ (attr
, QCheight
))
4560 value
= Fstring_to_number (value
, make_number (10));
4561 if (XINT (value
) <= 0)
4562 signal_error ("Invalid face height from X resource", value
);
4564 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4565 value
= face_boolean_x_resource_value (value
, 1);
4566 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4567 value
= intern (SDATA (value
));
4568 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4569 value
= face_boolean_x_resource_value (value
, 1);
4570 else if (EQ (attr
, QCunderline
)
4571 || EQ (attr
, QCoverline
)
4572 || EQ (attr
, QCstrike_through
))
4574 Lisp_Object boolean_value
;
4576 /* If the result of face_boolean_x_resource_value is t or nil,
4577 VALUE does NOT specify a color. */
4578 boolean_value
= face_boolean_x_resource_value (value
, 0);
4579 if (SYMBOLP (boolean_value
))
4580 value
= boolean_value
;
4582 else if (EQ (attr
, QCbox
))
4583 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4585 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4588 #endif /* HAVE_WINDOW_SYSTEM */
4591 /***********************************************************************
4593 ***********************************************************************/
4595 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4597 /* Make menus on frame F appear as specified by the `menu' face. */
4600 x_update_menu_appearance (f
)
4603 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4607 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4611 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4612 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4613 const char *myname
= SDATA (Vx_resource_name
);
4616 const char *popup_path
= "popup_menu";
4618 const char *popup_path
= "menu.popup";
4621 if (STRINGP (LFACE_FOREGROUND (lface
)))
4623 sprintf (line
, "%s.%s*foreground: %s",
4625 SDATA (LFACE_FOREGROUND (lface
)));
4626 XrmPutLineResource (&rdb
, line
);
4627 sprintf (line
, "%s.pane.menubar*foreground: %s",
4628 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4629 XrmPutLineResource (&rdb
, line
);
4633 if (STRINGP (LFACE_BACKGROUND (lface
)))
4635 sprintf (line
, "%s.%s*background: %s",
4637 SDATA (LFACE_BACKGROUND (lface
)));
4638 XrmPutLineResource (&rdb
, line
);
4639 sprintf (line
, "%s.pane.menubar*background: %s",
4640 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4641 XrmPutLineResource (&rdb
, line
);
4646 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4647 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4648 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4649 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4650 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4651 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4654 const char *suffix
= "List";
4656 const char *suffix
= "";
4658 sprintf (line
, "%s.pane.menubar*font%s: %s",
4659 myname
, suffix
, face
->font_name
);
4660 XrmPutLineResource (&rdb
, line
);
4661 sprintf (line
, "%s.%s*font%s: %s",
4662 myname
, popup_path
, suffix
, face
->font_name
);
4663 XrmPutLineResource (&rdb
, line
);
4667 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4668 free_frame_menubar (f
);
4672 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4675 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4676 Sface_attribute_relative_p
,
4678 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4680 Lisp_Object attribute
, value
;
4682 if (EQ (value
, Qunspecified
))
4684 else if (EQ (attribute
, QCheight
))
4685 return INTEGERP (value
) ? Qnil
: Qt
;
4690 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4692 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4693 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4694 the result will be absolute, otherwise it will be relative. */)
4695 (attribute
, value1
, value2
)
4696 Lisp_Object attribute
, value1
, value2
;
4698 if (EQ (value1
, Qunspecified
))
4700 else if (EQ (attribute
, QCheight
))
4701 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4707 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4708 Sinternal_get_lisp_face_attribute
,
4710 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4711 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4712 face attribute name, signal an error.
4713 If the optional argument FRAME is given, report on face FACE in that
4714 frame. If FRAME is t, report on the defaults for face FACE (for new
4715 frames). If FRAME is omitted or nil, use the selected frame. */)
4716 (symbol
, keyword
, frame
)
4717 Lisp_Object symbol
, keyword
, frame
;
4719 Lisp_Object lface
, value
= Qnil
;
4721 CHECK_SYMBOL (symbol
);
4722 CHECK_SYMBOL (keyword
);
4725 lface
= lface_from_face_name (NULL
, symbol
, 1);
4729 frame
= selected_frame
;
4730 CHECK_LIVE_FRAME (frame
);
4731 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4734 if (EQ (keyword
, QCfamily
))
4735 value
= LFACE_FAMILY (lface
);
4736 else if (EQ (keyword
, QCheight
))
4737 value
= LFACE_HEIGHT (lface
);
4738 else if (EQ (keyword
, QCweight
))
4739 value
= LFACE_WEIGHT (lface
);
4740 else if (EQ (keyword
, QCslant
))
4741 value
= LFACE_SLANT (lface
);
4742 else if (EQ (keyword
, QCunderline
))
4743 value
= LFACE_UNDERLINE (lface
);
4744 else if (EQ (keyword
, QCoverline
))
4745 value
= LFACE_OVERLINE (lface
);
4746 else if (EQ (keyword
, QCstrike_through
))
4747 value
= LFACE_STRIKE_THROUGH (lface
);
4748 else if (EQ (keyword
, QCbox
))
4749 value
= LFACE_BOX (lface
);
4750 else if (EQ (keyword
, QCinverse_video
)
4751 || EQ (keyword
, QCreverse_video
))
4752 value
= LFACE_INVERSE (lface
);
4753 else if (EQ (keyword
, QCforeground
))
4754 value
= LFACE_FOREGROUND (lface
);
4755 else if (EQ (keyword
, QCbackground
))
4756 value
= LFACE_BACKGROUND (lface
);
4757 else if (EQ (keyword
, QCstipple
))
4758 value
= LFACE_STIPPLE (lface
);
4759 else if (EQ (keyword
, QCwidth
))
4760 value
= LFACE_SWIDTH (lface
);
4761 else if (EQ (keyword
, QCinherit
))
4762 value
= LFACE_INHERIT (lface
);
4763 else if (EQ (keyword
, QCfont
))
4764 value
= LFACE_FONT (lface
);
4765 else if (EQ (keyword
, QCfontset
))
4766 value
= LFACE_FONTSET (lface
);
4768 signal_error ("Invalid face attribute name", keyword
);
4774 DEFUN ("internal-lisp-face-attribute-values",
4775 Finternal_lisp_face_attribute_values
,
4776 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4777 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4778 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4782 Lisp_Object result
= Qnil
;
4784 CHECK_SYMBOL (attr
);
4786 if (EQ (attr
, QCweight
)
4787 || EQ (attr
, QCslant
)
4788 || EQ (attr
, QCwidth
))
4790 /* Extract permissible symbols from tables. */
4791 struct table_entry
*table
;
4794 if (EQ (attr
, QCweight
))
4795 table
= weight_table
, dim
= DIM (weight_table
);
4796 else if (EQ (attr
, QCslant
))
4797 table
= slant_table
, dim
= DIM (slant_table
);
4799 table
= swidth_table
, dim
= DIM (swidth_table
);
4801 for (i
= 0; i
< dim
; ++i
)
4803 Lisp_Object symbol
= *table
[i
].symbol
;
4804 Lisp_Object tail
= result
;
4807 && !EQ (XCAR (tail
), symbol
))
4811 result
= Fcons (symbol
, result
);
4814 else if (EQ (attr
, QCunderline
))
4815 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4816 else if (EQ (attr
, QCoverline
))
4817 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4818 else if (EQ (attr
, QCstrike_through
))
4819 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4820 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4821 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4827 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4828 Sinternal_merge_in_global_face
, 2, 2, 0,
4829 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4830 Default face attributes override any local face attributes. */)
4832 Lisp_Object face
, frame
;
4835 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4837 CHECK_LIVE_FRAME (frame
);
4838 global_lface
= lface_from_face_name (NULL
, face
, 1);
4839 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4840 if (NILP (local_lface
))
4841 local_lface
= Finternal_make_lisp_face (face
, frame
);
4843 /* Make every specified global attribute override the local one.
4844 BEWARE!! This is only used from `face-set-after-frame-default' where
4845 the local frame is defined from default specs in `face-defface-spec'
4846 and those should be overridden by global settings. Hence the strange
4847 "global before local" priority. */
4848 lvec
= XVECTOR (local_lface
)->contents
;
4849 gvec
= XVECTOR (global_lface
)->contents
;
4850 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4851 if (! UNSPECIFIEDP (gvec
[i
]))
4858 /* The following function is implemented for compatibility with 20.2.
4859 The function is used in x-resolve-fonts when it is asked to
4860 return fonts with the same size as the font of a face. This is
4861 done in fontset.el. */
4863 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4864 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4865 If the optional argument FRAME is given, report on face FACE in that frame.
4866 If FRAME is t, report on the defaults for face FACE (for new frames).
4867 The font default for a face is either nil, or a list
4868 of the form (bold), (italic) or (bold italic).
4869 If FRAME is omitted or nil, use the selected frame. */)
4871 Lisp_Object face
, frame
;
4875 Lisp_Object result
= Qnil
;
4876 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4878 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4879 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4880 result
= Fcons (Qbold
, result
);
4882 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4883 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4884 result
= Fcons (Qitalic
, result
);
4890 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4891 int face_id
= lookup_named_face (f
, face
);
4892 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4893 return face
? build_string (face
->font_name
) : Qnil
;
4898 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4899 all attributes are `equal'. Tries to be fast because this function
4900 is called quite often. */
4903 lface_equal_p (v1
, v2
)
4904 Lisp_Object
*v1
, *v2
;
4908 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4910 Lisp_Object a
= v1
[i
];
4911 Lisp_Object b
= v2
[i
];
4913 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4914 and the other is specified. */
4915 equal_p
= XTYPE (a
) == XTYPE (b
);
4924 equal_p
= ((SBYTES (a
)
4926 && bcmp (SDATA (a
), SDATA (b
),
4936 equal_p
= !NILP (Fequal (a
, b
));
4946 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4947 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4948 doc
: /* True if FACE1 and FACE2 are equal.
4949 If the optional argument FRAME is given, report on face FACE in that frame.
4950 If FRAME is t, report on the defaults for face FACE (for new frames).
4951 If FRAME is omitted or nil, use the selected frame. */)
4952 (face1
, face2
, frame
)
4953 Lisp_Object face1
, face2
, frame
;
4956 Lisp_Object lface1
, lface2
;
4958 lface1
= lface_from_face_name (NULL
, face1
, 1);
4959 lface2
= lface_from_face_name (NULL
, face2
, 1);
4960 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4961 XVECTOR (lface2
)->contents
);
4962 return equal_p
? Qt
: Qnil
;
4966 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4967 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4968 doc
: /* True if FACE has no attribute specified.
4969 If the optional argument FRAME is given, report on face FACE in that frame.
4970 If FRAME is t, report on the defaults for face FACE (for new frames).
4971 If FRAME is omitted or nil, use the selected frame. */)
4973 Lisp_Object face
, frame
;
4980 frame
= selected_frame
;
4981 CHECK_LIVE_FRAME (frame
);
4985 lface
= lface_from_face_name (NULL
, face
, 1);
4987 lface
= lface_from_face_name (f
, face
, 1);
4989 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4990 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4993 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4997 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4999 doc
: /* Return an alist of frame-local faces defined on FRAME.
5000 For internal use only. */)
5004 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5005 return f
->face_alist
;
5009 /* Return a hash code for Lisp string STRING with case ignored. Used
5010 below in computing a hash value for a Lisp face. */
5012 static INLINE
unsigned
5013 hash_string_case_insensitive (string
)
5016 const unsigned char *s
;
5018 xassert (STRINGP (string
));
5019 for (s
= SDATA (string
); *s
; ++s
)
5020 hash
= (hash
<< 1) ^ tolower (*s
);
5025 /* Return a hash code for face attribute vector V. */
5027 static INLINE
unsigned
5031 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5032 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5033 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5034 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5035 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5036 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5037 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5041 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5042 considering charsets/registries). They do if they specify the same
5043 family, point size, weight, width, slant, font, and fontset. Both
5044 LFACE1 and LFACE2 must be fully-specified. */
5047 lface_same_font_attributes_p (lface1
, lface2
)
5048 Lisp_Object
*lface1
, *lface2
;
5050 xassert (lface_fully_specified_p (lface1
)
5051 && lface_fully_specified_p (lface2
));
5052 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5053 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5054 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5055 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5056 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5057 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5058 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5059 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5060 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5061 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5062 && ! xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5063 SDATA (lface2
[LFACE_FONT_INDEX
]))))
5064 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5065 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5066 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5067 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
5068 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
5074 /***********************************************************************
5076 ***********************************************************************/
5078 /* Allocate and return a new realized face for Lisp face attribute
5081 static struct face
*
5082 make_realized_face (attr
)
5085 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5086 bzero (face
, sizeof *face
);
5087 face
->ascii_face
= face
;
5088 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5093 /* Free realized face FACE, including its X resources. FACE may
5097 free_realized_face (f
, face
)
5103 #ifdef HAVE_WINDOW_SYSTEM
5104 if (FRAME_WINDOW_P (f
))
5106 /* Free fontset of FACE if it is ASCII face. */
5107 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5108 free_face_fontset (f
, face
);
5111 x_free_gc (f
, face
->gc
);
5115 free_face_colors (f
, face
);
5116 x_destroy_bitmap (f
, face
->stipple
);
5118 #endif /* HAVE_WINDOW_SYSTEM */
5125 /* Prepare face FACE for subsequent display on frame F. This
5126 allocated GCs if they haven't been allocated yet or have been freed
5127 by clearing the face cache. */
5130 prepare_face_for_display (f
, face
)
5134 #ifdef HAVE_WINDOW_SYSTEM
5135 xassert (FRAME_WINDOW_P (f
));
5140 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5142 xgcv
.foreground
= face
->foreground
;
5143 xgcv
.background
= face
->background
;
5144 #ifdef HAVE_X_WINDOWS
5145 xgcv
.graphics_exposures
= False
;
5147 /* The font of FACE may be null if we couldn't load it. */
5150 #ifdef HAVE_X_WINDOWS
5151 xgcv
.font
= face
->font
->fid
;
5154 xgcv
.font
= face
->font
;
5157 xgcv
.font
= face
->font
;
5163 #ifdef HAVE_X_WINDOWS
5166 xgcv
.fill_style
= FillOpaqueStippled
;
5167 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5168 mask
|= GCFillStyle
| GCStipple
;
5171 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5174 #endif /* HAVE_WINDOW_SYSTEM */
5178 /* Returns the `distance' between the colors X and Y. */
5181 color_distance (x
, y
)
5184 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5185 Quoting from that paper:
5187 This formula has results that are very close to L*u*v* (with the
5188 modified lightness curve) and, more importantly, it is a more even
5189 algorithm: it does not have a range of colours where it suddenly
5190 gives far from optimal results.
5192 See <http://www.compuphase.com/cmetric.htm> for more info. */
5194 long r
= (x
->red
- y
->red
) >> 8;
5195 long g
= (x
->green
- y
->green
) >> 8;
5196 long b
= (x
->blue
- y
->blue
) >> 8;
5197 long r_mean
= (x
->red
+ y
->red
) >> 9;
5200 (((512 + r_mean
) * r
* r
) >> 8)
5202 + (((767 - r_mean
) * b
* b
) >> 8);
5206 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5207 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5208 COLOR1 and COLOR2 may be either strings containing the color name,
5209 or lists of the form (RED GREEN BLUE).
5210 If FRAME is unspecified or nil, the current frame is used. */)
5211 (color1
, color2
, frame
)
5212 Lisp_Object color1
, color2
, frame
;
5215 XColor cdef1
, cdef2
;
5218 frame
= selected_frame
;
5219 CHECK_LIVE_FRAME (frame
);
5222 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5223 || !STRINGP (color1
)
5224 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5225 signal_error ("Invalid color", color1
);
5226 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5227 || !STRINGP (color2
)
5228 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5229 signal_error ("Invalid color", color2
);
5231 return make_number (color_distance (&cdef1
, &cdef2
));
5235 /***********************************************************************
5236 Face capability testing for ttys
5237 ***********************************************************************/
5240 /* If the distance (as returned by color_distance) between two colors is
5241 less than this, then they are considered the same, for determining
5242 whether a color is supported or not. The range of values is 0-65535. */
5244 #define TTY_SAME_COLOR_THRESHOLD 10000
5247 DEFUN ("tty-supports-face-attributes-p",
5248 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5250 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5251 The optional argument FRAME is the frame on which to test; if it is nil
5252 or unspecified, then the current frame is used. If FRAME is not a tty
5253 frame, then nil is returned.
5255 The definition of `supported' is somewhat heuristic, but basically means
5256 that a face containing all the attributes in ATTRIBUTES, when merged
5257 with the default face for display, can be represented in a way that's
5259 \(1) different in appearance than the default face, and
5260 \(2) `close in spirit' to what the attributes specify, if not exact.
5262 Point (2) implies that a `:weight black' attribute will be satisified
5263 by any terminal that can display bold, and a `:foreground "yellow"' as
5264 long as the terminal can display a yellowish color, but `:slant italic'
5265 will _not_ be satisified by the tty display code's automatic
5266 substitution of a `dim' face for italic. */)
5268 Lisp_Object attributes
, frame
;
5272 Lisp_Object val
, fg
, bg
;
5273 XColor fg_tty_color
, fg_std_color
;
5274 XColor bg_tty_color
, bg_std_color
;
5275 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5276 unsigned test_caps
= 0;
5279 frame
= selected_frame
;
5280 CHECK_LIVE_FRAME (frame
);
5283 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5284 attrs
[i
] = Qunspecified
;
5285 merge_face_vector_with_property (f
, attrs
, attributes
);
5287 /* This function only works on ttys. */
5288 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5291 /* First check some easy-to-check stuff; ttys support none of the
5292 following attributes, so we can just return nil if any are requested. */
5295 val
= attrs
[LFACE_STIPPLE_INDEX
];
5296 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5300 val
= attrs
[LFACE_HEIGHT_INDEX
];
5301 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5305 val
= attrs
[LFACE_SWIDTH_INDEX
];
5306 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5307 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5311 val
= attrs
[LFACE_OVERLINE_INDEX
];
5312 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5315 /* strike-through */
5316 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5317 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5321 val
= attrs
[LFACE_BOX_INDEX
];
5322 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5325 /* slant (italics/oblique); We consider any non-default value
5326 unsupportable on ttys, even though the face code actually `fakes'
5327 them using a dim attribute if possible. This is because the faked
5328 result is too different from what the face specifies. */
5329 val
= attrs
[LFACE_SLANT_INDEX
];
5330 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5331 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5335 /* Test for terminal `capabilities' (non-color character attributes). */
5337 /* font weight (bold/dim) */
5338 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5341 if (weight
> XLFD_WEIGHT_MEDIUM
)
5342 test_caps
= TTY_CAP_BOLD
;
5343 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5344 test_caps
= TTY_CAP_DIM
;
5348 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5349 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5352 return Qnil
; /* ttys don't support colored underlines */
5354 test_caps
|= TTY_CAP_UNDERLINE
;
5358 val
= attrs
[LFACE_INVERSE_INDEX
];
5359 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5360 test_caps
|= TTY_CAP_INVERSE
;
5363 /* Color testing. */
5365 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5366 we use them when calling `tty_capable_p' below, even if the face
5367 specifies no colors. */
5368 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5369 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5371 /* Check if foreground color is close enough. */
5372 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5375 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5377 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5378 > TTY_SAME_COLOR_THRESHOLD
)
5382 /* Check if background color is close enough. */
5383 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5386 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5388 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5389 > TTY_SAME_COLOR_THRESHOLD
)
5393 /* If both foreground and background are requested, see if the
5394 distance between them is OK. We just check to see if the distance
5395 between the tty's foreground and background is close enough to the
5396 distance between the standard foreground and background. */
5397 if (STRINGP (fg
) && STRINGP (bg
))
5400 = (color_distance (&fg_std_color
, &bg_std_color
)
5401 - color_distance (&fg_tty_color
, &bg_tty_color
));
5402 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5403 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5408 /* See if the capabilities we selected above are supported, with the
5410 if (test_caps
!= 0 &&
5411 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5415 /* Hmmm, everything checks out, this terminal must support this face. */
5421 /***********************************************************************
5423 ***********************************************************************/
5425 /* Return a new face cache for frame F. */
5427 static struct face_cache
*
5431 struct face_cache
*c
;
5434 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5435 bzero (c
, sizeof *c
);
5436 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5437 c
->buckets
= (struct face
**) xmalloc (size
);
5438 bzero (c
->buckets
, size
);
5440 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5442 c
->menu_face_changed_p
= menu_face_changed_default
;
5447 /* Clear out all graphics contexts for all realized faces, except for
5448 the basic faces. This should be done from time to time just to avoid
5449 keeping too many graphics contexts that are no longer needed. */
5453 struct face_cache
*c
;
5455 if (c
&& FRAME_WINDOW_P (c
->f
))
5457 #ifdef HAVE_WINDOW_SYSTEM
5459 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5461 struct face
*face
= c
->faces_by_id
[i
];
5462 if (face
&& face
->gc
)
5464 x_free_gc (c
->f
, face
->gc
);
5468 #endif /* HAVE_WINDOW_SYSTEM */
5473 /* Free all realized faces in face cache C, including basic faces. C
5474 may be null. If faces are freed, make sure the frame's current
5475 matrix is marked invalid, so that a display caused by an expose
5476 event doesn't try to use faces we destroyed. */
5479 free_realized_faces (c
)
5480 struct face_cache
*c
;
5485 struct frame
*f
= c
->f
;
5487 /* We must block input here because we can't process X events
5488 safely while only some faces are freed, or when the frame's
5489 current matrix still references freed faces. */
5492 for (i
= 0; i
< c
->used
; ++i
)
5494 free_realized_face (f
, c
->faces_by_id
[i
]);
5495 c
->faces_by_id
[i
] = NULL
;
5499 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5500 bzero (c
->buckets
, size
);
5502 /* Must do a thorough redisplay the next time. Mark current
5503 matrices as invalid because they will reference faces freed
5504 above. This function is also called when a frame is
5505 destroyed. In this case, the root window of F is nil. */
5506 if (WINDOWP (f
->root_window
))
5508 clear_current_matrices (f
);
5509 ++windows_or_buffers_changed
;
5517 /* Free all realized faces that are using FONTSET on frame F. */
5520 free_realized_faces_for_fontset (f
, fontset
)
5524 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5528 /* We must block input here because we can't process X events safely
5529 while only some faces are freed, or when the frame's current
5530 matrix still references freed faces. */
5533 for (i
= 0; i
< cache
->used
; i
++)
5535 face
= cache
->faces_by_id
[i
];
5537 && face
->fontset
== fontset
)
5539 uncache_face (cache
, face
);
5540 free_realized_face (f
, face
);
5544 /* Must do a thorough redisplay the next time. Mark current
5545 matrices as invalid because they will reference faces freed
5546 above. This function is also called when a frame is destroyed.
5547 In this case, the root window of F is nil. */
5548 if (WINDOWP (f
->root_window
))
5550 clear_current_matrices (f
);
5551 ++windows_or_buffers_changed
;
5558 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5559 This is done after attributes of a named face have been changed,
5560 because we can't tell which realized faces depend on that face. */
5563 free_all_realized_faces (frame
)
5569 FOR_EACH_FRAME (rest
, frame
)
5570 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5573 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5577 /* Free face cache C and faces in it, including their X resources. */
5581 struct face_cache
*c
;
5585 free_realized_faces (c
);
5587 xfree (c
->faces_by_id
);
5593 /* Cache realized face FACE in face cache C. HASH is the hash value
5594 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5595 FACE), insert the new face to the beginning of the collision list
5596 of the face hash table of C. Otherwise, add the new face to the
5597 end of the collision list. This way, lookup_face can quickly find
5598 that a requested face is not cached. */
5601 cache_face (c
, face
, hash
)
5602 struct face_cache
*c
;
5606 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5610 if (face
->ascii_face
!= face
)
5612 struct face
*last
= c
->buckets
[i
];
5623 c
->buckets
[i
] = face
;
5624 face
->prev
= face
->next
= NULL
;
5630 face
->next
= c
->buckets
[i
];
5632 face
->next
->prev
= face
;
5633 c
->buckets
[i
] = face
;
5636 /* Find a free slot in C->faces_by_id and use the index of the free
5637 slot as FACE->id. */
5638 for (i
= 0; i
< c
->used
; ++i
)
5639 if (c
->faces_by_id
[i
] == NULL
)
5643 /* Maybe enlarge C->faces_by_id. */
5644 if (i
== c
->used
&& c
->used
== c
->size
)
5646 int new_size
= 2 * c
->size
;
5647 int sz
= new_size
* sizeof *c
->faces_by_id
;
5648 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5653 /* Check that FACE got a unique id. */
5658 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5659 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5665 #endif /* GLYPH_DEBUG */
5667 c
->faces_by_id
[i
] = face
;
5673 /* Remove face FACE from cache C. */
5676 uncache_face (c
, face
)
5677 struct face_cache
*c
;
5680 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5683 face
->prev
->next
= face
->next
;
5685 c
->buckets
[i
] = face
->next
;
5688 face
->next
->prev
= face
->prev
;
5690 c
->faces_by_id
[face
->id
] = NULL
;
5691 if (face
->id
== c
->used
)
5696 /* Look up a realized face with face attributes ATTR in the face cache
5697 of frame F. The face will be used to display ASCII characters.
5698 Value is the ID of the face found. If no suitable face is found,
5699 realize a new one. */
5702 lookup_face (f
, attr
)
5706 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5711 xassert (cache
!= NULL
);
5712 check_lface_attrs (attr
);
5714 /* Look up ATTR in the face cache. */
5715 hash
= lface_hash (attr
);
5716 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5718 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5720 if (face
->ascii_face
!= face
)
5722 /* There's no more ASCII face. */
5726 if (face
->hash
== hash
5727 && lface_equal_p (face
->lface
, attr
))
5731 /* If not found, realize a new face. */
5733 face
= realize_face (cache
, attr
, -1);
5736 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5737 #endif /* GLYPH_DEBUG */
5743 /* Look up a realized face that has the same attributes as BASE_FACE
5744 except for the font in the face cache of frame F. If FONT_ID is
5745 not negative, it is an ID number of an already opened font that is
5746 used by the face. If FONT_ID is negative, the face has no font.
5747 Value is the ID of the face found. If no suitable face is found,
5748 realize a new one. */
5751 lookup_non_ascii_face (f
, font_id
, base_face
)
5754 struct face
*base_face
;
5756 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5761 xassert (cache
!= NULL
);
5762 base_face
= base_face
->ascii_face
;
5763 hash
= lface_hash (base_face
->lface
);
5764 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5766 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5768 if (face
->ascii_face
== face
)
5770 if (face
->ascii_face
== base_face
5771 && face
->font_info_id
== font_id
)
5775 /* If not found, realize a new face. */
5777 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5780 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5781 #endif /* GLYPH_DEBUG */
5786 /* Return the face id of the realized face for named face SYMBOL on
5787 frame F suitable for displaying ASCII characters. Value is -1 if
5788 the face couldn't be determined, which might happen if the default
5789 face isn't realized and cannot be realized. */
5792 lookup_named_face (f
, symbol
)
5796 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5797 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5798 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5800 if (default_face
== NULL
)
5802 if (!realize_basic_faces (f
))
5804 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5807 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5808 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5809 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5810 return lookup_face (f
, attrs
);
5814 /* Return the ID of the realized ASCII face of Lisp face with ID
5815 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5818 ascii_face_of_lisp_face (f
, lface_id
)
5824 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5826 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5827 face_id
= lookup_named_face (f
, face_name
);
5836 /* Return a face for charset ASCII that is like the face with id
5837 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5838 STEPS < 0 means larger. Value is the id of the face. */
5841 smaller_face (f
, face_id
, steps
)
5845 #ifdef HAVE_WINDOW_SYSTEM
5847 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5848 int pt
, last_pt
, last_height
;
5851 struct face
*new_face
;
5853 /* If not called for an X frame, just return the original face. */
5854 if (FRAME_TERMCAP_P (f
))
5857 /* Try in increments of 1/2 pt. */
5858 delta
= steps
< 0 ? 5 : -5;
5859 steps
= abs (steps
);
5861 face
= FACE_FROM_ID (f
, face_id
);
5862 bcopy (face
->lface
, attrs
, sizeof attrs
);
5863 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5864 new_face_id
= face_id
;
5865 last_height
= FONT_HEIGHT (face
->font
);
5869 /* Give up if we cannot find a font within 10pt. */
5870 && abs (last_pt
- pt
) < 100)
5872 /* Look up a face for a slightly smaller/larger font. */
5874 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5875 new_face_id
= lookup_face (f
, attrs
);
5876 new_face
= FACE_FROM_ID (f
, new_face_id
);
5878 /* If height changes, count that as one step. */
5879 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5880 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5883 last_height
= FONT_HEIGHT (new_face
->font
);
5890 #else /* not HAVE_WINDOW_SYSTEM */
5894 #endif /* not HAVE_WINDOW_SYSTEM */
5898 /* Return a face for charset ASCII that is like the face with id
5899 FACE_ID on frame F, but has height HEIGHT. */
5902 face_with_height (f
, face_id
, height
)
5907 #ifdef HAVE_WINDOW_SYSTEM
5909 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5911 if (FRAME_TERMCAP_P (f
)
5915 face
= FACE_FROM_ID (f
, face_id
);
5916 bcopy (face
->lface
, attrs
, sizeof attrs
);
5917 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5918 face_id
= lookup_face (f
, attrs
);
5919 #endif /* HAVE_WINDOW_SYSTEM */
5925 /* Return the face id of the realized face for named face SYMBOL on
5926 frame F suitable for displaying ASCII characters, and use
5927 attributes of the face FACE_ID for attributes that aren't
5928 completely specified by SYMBOL. This is like lookup_named_face,
5929 except that the default attributes come from FACE_ID, not from the
5930 default face. FACE_ID is assumed to be already realized. */
5933 lookup_derived_face (f
, symbol
, face_id
)
5938 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5939 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5940 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5945 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5946 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5947 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5948 return lookup_face (f
, attrs
);
5951 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5952 Sface_attributes_as_vector
, 1, 1, 0,
5953 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5958 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5960 merge_face_vector_with_property (XFRAME (selected_frame
),
5961 XVECTOR (lface
)->contents
,
5968 /***********************************************************************
5970 ***********************************************************************/
5972 DEFUN ("internal-set-font-selection-order",
5973 Finternal_set_font_selection_order
,
5974 Sinternal_set_font_selection_order
, 1, 1, 0,
5975 doc
: /* Set font selection order for face font selection to ORDER.
5976 ORDER must be a list of length 4 containing the symbols `:width',
5977 `:height', `:weight', and `:slant'. Face attributes appearing
5978 first in ORDER are matched first, e.g. if `:height' appears before
5979 `:weight' in ORDER, font selection first tries to find a font with
5980 a suitable height, and then tries to match the font weight.
5987 int indices
[DIM (font_sort_order
)];
5990 bzero (indices
, sizeof indices
);
5994 CONSP (list
) && i
< DIM (indices
);
5995 list
= XCDR (list
), ++i
)
5997 Lisp_Object attr
= XCAR (list
);
6000 if (EQ (attr
, QCwidth
))
6002 else if (EQ (attr
, QCheight
))
6003 xlfd
= XLFD_POINT_SIZE
;
6004 else if (EQ (attr
, QCweight
))
6006 else if (EQ (attr
, QCslant
))
6011 if (indices
[i
] != 0)
6016 if (!NILP (list
) || i
!= DIM (indices
))
6017 signal_error ("Invalid font sort order", order
);
6018 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6019 if (indices
[i
] == 0)
6020 signal_error ("Invalid font sort order", order
);
6022 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6024 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6025 free_all_realized_faces (Qnil
);
6032 DEFUN ("internal-set-alternative-font-family-alist",
6033 Finternal_set_alternative_font_family_alist
,
6034 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6035 doc
: /* Define alternative font families to try in face font selection.
6036 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6037 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6038 be found. Value is ALIST. */)
6043 Vface_alternative_font_family_alist
= alist
;
6044 free_all_realized_faces (Qnil
);
6049 DEFUN ("internal-set-alternative-font-registry-alist",
6050 Finternal_set_alternative_font_registry_alist
,
6051 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6052 doc
: /* Define alternative font registries to try in face font selection.
6053 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6054 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6055 be found. Value is ALIST. */)
6060 Vface_alternative_font_registry_alist
= alist
;
6061 free_all_realized_faces (Qnil
);
6066 #ifdef HAVE_WINDOW_SYSTEM
6068 /* Value is non-zero if FONT is the name of a scalable font. The
6069 X11R6 XLFD spec says that point size, pixel size, and average width
6070 are zero for scalable fonts. Intlfonts contain at least one
6071 scalable font ("*-muleindian-1") for which this isn't true, so we
6072 just test average width. */
6075 font_scalable_p (font
)
6076 struct font_name
*font
;
6078 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6079 return (*s
== '0' && *(s
+ 1) == '\0')
6081 /* Windows implementation of XLFD is slightly broken for backward
6082 compatibility with previous broken versions, so test for
6083 wildcards as well as 0. */
6090 /* Ignore the difference of font point size less than this value. */
6092 #define FONT_POINT_SIZE_QUANTUM 5
6094 /* Value is non-zero if FONT1 is a better match for font attributes
6095 VALUES than FONT2. VALUES is an array of face attribute values in
6096 font sort order. COMPARE_PT_P zero means don't compare point
6097 sizes. AVGWIDTH, if not zero, is a specified font average width
6101 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6103 struct font_name
*font1
, *font2
;
6104 int compare_pt_p
, avgwidth
;
6108 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6110 int xlfd_idx
= font_sort_order
[i
];
6112 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6116 if (xlfd_idx
== XLFD_POINT_SIZE
)
6118 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6119 / font1
->rescale_ratio
));
6120 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6121 / font2
->rescale_ratio
));
6122 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6127 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6128 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6131 if (delta1
> delta2
)
6133 else if (delta1
< delta2
)
6137 /* The difference may be equal because, e.g., the face
6138 specifies `italic' but we have only `regular' and
6139 `oblique'. Prefer `oblique' in this case. */
6140 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6141 && font1
->numeric
[xlfd_idx
] > values
[i
]
6142 && font2
->numeric
[xlfd_idx
] < values
[i
])
6150 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6151 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6152 if (delta1
> delta2
)
6154 else if (delta1
< delta2
)
6158 return font1
->registry_priority
< font2
->registry_priority
;
6162 /* Value is non-zero if FONT is an exact match for face attributes in
6163 SPECIFIED. SPECIFIED is an array of face attribute values in font
6164 sort order. AVGWIDTH, if non-zero, is an average width to compare
6168 exact_face_match_p (specified
, font
, avgwidth
)
6170 struct font_name
*font
;
6175 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6176 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6179 return (i
== DIM (font_sort_order
)
6181 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6185 /* Value is the name of a scaled font, generated from scalable font
6186 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6187 Value is allocated from heap. */
6190 build_scalable_font_name (f
, font
, specified_pt
)
6192 struct font_name
*font
;
6195 char pixel_size
[20];
6197 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6200 /* If scalable font is for a specific resolution, compute
6201 the point size we must specify from the resolution of
6202 the display and the specified resolution of the font. */
6203 if (font
->numeric
[XLFD_RESY
] != 0)
6205 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6206 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6211 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6213 /* We may need a font of the different size. */
6214 pixel_value
*= font
->rescale_ratio
;
6216 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6217 font of the specified PIXEL_SIZE. */
6219 { /* Set point size of the font. */
6220 char point_size
[20];
6221 sprintf (point_size
, "%d", (int) pt
);
6222 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6223 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6227 /* Set pixel size. */
6228 sprintf (pixel_size
, "%d", pixel_value
);
6229 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6230 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6232 /* If font doesn't specify its resolution, use the
6233 resolution of the display. */
6234 if (font
->numeric
[XLFD_RESY
] == 0)
6237 sprintf (buffer
, "%d", (int) resy
);
6238 font
->fields
[XLFD_RESY
] = buffer
;
6239 font
->numeric
[XLFD_RESY
] = resy
;
6242 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6245 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6246 sprintf (buffer
, "%d", resx
);
6247 font
->fields
[XLFD_RESX
] = buffer
;
6248 font
->numeric
[XLFD_RESX
] = resx
;
6251 return build_font_name (font
);
6255 /* Value is non-zero if we are allowed to use scalable font FONT. We
6256 can't run a Lisp function here since this function may be called
6257 with input blocked. */
6260 may_use_scalable_font_p (font
)
6263 if (EQ (Vscalable_fonts_allowed
, Qt
))
6265 else if (CONSP (Vscalable_fonts_allowed
))
6267 Lisp_Object tail
, regexp
;
6269 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6271 regexp
= XCAR (tail
);
6272 if (STRINGP (regexp
)
6273 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6283 /* Return the name of the best matching font for face attributes ATTRS
6284 in the array of font_name structures FONTS which contains NFONTS
6285 elements. WIDTH_RATIO is a factor with which to multiply average
6286 widths if ATTRS specifies such a width.
6288 Value is a font name which is allocated from the heap. FONTS is
6289 freed by this function.
6291 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6292 indicate whether the resulting font should be drawn using overstrike
6293 to simulate bold-face. */
6296 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6299 struct font_name
*fonts
;
6302 int *needs_overstrike
;
6305 struct font_name
*best
;
6308 int exact_p
, avgwidth
;
6313 /* Make specified font attributes available in `specified',
6314 indexed by sort order. */
6315 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6317 int xlfd_idx
= font_sort_order
[i
];
6319 if (xlfd_idx
== XLFD_SWIDTH
)
6320 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6321 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6322 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6323 else if (xlfd_idx
== XLFD_WEIGHT
)
6324 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6325 else if (xlfd_idx
== XLFD_SLANT
)
6326 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6331 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6333 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6337 if (needs_overstrike
)
6338 *needs_overstrike
= 0;
6340 /* Start with the first non-scalable font in the list. */
6341 for (i
= 0; i
< nfonts
; ++i
)
6342 if (!font_scalable_p (fonts
+ i
))
6345 /* Find the best match among the non-scalable fonts. */
6350 for (i
= 1; i
< nfonts
; ++i
)
6351 if (!font_scalable_p (fonts
+ i
)
6352 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6356 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6364 /* Unless we found an exact match among non-scalable fonts, see if
6365 we can find a better match among scalable fonts. */
6368 /* A scalable font is better if
6370 1. its weight, slant, swidth attributes are better, or.
6372 2. the best non-scalable font doesn't have the required
6373 point size, and the scalable fonts weight, slant, swidth
6376 int non_scalable_has_exact_height_p
;
6378 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6379 non_scalable_has_exact_height_p
= 1;
6381 non_scalable_has_exact_height_p
= 0;
6383 for (i
= 0; i
< nfonts
; ++i
)
6384 if (font_scalable_p (fonts
+ i
))
6387 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6388 || (!non_scalable_has_exact_height_p
6389 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6393 if (needs_overstrike
)
6395 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6396 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6398 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6400 /* We want a bold font, but didn't get one; try to use
6401 overstriking instead to simulate bold-face. However,
6402 don't overstrike an already-bold fontn unless the
6403 desired weight grossly exceeds the available weight. */
6404 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6405 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6407 *needs_overstrike
= 1;
6412 if (font_scalable_p (best
))
6413 font_name
= build_scalable_font_name (f
, best
, pt
);
6415 font_name
= build_font_name (best
);
6417 /* Free font_name structures. */
6418 free_font_names (fonts
, nfonts
);
6424 /* Get a list of matching fonts on frame F, considering FAMILY
6425 and alternative font families from Vface_alternative_font_registry_alist.
6427 FAMILY is the font family whose alternatives are considered.
6429 REGISTRY, if a string, specifies a font registry and encoding to
6430 match. A value of nil means include fonts of any registry and
6433 Return in *FONTS a pointer to a vector of font_name structures for
6434 the fonts matched. Value is the number of fonts found. */
6437 try_alternative_families (f
, family
, registry
, fonts
)
6439 Lisp_Object family
, registry
;
6440 struct font_name
**fonts
;
6445 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6448 /* Try alternative font families. */
6449 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6452 for (alter
= XCDR (alter
);
6453 CONSP (alter
) && nfonts
== 0;
6454 alter
= XCDR (alter
))
6456 if (STRINGP (XCAR (alter
)))
6457 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6461 /* Try all scalable fonts before giving up. */
6462 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6464 int count
= SPECPDL_INDEX ();
6465 specbind (Qscalable_fonts_allowed
, Qt
);
6466 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6467 unbind_to (count
, Qnil
);
6474 /* Get a list of matching fonts on frame F.
6476 PATTERN, if a string, specifies a font name pattern to match while
6477 ignoring FAMILY and REGISTRY.
6479 FAMILY, if a list, specifies a list of font families to try.
6481 REGISTRY, if a list, specifies a list of font registries and
6484 Return in *FONTS a pointer to a vector of font_name structures for
6485 the fonts matched. Value is the number of fonts found. */
6488 try_font_list (f
, pattern
, family
, registry
, fonts
)
6490 Lisp_Object pattern
, family
, registry
;
6491 struct font_name
**fonts
;
6495 if (STRINGP (pattern
))
6496 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6502 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6504 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6505 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6507 /* Try font family of the default face or "fixed". */
6508 if (nfonts
== 0 && !NILP (family
))
6510 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6512 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6514 family
= build_string ("fixed");
6515 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6518 /* Try any family with the given registry. */
6519 if (nfonts
== 0 && !NILP (family
))
6520 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6527 /* Return the fontset id of the base fontset name or alias name given
6528 by the fontset attribute of ATTRS. Value is -1 if the fontset
6529 attribute of ATTRS doesn't name a fontset. */
6532 face_fontset (attrs
)
6537 name
= attrs
[LFACE_FONTSET_INDEX
];
6538 if (!STRINGP (name
))
6540 return fs_query_fontset (name
, 0);
6544 /* Choose a name of font to use on frame F to display characters with
6545 Lisp face attributes specified by ATTRS. The font name is
6546 determined by the font-related attributes in ATTRS and FONT-SPEC
6549 When we are choosing a font for ASCII characters, FONT-SPEC is
6550 always nil. Otherwise FONT-SPEC is a list
6551 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6552 or a string specifying a font name pattern.
6554 If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
6555 indicate whether the resulting font should be drawn using
6556 overstrike to simulate bold-face.
6558 Value is the font name which is allocated from the heap and must be
6559 freed by the caller. */
6562 choose_face_font (f
, attrs
, font_spec
, needs_overstrike
)
6565 Lisp_Object font_spec
;
6566 int *needs_overstrike
;
6568 Lisp_Object pattern
, family
, adstyle
, registry
;
6569 char *font_name
= NULL
;
6570 struct font_name
*fonts
;
6573 if (needs_overstrike
)
6574 *needs_overstrike
= 0;
6576 /* If we are choosing an ASCII font and a font name is explicitly
6577 specified in ATTRS, return it. */
6578 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6579 return xstrdup (SDATA (attrs
[LFACE_FONT_INDEX
]));
6581 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6584 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6586 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6587 ADSTYLE is not used in the font selector for the moment. */
6588 if (VECTORP (font_spec
))
6591 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6592 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6593 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6594 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6596 else if (STRINGP (font_spec
))
6598 pattern
= font_spec
;
6605 /* We are choosing an ASCII font. By default, use the registry
6606 name "iso8859-1". But, if the registry name of the ASCII
6607 font specified in the fontset of ATTRS is not "iso8859-1"
6608 (e.g "iso10646-1"), use also that name with higher
6610 int fontset
= face_fontset (attrs
);
6613 struct font_name font
;
6617 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
6619 ascii
= fontset_ascii (fontset
);
6620 len
= SBYTES (ascii
);
6622 || strcmp (SDATA (ascii
) + len
- 9, "iso8859-1"))
6624 font
.name
= LSTRDUPA (ascii
);
6625 /* Check if the name is in XLFD. */
6626 if (split_font_name (f
, &font
, 0))
6628 font
.fields
[XLFD_ENCODING
][-1] = '-';
6629 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
6635 /* Get a list of fonts matching that pattern and choose the
6636 best match for the specified face attributes from it. */
6637 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6638 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
),
6643 #endif /* HAVE_WINDOW_SYSTEM */
6647 /***********************************************************************
6649 ***********************************************************************/
6651 /* Realize basic faces on frame F. Value is zero if frame parameters
6652 of F don't contain enough information needed to realize the default
6656 realize_basic_faces (f
)
6660 int count
= SPECPDL_INDEX ();
6662 /* Block input here so that we won't be surprised by an X expose
6663 event, for instance, without having the faces set up. */
6665 specbind (Qscalable_fonts_allowed
, Qt
);
6667 if (realize_default_face (f
))
6669 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6670 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6671 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6672 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6673 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6674 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6675 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6676 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6677 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6678 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6680 /* Reflect changes in the `menu' face in menu bars. */
6681 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6683 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6684 #ifdef USE_X_TOOLKIT
6685 x_update_menu_appearance (f
);
6692 unbind_to (count
, Qnil
);
6698 /* Realize the default face on frame F. If the face is not fully
6699 specified, make it fully-specified. Attributes of the default face
6700 that are not explicitly specified are taken from frame parameters. */
6703 realize_default_face (f
)
6706 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6708 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6709 Lisp_Object frame_font
;
6712 /* If the `default' face is not yet known, create it. */
6713 lface
= lface_from_face_name (f
, Qdefault
, 0);
6717 XSETFRAME (frame
, f
);
6718 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6722 #ifdef HAVE_WINDOW_SYSTEM
6723 if (FRAME_WINDOW_P (f
))
6725 /* Set frame_font to the value of the `font' frame parameter. */
6726 frame_font
= Fassq (Qfont
, f
->param_alist
);
6727 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6728 frame_font
= XCDR (frame_font
);
6729 set_lface_from_font_name (f
, lface
, frame_font
,
6730 f
->default_face_done_p
, 1);
6731 f
->default_face_done_p
= 1;
6733 #endif /* HAVE_WINDOW_SYSTEM */
6735 if (!FRAME_WINDOW_P (f
))
6737 LFACE_FAMILY (lface
) = build_string ("default");
6738 LFACE_SWIDTH (lface
) = Qnormal
;
6739 LFACE_HEIGHT (lface
) = make_number (1);
6740 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6741 LFACE_WEIGHT (lface
) = Qnormal
;
6742 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6743 LFACE_SLANT (lface
) = Qnormal
;
6744 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6747 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6748 LFACE_UNDERLINE (lface
) = Qnil
;
6750 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6751 LFACE_OVERLINE (lface
) = Qnil
;
6753 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6754 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6756 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6757 LFACE_BOX (lface
) = Qnil
;
6759 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6760 LFACE_INVERSE (lface
) = Qnil
;
6762 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6764 /* This function is called so early that colors are not yet
6765 set in the frame parameter list. */
6766 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6768 if (CONSP (color
) && STRINGP (XCDR (color
)))
6769 LFACE_FOREGROUND (lface
) = XCDR (color
);
6770 else if (FRAME_WINDOW_P (f
))
6772 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6773 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6778 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6780 /* This function is called so early that colors are not yet
6781 set in the frame parameter list. */
6782 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6783 if (CONSP (color
) && STRINGP (XCDR (color
)))
6784 LFACE_BACKGROUND (lface
) = XCDR (color
);
6785 else if (FRAME_WINDOW_P (f
))
6787 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6788 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6793 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6794 LFACE_STIPPLE (lface
) = Qnil
;
6796 /* Realize the face; it must be fully-specified now. */
6797 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6798 check_lface (lface
);
6799 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6800 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6805 /* Realize basic faces other than the default face in face cache C.
6806 SYMBOL is the face name, ID is the face id the realized face must
6807 have. The default face must have been realized already. */
6810 realize_named_face (f
, symbol
, id
)
6815 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6816 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6817 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6818 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6819 struct face
*new_face
;
6821 /* The default face must exist and be fully specified. */
6822 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6823 check_lface_attrs (attrs
);
6824 xassert (lface_fully_specified_p (attrs
));
6826 /* If SYMBOL isn't know as a face, create it. */
6830 XSETFRAME (frame
, f
);
6831 lface
= Finternal_make_lisp_face (symbol
, frame
);
6834 /* Merge SYMBOL's face with the default face. */
6835 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6836 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6838 /* Realize the face. */
6839 new_face
= realize_face (c
, attrs
, id
);
6843 /* Realize the fully-specified face with attributes ATTRS in face
6844 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6845 non-negative, it is an ID of face to remove before caching the new
6846 face. Value is a pointer to the newly created realized face. */
6848 static struct face
*
6849 realize_face (cache
, attrs
, former_face_id
)
6850 struct face_cache
*cache
;
6856 /* LFACE must be fully specified. */
6857 xassert (cache
!= NULL
);
6858 check_lface_attrs (attrs
);
6860 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6862 /* Remove the former face. */
6863 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6864 uncache_face (cache
, former_face
);
6865 free_realized_face (cache
->f
, former_face
);
6868 if (FRAME_WINDOW_P (cache
->f
))
6869 face
= realize_x_face (cache
, attrs
);
6870 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6871 face
= realize_tty_face (cache
, attrs
);
6875 /* Insert the new face. */
6876 cache_face (cache
, face
, lface_hash (attrs
));
6881 /* Realize the fully-specified face that has the same attributes as
6882 BASE_FACE except for the font on frame F. If FONT_ID is not
6883 negative, it is an ID number of an already opened font that should
6884 be used by the face. If FONT_ID is negative, the face has no font,
6885 i.e., characters are displayed by empty boxes. */
6887 static struct face
*
6888 realize_non_ascii_face (f
, font_id
, base_face
)
6891 struct face
*base_face
;
6893 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6895 struct font_info
*font_info
;
6897 face
= (struct face
*) xmalloc (sizeof *face
);
6901 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6902 face
->colors_copied_bitwise_p
= 1;
6904 face
->font_info_id
= font_id
;
6907 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6908 face
->font
= font_info
->font
;
6909 face
->font_name
= font_info
->full_name
;
6914 face
->font_name
= NULL
;
6919 cache_face (cache
, face
, face
->hash
);
6925 /* Realize the fully-specified face with attributes ATTRS in face
6926 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6927 the new face doesn't share font with the default face, a fontname
6928 is allocated from the heap and set in `font_name' of the new face,
6929 but it is not yet loaded here. Value is a pointer to the newly
6930 created realized face. */
6932 static struct face
*
6933 realize_x_face (cache
, attrs
)
6934 struct face_cache
*cache
;
6937 #ifdef HAVE_WINDOW_SYSTEM
6938 struct face
*face
, *default_face
;
6940 Lisp_Object stipple
, overline
, strike_through
, box
;
6942 xassert (FRAME_WINDOW_P (cache
->f
));
6944 /* Allocate a new realized face. */
6945 face
= make_realized_face (attrs
);
6946 face
->ascii_face
= face
;
6950 /* Determine the font to use. Most of the time, the font will be
6951 the same as the font of the default face, so try that first. */
6952 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6954 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6956 face
->font
= default_face
->font
;
6957 face
->font_info_id
= default_face
->font_info_id
;
6958 face
->font_name
= default_face
->font_name
;
6960 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6964 /* If the face attribute ATTRS specifies a fontset, use it as
6965 the base of a new realized fontset. Otherwise, use the same
6966 base fontset as of the default face. The base determines
6967 registry and encoding of a font. It may also determine
6968 foundry and family. The other fields of font name pattern
6969 are constructed from ATTRS. */
6970 int fontset
= face_fontset (attrs
);
6972 /* If we are realizing the default face, ATTRS should specify a
6973 fontset. In other words, if FONTSET is -1, we are not
6974 realizing the default face, thus the default face should have
6975 already been realized. */
6977 fontset
= default_face
->fontset
;
6980 load_face_font (f
, face
);
6981 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6984 /* Load colors, and set remaining attributes. */
6986 load_face_colors (f
, face
, attrs
);
6989 box
= attrs
[LFACE_BOX_INDEX
];
6992 /* A simple box of line width 1 drawn in color given by
6994 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6996 face
->box
= FACE_SIMPLE_BOX
;
6997 face
->box_line_width
= 1;
6999 else if (INTEGERP (box
))
7001 /* Simple box of specified line width in foreground color of the
7003 xassert (XINT (box
) != 0);
7004 face
->box
= FACE_SIMPLE_BOX
;
7005 face
->box_line_width
= XINT (box
);
7006 face
->box_color
= face
->foreground
;
7007 face
->box_color_defaulted_p
= 1;
7009 else if (CONSP (box
))
7011 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7012 being one of `raised' or `sunken'. */
7013 face
->box
= FACE_SIMPLE_BOX
;
7014 face
->box_color
= face
->foreground
;
7015 face
->box_color_defaulted_p
= 1;
7016 face
->box_line_width
= 1;
7020 Lisp_Object keyword
, value
;
7022 keyword
= XCAR (box
);
7030 if (EQ (keyword
, QCline_width
))
7032 if (INTEGERP (value
) && XINT (value
) != 0)
7033 face
->box_line_width
= XINT (value
);
7035 else if (EQ (keyword
, QCcolor
))
7037 if (STRINGP (value
))
7039 face
->box_color
= load_color (f
, face
, value
,
7041 face
->use_box_color_for_shadows_p
= 1;
7044 else if (EQ (keyword
, QCstyle
))
7046 if (EQ (value
, Qreleased_button
))
7047 face
->box
= FACE_RAISED_BOX
;
7048 else if (EQ (value
, Qpressed_button
))
7049 face
->box
= FACE_SUNKEN_BOX
;
7054 /* Text underline, overline, strike-through. */
7056 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7058 /* Use default color (same as foreground color). */
7059 face
->underline_p
= 1;
7060 face
->underline_defaulted_p
= 1;
7061 face
->underline_color
= 0;
7063 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7065 /* Use specified color. */
7066 face
->underline_p
= 1;
7067 face
->underline_defaulted_p
= 0;
7068 face
->underline_color
7069 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7070 LFACE_UNDERLINE_INDEX
);
7072 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7074 face
->underline_p
= 0;
7075 face
->underline_defaulted_p
= 0;
7076 face
->underline_color
= 0;
7079 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7080 if (STRINGP (overline
))
7082 face
->overline_color
7083 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7084 LFACE_OVERLINE_INDEX
);
7085 face
->overline_p
= 1;
7087 else if (EQ (overline
, Qt
))
7089 face
->overline_color
= face
->foreground
;
7090 face
->overline_color_defaulted_p
= 1;
7091 face
->overline_p
= 1;
7094 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7095 if (STRINGP (strike_through
))
7097 face
->strike_through_color
7098 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7099 LFACE_STRIKE_THROUGH_INDEX
);
7100 face
->strike_through_p
= 1;
7102 else if (EQ (strike_through
, Qt
))
7104 face
->strike_through_color
= face
->foreground
;
7105 face
->strike_through_color_defaulted_p
= 1;
7106 face
->strike_through_p
= 1;
7109 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7110 if (!NILP (stipple
))
7111 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7114 #endif /* HAVE_WINDOW_SYSTEM */
7118 /* Map a specified color of face FACE on frame F to a tty color index.
7119 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7120 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7121 default foreground/background colors. */
7124 map_tty_color (f
, face
, idx
, defaulted
)
7127 enum lface_attribute_index idx
;
7130 Lisp_Object frame
, color
, def
;
7131 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7132 unsigned long default_pixel
, default_other_pixel
, pixel
;
7134 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7138 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7139 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7143 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7144 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7147 XSETFRAME (frame
, f
);
7148 color
= face
->lface
[idx
];
7152 && CONSP (Vtty_defined_color_alist
)
7153 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7156 /* Associations in tty-defined-color-alist are of the form
7157 (NAME INDEX R G B). We need the INDEX part. */
7158 pixel
= XINT (XCAR (XCDR (def
)));
7161 if (pixel
== default_pixel
&& STRINGP (color
))
7163 pixel
= load_color (f
, face
, color
, idx
);
7165 #if defined (MSDOS) || defined (WINDOWSNT)
7166 /* If the foreground of the default face is the default color,
7167 use the foreground color defined by the frame. */
7169 if (FRAME_MSDOS_P (f
))
7172 if (pixel
== default_pixel
7173 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7176 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7178 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7179 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7182 else if (pixel
== default_other_pixel
)
7185 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7187 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7188 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7194 #endif /* MSDOS or WINDOWSNT */
7198 face
->foreground
= pixel
;
7200 face
->background
= pixel
;
7204 /* Realize the fully-specified face with attributes ATTRS in face
7205 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
7206 Value is a pointer to the newly created realized face. */
7208 static struct face
*
7209 realize_tty_face (cache
, attrs
)
7210 struct face_cache
*cache
;
7215 int face_colors_defaulted
= 0;
7216 struct frame
*f
= cache
->f
;
7218 /* Frame must be a termcap frame. */
7219 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7221 /* Allocate a new realized face. */
7222 face
= make_realized_face (attrs
);
7223 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7225 /* Map face attributes to TTY appearances. We map slant to
7226 dimmed text because we want italic text to appear differently
7227 and because dimmed text is probably used infrequently. */
7228 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7229 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7231 if (weight
> XLFD_WEIGHT_MEDIUM
)
7232 face
->tty_bold_p
= 1;
7233 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7234 face
->tty_dim_p
= 1;
7235 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7236 face
->tty_underline_p
= 1;
7237 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7238 face
->tty_reverse_p
= 1;
7240 /* Map color names to color indices. */
7241 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7242 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7244 /* Swap colors if face is inverse-video. If the colors are taken
7245 from the frame colors, they are already inverted, since the
7246 frame-creation function calls x-handle-reverse-video. */
7247 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7249 unsigned long tem
= face
->foreground
;
7250 face
->foreground
= face
->background
;
7251 face
->background
= tem
;
7254 if (tty_suppress_bold_inverse_default_colors_p
7256 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7257 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7258 face
->tty_bold_p
= 0;
7264 DEFUN ("tty-suppress-bold-inverse-default-colors",
7265 Ftty_suppress_bold_inverse_default_colors
,
7266 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7267 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7268 SUPPRESS non-nil means suppress it.
7269 This affects bold faces on TTYs whose foreground is the default background
7270 color of the display and whose background is the default foreground color.
7271 For such faces, the bold face attribute is ignored if this variable
7274 Lisp_Object suppress
;
7276 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7277 ++face_change_count
;
7283 /***********************************************************************
7285 ***********************************************************************/
7287 /* Return the ID of the face to use to display character CH with face
7288 property PROP on frame F in current_buffer. */
7291 compute_char_face (f
, ch
, prop
)
7298 if (NILP (current_buffer
->enable_multibyte_characters
))
7303 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7304 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7308 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7309 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7310 bcopy (face
->lface
, attrs
, sizeof attrs
);
7311 merge_face_vector_with_property (f
, attrs
, prop
);
7312 face_id
= lookup_face (f
, attrs
);
7313 if (! ASCII_CHAR_P (ch
))
7315 face
= FACE_FROM_ID (f
, face_id
);
7316 face_id
= FACE_FOR_CHAR (f
, face
, ch
, -1, Qnil
);
7323 /* Return the face ID associated with buffer position POS for
7324 displaying ASCII characters. Return in *ENDPTR the position at
7325 which a different face is needed, as far as text properties and
7326 overlays are concerned. W is a window displaying current_buffer.
7328 REGION_BEG, REGION_END delimit the region, so it can be
7331 LIMIT is a position not to scan beyond. That is to limit the time
7332 this function can take.
7334 If MOUSE is non-zero, use the character's mouse-face, not its face.
7336 The face returned is suitable for displaying ASCII characters. */
7339 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7340 endptr
, limit
, mouse
)
7343 int region_beg
, region_end
;
7348 struct frame
*f
= XFRAME (w
->frame
);
7349 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7350 Lisp_Object prop
, position
;
7352 Lisp_Object
*overlay_vec
;
7355 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7356 Lisp_Object limit1
, end
;
7357 struct face
*default_face
;
7359 /* W must display the current buffer. We could write this function
7360 to use the frame and buffer of W, but right now it doesn't. */
7361 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7363 XSETFRAME (frame
, f
);
7364 XSETFASTINT (position
, pos
);
7367 if (pos
< region_beg
&& region_beg
< endpos
)
7368 endpos
= region_beg
;
7370 /* Get the `face' or `mouse_face' text property at POS, and
7371 determine the next position at which the property changes. */
7372 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7373 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7374 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7376 endpos
= XINT (end
);
7378 /* Look at properties from overlays. */
7383 /* First try with room for 40 overlays. */
7385 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7386 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7387 &next_overlay
, NULL
, 0);
7389 /* If there are more than 40, make enough space for all, and try
7391 if (noverlays
> len
)
7394 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7395 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7396 &next_overlay
, NULL
, 0);
7399 if (next_overlay
< endpos
)
7400 endpos
= next_overlay
;
7405 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7407 /* Optimize common cases where we can use the default face. */
7410 && !(pos
>= region_beg
&& pos
< region_end
))
7411 return DEFAULT_FACE_ID
;
7413 /* Begin with attributes from the default face. */
7414 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7416 /* Merge in attributes specified via text properties. */
7418 merge_face_vector_with_property (f
, attrs
, prop
);
7420 /* Now merge the overlay data. */
7421 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7422 for (i
= 0; i
< noverlays
; i
++)
7427 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7429 merge_face_vector_with_property (f
, attrs
, prop
);
7431 oend
= OVERLAY_END (overlay_vec
[i
]);
7432 oendpos
= OVERLAY_POSITION (oend
);
7433 if (oendpos
< endpos
)
7437 /* If in the region, merge in the region face. */
7438 if (pos
>= region_beg
&& pos
< region_end
)
7440 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7441 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7443 if (region_end
< endpos
)
7444 endpos
= region_end
;
7449 /* Look up a realized face with the given face attributes,
7450 or realize a new one for ASCII characters. */
7451 return lookup_face (f
, attrs
);
7455 /* Compute the face at character position POS in Lisp string STRING on
7456 window W, for ASCII characters.
7458 If STRING is an overlay string, it comes from position BUFPOS in
7459 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7460 not an overlay string. W must display the current buffer.
7461 REGION_BEG and REGION_END give the start and end positions of the
7462 region; both are -1 if no region is visible.
7464 BASE_FACE_ID is the id of a face to merge with. For strings coming
7465 from overlays or the `display' property it is the face at BUFPOS.
7467 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7469 Set *ENDPTR to the next position where to check for faces in
7470 STRING; -1 if the face is constant from POS to the end of the
7473 Value is the id of the face to use. The face returned is suitable
7474 for displaying ASCII characters. */
7477 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7478 region_end
, endptr
, base_face_id
, mouse_p
)
7482 int region_beg
, region_end
;
7484 enum face_id base_face_id
;
7487 Lisp_Object prop
, position
, end
, limit
;
7488 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7489 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7490 struct face
*base_face
;
7491 int multibyte_p
= STRING_MULTIBYTE (string
);
7492 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7494 /* Get the value of the face property at the current position within
7495 STRING. Value is nil if there is no face property. */
7496 XSETFASTINT (position
, pos
);
7497 prop
= Fget_text_property (position
, prop_name
, string
);
7499 /* Get the next position at which to check for faces. Value of end
7500 is nil if face is constant all the way to the end of the string.
7501 Otherwise it is a string position where to check faces next.
7502 Limit is the maximum position up to which to check for property
7503 changes in Fnext_single_property_change. Strings are usually
7504 short, so set the limit to the end of the string. */
7505 XSETFASTINT (limit
, SCHARS (string
));
7506 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7508 *endptr
= XFASTINT (end
);
7512 base_face
= FACE_FROM_ID (f
, base_face_id
);
7513 xassert (base_face
);
7515 /* Optimize the default case that there is no face property and we
7516 are not in the region. */
7518 && (base_face_id
!= DEFAULT_FACE_ID
7519 /* BUFPOS <= 0 means STRING is not an overlay string, so
7520 that the region doesn't have to be taken into account. */
7522 || bufpos
< region_beg
7523 || bufpos
>= region_end
)
7525 /* We can't realize faces for different charsets differently
7526 if we don't have fonts, so we can stop here if not working
7527 on a window-system frame. */
7528 || !FRAME_WINDOW_P (f
)
7529 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7530 return base_face
->id
;
7532 /* Begin with attributes from the base face. */
7533 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7535 /* Merge in attributes specified via text properties. */
7537 merge_face_vector_with_property (f
, attrs
, prop
);
7539 /* If in the region, merge in the region face. */
7541 && bufpos
>= region_beg
7542 && bufpos
< region_end
)
7544 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7545 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7548 /* Look up a realized face with the given face attributes,
7549 or realize a new one for ASCII characters. */
7550 return lookup_face (f
, attrs
);
7555 /***********************************************************************
7557 ***********************************************************************/
7561 /* Print the contents of the realized face FACE to stderr. */
7564 dump_realized_face (face
)
7567 fprintf (stderr
, "ID: %d\n", face
->id
);
7568 #ifdef HAVE_X_WINDOWS
7569 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7571 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7573 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7574 fprintf (stderr
, "background: 0x%lx (%s)\n",
7576 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7577 fprintf (stderr
, "font_name: %s (%s)\n",
7579 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7580 #ifdef HAVE_X_WINDOWS
7581 fprintf (stderr
, "font = %p\n", face
->font
);
7583 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7584 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7585 fprintf (stderr
, "underline: %d (%s)\n",
7587 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7588 fprintf (stderr
, "hash: %d\n", face
->hash
);
7592 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7600 fprintf (stderr
, "font selection order: ");
7601 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7602 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7603 fprintf (stderr
, "\n");
7605 fprintf (stderr
, "alternative fonts: ");
7606 debug_print (Vface_alternative_font_family_alist
);
7607 fprintf (stderr
, "\n");
7609 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7610 Fdump_face (make_number (i
));
7616 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7618 error ("Not a valid face");
7619 dump_realized_face (face
);
7626 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7627 0, 0, 0, doc
: /* */)
7630 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7631 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7632 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7636 #endif /* GLYPH_DEBUG != 0 */
7640 /***********************************************************************
7642 ***********************************************************************/
7647 Qface
= intern ("face");
7649 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7650 staticpro (&Qbitmap_spec_p
);
7651 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7652 staticpro (&Qframe_update_face_colors
);
7654 /* Lisp face attribute keywords. */
7655 QCfamily
= intern (":family");
7656 staticpro (&QCfamily
);
7657 QCheight
= intern (":height");
7658 staticpro (&QCheight
);
7659 QCweight
= intern (":weight");
7660 staticpro (&QCweight
);
7661 QCslant
= intern (":slant");
7662 staticpro (&QCslant
);
7663 QCunderline
= intern (":underline");
7664 staticpro (&QCunderline
);
7665 QCinverse_video
= intern (":inverse-video");
7666 staticpro (&QCinverse_video
);
7667 QCreverse_video
= intern (":reverse-video");
7668 staticpro (&QCreverse_video
);
7669 QCforeground
= intern (":foreground");
7670 staticpro (&QCforeground
);
7671 QCbackground
= intern (":background");
7672 staticpro (&QCbackground
);
7673 QCstipple
= intern (":stipple");;
7674 staticpro (&QCstipple
);
7675 QCwidth
= intern (":width");
7676 staticpro (&QCwidth
);
7677 QCfont
= intern (":font");
7678 staticpro (&QCfont
);
7679 QCfontset
= intern (":fontset");
7680 staticpro (&QCfontset
);
7681 QCbold
= intern (":bold");
7682 staticpro (&QCbold
);
7683 QCitalic
= intern (":italic");
7684 staticpro (&QCitalic
);
7685 QCoverline
= intern (":overline");
7686 staticpro (&QCoverline
);
7687 QCstrike_through
= intern (":strike-through");
7688 staticpro (&QCstrike_through
);
7689 QCbox
= intern (":box");
7691 QCinherit
= intern (":inherit");
7692 staticpro (&QCinherit
);
7694 /* Symbols used for Lisp face attribute values. */
7695 QCcolor
= intern (":color");
7696 staticpro (&QCcolor
);
7697 QCline_width
= intern (":line-width");
7698 staticpro (&QCline_width
);
7699 QCstyle
= intern (":style");
7700 staticpro (&QCstyle
);
7701 Qreleased_button
= intern ("released-button");
7702 staticpro (&Qreleased_button
);
7703 Qpressed_button
= intern ("pressed-button");
7704 staticpro (&Qpressed_button
);
7705 Qnormal
= intern ("normal");
7706 staticpro (&Qnormal
);
7707 Qultra_light
= intern ("ultra-light");
7708 staticpro (&Qultra_light
);
7709 Qextra_light
= intern ("extra-light");
7710 staticpro (&Qextra_light
);
7711 Qlight
= intern ("light");
7712 staticpro (&Qlight
);
7713 Qsemi_light
= intern ("semi-light");
7714 staticpro (&Qsemi_light
);
7715 Qsemi_bold
= intern ("semi-bold");
7716 staticpro (&Qsemi_bold
);
7717 Qbold
= intern ("bold");
7719 Qextra_bold
= intern ("extra-bold");
7720 staticpro (&Qextra_bold
);
7721 Qultra_bold
= intern ("ultra-bold");
7722 staticpro (&Qultra_bold
);
7723 Qoblique
= intern ("oblique");
7724 staticpro (&Qoblique
);
7725 Qitalic
= intern ("italic");
7726 staticpro (&Qitalic
);
7727 Qreverse_oblique
= intern ("reverse-oblique");
7728 staticpro (&Qreverse_oblique
);
7729 Qreverse_italic
= intern ("reverse-italic");
7730 staticpro (&Qreverse_italic
);
7731 Qultra_condensed
= intern ("ultra-condensed");
7732 staticpro (&Qultra_condensed
);
7733 Qextra_condensed
= intern ("extra-condensed");
7734 staticpro (&Qextra_condensed
);
7735 Qcondensed
= intern ("condensed");
7736 staticpro (&Qcondensed
);
7737 Qsemi_condensed
= intern ("semi-condensed");
7738 staticpro (&Qsemi_condensed
);
7739 Qsemi_expanded
= intern ("semi-expanded");
7740 staticpro (&Qsemi_expanded
);
7741 Qexpanded
= intern ("expanded");
7742 staticpro (&Qexpanded
);
7743 Qextra_expanded
= intern ("extra-expanded");
7744 staticpro (&Qextra_expanded
);
7745 Qultra_expanded
= intern ("ultra-expanded");
7746 staticpro (&Qultra_expanded
);
7747 Qbackground_color
= intern ("background-color");
7748 staticpro (&Qbackground_color
);
7749 Qforeground_color
= intern ("foreground-color");
7750 staticpro (&Qforeground_color
);
7751 Qunspecified
= intern ("unspecified");
7752 staticpro (&Qunspecified
);
7754 Qface_alias
= intern ("face-alias");
7755 staticpro (&Qface_alias
);
7756 Qdefault
= intern ("default");
7757 staticpro (&Qdefault
);
7758 Qtool_bar
= intern ("tool-bar");
7759 staticpro (&Qtool_bar
);
7760 Qregion
= intern ("region");
7761 staticpro (&Qregion
);
7762 Qfringe
= intern ("fringe");
7763 staticpro (&Qfringe
);
7764 Qheader_line
= intern ("header-line");
7765 staticpro (&Qheader_line
);
7766 Qscroll_bar
= intern ("scroll-bar");
7767 staticpro (&Qscroll_bar
);
7768 Qmenu
= intern ("menu");
7770 Qcursor
= intern ("cursor");
7771 staticpro (&Qcursor
);
7772 Qborder
= intern ("border");
7773 staticpro (&Qborder
);
7774 Qmouse
= intern ("mouse");
7775 staticpro (&Qmouse
);
7776 Qmode_line_inactive
= intern ("mode-line-inactive");
7777 staticpro (&Qmode_line_inactive
);
7778 Qtty_color_desc
= intern ("tty-color-desc");
7779 staticpro (&Qtty_color_desc
);
7780 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7781 staticpro (&Qtty_color_standard_values
);
7782 Qtty_color_by_index
= intern ("tty-color-by-index");
7783 staticpro (&Qtty_color_by_index
);
7784 Qtty_color_alist
= intern ("tty-color-alist");
7785 staticpro (&Qtty_color_alist
);
7786 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7787 staticpro (&Qscalable_fonts_allowed
);
7789 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7790 staticpro (&Vparam_value_alist
);
7791 Vface_alternative_font_family_alist
= Qnil
;
7792 staticpro (&Vface_alternative_font_family_alist
);
7793 Vface_alternative_font_registry_alist
= Qnil
;
7794 staticpro (&Vface_alternative_font_registry_alist
);
7796 defsubr (&Sinternal_make_lisp_face
);
7797 defsubr (&Sinternal_lisp_face_p
);
7798 defsubr (&Sinternal_set_lisp_face_attribute
);
7799 #ifdef HAVE_WINDOW_SYSTEM
7800 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7802 defsubr (&Scolor_gray_p
);
7803 defsubr (&Scolor_supported_p
);
7804 defsubr (&Sface_attribute_relative_p
);
7805 defsubr (&Smerge_face_attribute
);
7806 defsubr (&Sinternal_get_lisp_face_attribute
);
7807 defsubr (&Sinternal_lisp_face_attribute_values
);
7808 defsubr (&Sinternal_lisp_face_equal_p
);
7809 defsubr (&Sinternal_lisp_face_empty_p
);
7810 defsubr (&Sinternal_copy_lisp_face
);
7811 defsubr (&Sinternal_merge_in_global_face
);
7812 defsubr (&Sface_font
);
7813 defsubr (&Sframe_face_alist
);
7814 defsubr (&Stty_supports_face_attributes_p
);
7815 defsubr (&Scolor_distance
);
7816 defsubr (&Sinternal_set_font_selection_order
);
7817 defsubr (&Sinternal_set_alternative_font_family_alist
);
7818 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7819 defsubr (&Sface_attributes_as_vector
);
7821 defsubr (&Sdump_face
);
7822 defsubr (&Sshow_face_resources
);
7823 #endif /* GLYPH_DEBUG */
7824 defsubr (&Sclear_face_cache
);
7825 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7827 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7828 defsubr (&Sdump_colors
);
7831 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7832 doc
: /* *Limit for font matching.
7833 If an integer > 0, font matching functions won't load more than
7834 that number of fonts when searching for a matching font. */);
7835 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7837 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7838 doc
: /* List of global face definitions (for internal use only.) */);
7839 Vface_new_frame_defaults
= Qnil
;
7841 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7842 doc
: /* *Default stipple pattern used on monochrome displays.
7843 This stipple pattern is used on monochrome displays
7844 instead of shades of gray for a face background color.
7845 See `set-face-stipple' for possible values for this variable. */);
7846 Vface_default_stipple
= build_string ("gray3");
7848 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7849 doc
: /* An alist of defined terminal colors and their RGB values. */);
7850 Vtty_defined_color_alist
= Qnil
;
7852 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7853 doc
: /* Allowed scalable fonts.
7854 A value of nil means don't allow any scalable fonts.
7855 A value of t means allow any scalable font.
7856 Otherwise, value must be a list of regular expressions. A font may be
7857 scaled if its name matches a regular expression in the list.
7858 Note that if value is nil, a scalable font might still be used, if no
7859 other font of the appropriate family and registry is available. */);
7860 Vscalable_fonts_allowed
= Qnil
;
7862 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7863 doc
: /* List of ignored fonts.
7864 Each element is a regular expression that matches names of fonts to
7866 Vface_ignored_fonts
= Qnil
;
7868 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7869 doc
: /* Alist of fonts vs the rescaling factors.
7870 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7871 FONT-NAME-PATTERN is a regular expression matching a font name, and
7872 RESCALE-RATIO is a floating point number to specify how much larger
7873 \(or smaller) font we should use. For instance, if a face requests
7874 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7875 Vface_font_rescale_alist
= Qnil
;
7877 #ifdef HAVE_WINDOW_SYSTEM
7878 defsubr (&Sbitmap_spec_p
);
7879 defsubr (&Sx_list_fonts
);
7880 defsubr (&Sinternal_face_x_get_resource
);
7881 defsubr (&Sx_family_fonts
);
7882 defsubr (&Sx_font_family_list
);
7883 #endif /* HAVE_WINDOW_SYSTEM */