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
, 0);
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
;
4957 Lisp_Object lface1
, lface2
;
4962 /* Don't use check_x_frame here because this function is called
4963 before X frames exist. At that time, if FRAME is nil,
4964 selected_frame will be used which is the frame dumped with
4965 Emacs. That frame is not an X frame. */
4966 f
= frame_or_selected_frame (frame
, 2);
4968 lface1
= lface_from_face_name (NULL
, face1
, 1);
4969 lface2
= lface_from_face_name (NULL
, face2
, 1);
4970 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4971 XVECTOR (lface2
)->contents
);
4972 return equal_p
? Qt
: Qnil
;
4976 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4977 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4978 doc
: /* True if FACE has no attribute specified.
4979 If the optional argument FRAME is given, report on face FACE in that frame.
4980 If FRAME is t, report on the defaults for face FACE (for new frames).
4981 If FRAME is omitted or nil, use the selected frame. */)
4983 Lisp_Object face
, frame
;
4990 frame
= selected_frame
;
4991 CHECK_LIVE_FRAME (frame
);
4995 lface
= lface_from_face_name (NULL
, face
, 1);
4997 lface
= lface_from_face_name (f
, face
, 1);
4999 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
5000 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5003 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5007 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5009 doc
: /* Return an alist of frame-local faces defined on FRAME.
5010 For internal use only. */)
5014 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5015 return f
->face_alist
;
5019 /* Return a hash code for Lisp string STRING with case ignored. Used
5020 below in computing a hash value for a Lisp face. */
5022 static INLINE
unsigned
5023 hash_string_case_insensitive (string
)
5026 const unsigned char *s
;
5028 xassert (STRINGP (string
));
5029 for (s
= SDATA (string
); *s
; ++s
)
5030 hash
= (hash
<< 1) ^ tolower (*s
);
5035 /* Return a hash code for face attribute vector V. */
5037 static INLINE
unsigned
5041 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5042 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5043 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5044 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5045 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5046 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5047 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5051 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5052 considering charsets/registries). They do if they specify the same
5053 family, point size, weight, width, slant, font, and fontset. Both
5054 LFACE1 and LFACE2 must be fully-specified. */
5057 lface_same_font_attributes_p (lface1
, lface2
)
5058 Lisp_Object
*lface1
, *lface2
;
5060 xassert (lface_fully_specified_p (lface1
)
5061 && lface_fully_specified_p (lface2
));
5062 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5063 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5064 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5065 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5066 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5067 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5068 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5069 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5070 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5071 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5072 && ! xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5073 SDATA (lface2
[LFACE_FONT_INDEX
]))))
5074 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5075 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5076 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5077 && ! xstricmp (SDATA (lface1
[LFACE_FONTSET_INDEX
]),
5078 SDATA (lface2
[LFACE_FONTSET_INDEX
]))))
5084 /***********************************************************************
5086 ***********************************************************************/
5088 /* Allocate and return a new realized face for Lisp face attribute
5091 static struct face
*
5092 make_realized_face (attr
)
5095 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5096 bzero (face
, sizeof *face
);
5097 face
->ascii_face
= face
;
5098 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5103 /* Free realized face FACE, including its X resources. FACE may
5107 free_realized_face (f
, face
)
5113 #ifdef HAVE_WINDOW_SYSTEM
5114 if (FRAME_WINDOW_P (f
))
5116 /* Free fontset of FACE if it is ASCII face. */
5117 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5118 free_face_fontset (f
, face
);
5121 x_free_gc (f
, face
->gc
);
5125 free_face_colors (f
, face
);
5126 x_destroy_bitmap (f
, face
->stipple
);
5128 #endif /* HAVE_WINDOW_SYSTEM */
5135 /* Prepare face FACE for subsequent display on frame F. This
5136 allocated GCs if they haven't been allocated yet or have been freed
5137 by clearing the face cache. */
5140 prepare_face_for_display (f
, face
)
5144 #ifdef HAVE_WINDOW_SYSTEM
5145 xassert (FRAME_WINDOW_P (f
));
5150 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5152 xgcv
.foreground
= face
->foreground
;
5153 xgcv
.background
= face
->background
;
5154 #ifdef HAVE_X_WINDOWS
5155 xgcv
.graphics_exposures
= False
;
5157 /* The font of FACE may be null if we couldn't load it. */
5160 #ifdef HAVE_X_WINDOWS
5161 xgcv
.font
= face
->font
->fid
;
5164 xgcv
.font
= face
->font
;
5167 xgcv
.font
= face
->font
;
5173 #ifdef HAVE_X_WINDOWS
5176 xgcv
.fill_style
= FillOpaqueStippled
;
5177 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5178 mask
|= GCFillStyle
| GCStipple
;
5181 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5184 #endif /* HAVE_WINDOW_SYSTEM */
5188 /* Returns the `distance' between the colors X and Y. */
5191 color_distance (x
, y
)
5194 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5195 Quoting from that paper:
5197 This formula has results that are very close to L*u*v* (with the
5198 modified lightness curve) and, more importantly, it is a more even
5199 algorithm: it does not have a range of colours where it suddenly
5200 gives far from optimal results.
5202 See <http://www.compuphase.com/cmetric.htm> for more info. */
5204 long r
= (x
->red
- y
->red
) >> 8;
5205 long g
= (x
->green
- y
->green
) >> 8;
5206 long b
= (x
->blue
- y
->blue
) >> 8;
5207 long r_mean
= (x
->red
+ y
->red
) >> 9;
5210 (((512 + r_mean
) * r
* r
) >> 8)
5212 + (((767 - r_mean
) * b
* b
) >> 8);
5216 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5217 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5218 COLOR1 and COLOR2 may be either strings containing the color name,
5219 or lists of the form (RED GREEN BLUE).
5220 If FRAME is unspecified or nil, the current frame is used. */)
5221 (color1
, color2
, frame
)
5222 Lisp_Object color1
, color2
, frame
;
5225 XColor cdef1
, cdef2
;
5228 frame
= selected_frame
;
5229 CHECK_LIVE_FRAME (frame
);
5232 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5233 || !STRINGP (color1
)
5234 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5235 signal_error ("Invalid color", color1
);
5236 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5237 || !STRINGP (color2
)
5238 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5239 signal_error ("Invalid color", color2
);
5241 return make_number (color_distance (&cdef1
, &cdef2
));
5245 /***********************************************************************
5246 Face capability testing for ttys
5247 ***********************************************************************/
5250 /* If the distance (as returned by color_distance) between two colors is
5251 less than this, then they are considered the same, for determining
5252 whether a color is supported or not. The range of values is 0-65535. */
5254 #define TTY_SAME_COLOR_THRESHOLD 10000
5257 DEFUN ("tty-supports-face-attributes-p",
5258 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5260 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5261 The optional argument FRAME is the frame on which to test; if it is nil
5262 or unspecified, then the current frame is used. If FRAME is not a tty
5263 frame, then nil is returned.
5265 The definition of `supported' is somewhat heuristic, but basically means
5266 that a face containing all the attributes in ATTRIBUTES, when merged
5267 with the default face for display, can be represented in a way that's
5269 \(1) different in appearance than the default face, and
5270 \(2) `close in spirit' to what the attributes specify, if not exact.
5272 Point (2) implies that a `:weight black' attribute will be satisified
5273 by any terminal that can display bold, and a `:foreground "yellow"' as
5274 long as the terminal can display a yellowish color, but `:slant italic'
5275 will _not_ be satisified by the tty display code's automatic
5276 substitution of a `dim' face for italic. */)
5278 Lisp_Object attributes
, frame
;
5282 Lisp_Object val
, fg
, bg
;
5283 XColor fg_tty_color
, fg_std_color
;
5284 XColor bg_tty_color
, bg_std_color
;
5285 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5286 unsigned test_caps
= 0;
5289 frame
= selected_frame
;
5290 CHECK_LIVE_FRAME (frame
);
5293 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5294 attrs
[i
] = Qunspecified
;
5295 merge_face_vector_with_property (f
, attrs
, attributes
);
5297 /* This function only works on ttys. */
5298 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5301 /* First check some easy-to-check stuff; ttys support none of the
5302 following attributes, so we can just return nil if any are requested. */
5305 val
= attrs
[LFACE_STIPPLE_INDEX
];
5306 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5310 val
= attrs
[LFACE_HEIGHT_INDEX
];
5311 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5315 val
= attrs
[LFACE_SWIDTH_INDEX
];
5316 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5317 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5321 val
= attrs
[LFACE_OVERLINE_INDEX
];
5322 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5325 /* strike-through */
5326 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5327 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5331 val
= attrs
[LFACE_BOX_INDEX
];
5332 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5335 /* slant (italics/oblique); We consider any non-default value
5336 unsupportable on ttys, even though the face code actually `fakes'
5337 them using a dim attribute if possible. This is because the faked
5338 result is too different from what the face specifies. */
5339 val
= attrs
[LFACE_SLANT_INDEX
];
5340 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5341 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5345 /* Test for terminal `capabilities' (non-color character attributes). */
5347 /* font weight (bold/dim) */
5348 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5351 if (weight
> XLFD_WEIGHT_MEDIUM
)
5352 test_caps
= TTY_CAP_BOLD
;
5353 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5354 test_caps
= TTY_CAP_DIM
;
5358 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5359 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5362 return Qnil
; /* ttys don't support colored underlines */
5364 test_caps
|= TTY_CAP_UNDERLINE
;
5368 val
= attrs
[LFACE_INVERSE_INDEX
];
5369 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5370 test_caps
|= TTY_CAP_INVERSE
;
5373 /* Color testing. */
5375 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5376 we use them when calling `tty_capable_p' below, even if the face
5377 specifies no colors. */
5378 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5379 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5381 /* Check if foreground color is close enough. */
5382 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5385 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5387 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5388 > TTY_SAME_COLOR_THRESHOLD
)
5392 /* Check if background color is close enough. */
5393 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5396 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5398 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5399 > TTY_SAME_COLOR_THRESHOLD
)
5403 /* If both foreground and background are requested, see if the
5404 distance between them is OK. We just check to see if the distance
5405 between the tty's foreground and background is close enough to the
5406 distance between the standard foreground and background. */
5407 if (STRINGP (fg
) && STRINGP (bg
))
5410 = (color_distance (&fg_std_color
, &bg_std_color
)
5411 - color_distance (&fg_tty_color
, &bg_tty_color
));
5412 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5413 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5418 /* See if the capabilities we selected above are supported, with the
5420 if (test_caps
!= 0 &&
5421 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5425 /* Hmmm, everything checks out, this terminal must support this face. */
5431 /***********************************************************************
5433 ***********************************************************************/
5435 /* Return a new face cache for frame F. */
5437 static struct face_cache
*
5441 struct face_cache
*c
;
5444 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5445 bzero (c
, sizeof *c
);
5446 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5447 c
->buckets
= (struct face
**) xmalloc (size
);
5448 bzero (c
->buckets
, size
);
5450 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5452 c
->menu_face_changed_p
= menu_face_changed_default
;
5457 /* Clear out all graphics contexts for all realized faces, except for
5458 the basic faces. This should be done from time to time just to avoid
5459 keeping too many graphics contexts that are no longer needed. */
5463 struct face_cache
*c
;
5465 if (c
&& FRAME_WINDOW_P (c
->f
))
5467 #ifdef HAVE_WINDOW_SYSTEM
5469 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5471 struct face
*face
= c
->faces_by_id
[i
];
5472 if (face
&& face
->gc
)
5474 x_free_gc (c
->f
, face
->gc
);
5478 #endif /* HAVE_WINDOW_SYSTEM */
5483 /* Free all realized faces in face cache C, including basic faces. C
5484 may be null. If faces are freed, make sure the frame's current
5485 matrix is marked invalid, so that a display caused by an expose
5486 event doesn't try to use faces we destroyed. */
5489 free_realized_faces (c
)
5490 struct face_cache
*c
;
5495 struct frame
*f
= c
->f
;
5497 /* We must block input here because we can't process X events
5498 safely while only some faces are freed, or when the frame's
5499 current matrix still references freed faces. */
5502 for (i
= 0; i
< c
->used
; ++i
)
5504 free_realized_face (f
, c
->faces_by_id
[i
]);
5505 c
->faces_by_id
[i
] = NULL
;
5509 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5510 bzero (c
->buckets
, size
);
5512 /* Must do a thorough redisplay the next time. Mark current
5513 matrices as invalid because they will reference faces freed
5514 above. This function is also called when a frame is
5515 destroyed. In this case, the root window of F is nil. */
5516 if (WINDOWP (f
->root_window
))
5518 clear_current_matrices (f
);
5519 ++windows_or_buffers_changed
;
5527 /* Free all realized faces that are using FONTSET on frame F. */
5530 free_realized_faces_for_fontset (f
, fontset
)
5534 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5538 /* We must block input here because we can't process X events safely
5539 while only some faces are freed, or when the frame's current
5540 matrix still references freed faces. */
5543 for (i
= 0; i
< cache
->used
; i
++)
5545 face
= cache
->faces_by_id
[i
];
5547 && face
->fontset
== fontset
)
5549 uncache_face (cache
, face
);
5550 free_realized_face (f
, face
);
5554 /* Must do a thorough redisplay the next time. Mark current
5555 matrices as invalid because they will reference faces freed
5556 above. This function is also called when a frame is destroyed.
5557 In this case, the root window of F is nil. */
5558 if (WINDOWP (f
->root_window
))
5560 clear_current_matrices (f
);
5561 ++windows_or_buffers_changed
;
5568 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5569 This is done after attributes of a named face have been changed,
5570 because we can't tell which realized faces depend on that face. */
5573 free_all_realized_faces (frame
)
5579 FOR_EACH_FRAME (rest
, frame
)
5580 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5583 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5587 /* Free face cache C and faces in it, including their X resources. */
5591 struct face_cache
*c
;
5595 free_realized_faces (c
);
5597 xfree (c
->faces_by_id
);
5603 /* Cache realized face FACE in face cache C. HASH is the hash value
5604 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5605 FACE), insert the new face to the beginning of the collision list
5606 of the face hash table of C. Otherwise, add the new face to the
5607 end of the collision list. This way, lookup_face can quickly find
5608 that a requested face is not cached. */
5611 cache_face (c
, face
, hash
)
5612 struct face_cache
*c
;
5616 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5620 if (face
->ascii_face
!= face
)
5622 struct face
*last
= c
->buckets
[i
];
5633 c
->buckets
[i
] = face
;
5634 face
->prev
= face
->next
= NULL
;
5640 face
->next
= c
->buckets
[i
];
5642 face
->next
->prev
= face
;
5643 c
->buckets
[i
] = face
;
5646 /* Find a free slot in C->faces_by_id and use the index of the free
5647 slot as FACE->id. */
5648 for (i
= 0; i
< c
->used
; ++i
)
5649 if (c
->faces_by_id
[i
] == NULL
)
5653 /* Maybe enlarge C->faces_by_id. */
5654 if (i
== c
->used
&& c
->used
== c
->size
)
5656 int new_size
= 2 * c
->size
;
5657 int sz
= new_size
* sizeof *c
->faces_by_id
;
5658 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5663 /* Check that FACE got a unique id. */
5668 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5669 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5675 #endif /* GLYPH_DEBUG */
5677 c
->faces_by_id
[i
] = face
;
5683 /* Remove face FACE from cache C. */
5686 uncache_face (c
, face
)
5687 struct face_cache
*c
;
5690 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5693 face
->prev
->next
= face
->next
;
5695 c
->buckets
[i
] = face
->next
;
5698 face
->next
->prev
= face
->prev
;
5700 c
->faces_by_id
[face
->id
] = NULL
;
5701 if (face
->id
== c
->used
)
5706 /* Look up a realized face with face attributes ATTR in the face cache
5707 of frame F. The face will be used to display ASCII characters.
5708 Value is the ID of the face found. If no suitable face is found,
5709 realize a new one. */
5712 lookup_face (f
, attr
)
5716 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5721 xassert (cache
!= NULL
);
5722 check_lface_attrs (attr
);
5724 /* Look up ATTR in the face cache. */
5725 hash
= lface_hash (attr
);
5726 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5728 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5730 if (face
->ascii_face
!= face
)
5732 /* There's no more ASCII face. */
5736 if (face
->hash
== hash
5737 && lface_equal_p (face
->lface
, attr
))
5741 /* If not found, realize a new face. */
5743 face
= realize_face (cache
, attr
, -1);
5746 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5747 #endif /* GLYPH_DEBUG */
5753 /* Look up a realized face that has the same attributes as BASE_FACE
5754 except for the font in the face cache of frame F. If FONT_ID is
5755 not negative, it is an ID number of an already opened font that is
5756 used by the face. If FONT_ID is negative, the face has no font.
5757 Value is the ID of the face found. If no suitable face is found,
5758 realize a new one. */
5761 lookup_non_ascii_face (f
, font_id
, base_face
)
5764 struct face
*base_face
;
5766 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5771 xassert (cache
!= NULL
);
5772 base_face
= base_face
->ascii_face
;
5773 hash
= lface_hash (base_face
->lface
);
5774 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5776 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5778 if (face
->ascii_face
== face
)
5780 if (face
->ascii_face
== base_face
5781 && face
->font_info_id
== font_id
)
5785 /* If not found, realize a new face. */
5787 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5790 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5791 #endif /* GLYPH_DEBUG */
5796 /* Return the face id of the realized face for named face SYMBOL on
5797 frame F suitable for displaying ASCII characters. Value is -1 if
5798 the face couldn't be determined, which might happen if the default
5799 face isn't realized and cannot be realized. */
5802 lookup_named_face (f
, symbol
)
5806 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5807 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5808 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5810 if (default_face
== NULL
)
5812 if (!realize_basic_faces (f
))
5814 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5817 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5818 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5819 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5820 return lookup_face (f
, attrs
);
5824 /* Return the ID of the realized ASCII face of Lisp face with ID
5825 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5828 ascii_face_of_lisp_face (f
, lface_id
)
5834 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5836 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5837 face_id
= lookup_named_face (f
, face_name
);
5846 /* Return a face for charset ASCII that is like the face with id
5847 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5848 STEPS < 0 means larger. Value is the id of the face. */
5851 smaller_face (f
, face_id
, steps
)
5855 #ifdef HAVE_WINDOW_SYSTEM
5857 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5858 int pt
, last_pt
, last_height
;
5861 struct face
*new_face
;
5863 /* If not called for an X frame, just return the original face. */
5864 if (FRAME_TERMCAP_P (f
))
5867 /* Try in increments of 1/2 pt. */
5868 delta
= steps
< 0 ? 5 : -5;
5869 steps
= abs (steps
);
5871 face
= FACE_FROM_ID (f
, face_id
);
5872 bcopy (face
->lface
, attrs
, sizeof attrs
);
5873 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5874 new_face_id
= face_id
;
5875 last_height
= FONT_HEIGHT (face
->font
);
5879 /* Give up if we cannot find a font within 10pt. */
5880 && abs (last_pt
- pt
) < 100)
5882 /* Look up a face for a slightly smaller/larger font. */
5884 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5885 new_face_id
= lookup_face (f
, attrs
);
5886 new_face
= FACE_FROM_ID (f
, new_face_id
);
5888 /* If height changes, count that as one step. */
5889 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5890 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5893 last_height
= FONT_HEIGHT (new_face
->font
);
5900 #else /* not HAVE_WINDOW_SYSTEM */
5904 #endif /* not HAVE_WINDOW_SYSTEM */
5908 /* Return a face for charset ASCII that is like the face with id
5909 FACE_ID on frame F, but has height HEIGHT. */
5912 face_with_height (f
, face_id
, height
)
5917 #ifdef HAVE_WINDOW_SYSTEM
5919 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5921 if (FRAME_TERMCAP_P (f
)
5925 face
= FACE_FROM_ID (f
, face_id
);
5926 bcopy (face
->lface
, attrs
, sizeof attrs
);
5927 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5928 face_id
= lookup_face (f
, attrs
);
5929 #endif /* HAVE_WINDOW_SYSTEM */
5935 /* Return the face id of the realized face for named face SYMBOL on
5936 frame F suitable for displaying ASCII characters, and use
5937 attributes of the face FACE_ID for attributes that aren't
5938 completely specified by SYMBOL. This is like lookup_named_face,
5939 except that the default attributes come from FACE_ID, not from the
5940 default face. FACE_ID is assumed to be already realized. */
5943 lookup_derived_face (f
, symbol
, face_id
)
5948 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5949 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5950 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5955 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5956 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5957 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5958 return lookup_face (f
, attrs
);
5961 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5962 Sface_attributes_as_vector
, 1, 1, 0,
5963 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5968 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5970 merge_face_vector_with_property (XFRAME (selected_frame
),
5971 XVECTOR (lface
)->contents
,
5978 /***********************************************************************
5980 ***********************************************************************/
5982 DEFUN ("internal-set-font-selection-order",
5983 Finternal_set_font_selection_order
,
5984 Sinternal_set_font_selection_order
, 1, 1, 0,
5985 doc
: /* Set font selection order for face font selection to ORDER.
5986 ORDER must be a list of length 4 containing the symbols `:width',
5987 `:height', `:weight', and `:slant'. Face attributes appearing
5988 first in ORDER are matched first, e.g. if `:height' appears before
5989 `:weight' in ORDER, font selection first tries to find a font with
5990 a suitable height, and then tries to match the font weight.
5997 int indices
[DIM (font_sort_order
)];
6000 bzero (indices
, sizeof indices
);
6004 CONSP (list
) && i
< DIM (indices
);
6005 list
= XCDR (list
), ++i
)
6007 Lisp_Object attr
= XCAR (list
);
6010 if (EQ (attr
, QCwidth
))
6012 else if (EQ (attr
, QCheight
))
6013 xlfd
= XLFD_POINT_SIZE
;
6014 else if (EQ (attr
, QCweight
))
6016 else if (EQ (attr
, QCslant
))
6021 if (indices
[i
] != 0)
6026 if (!NILP (list
) || i
!= DIM (indices
))
6027 signal_error ("Invalid font sort order", order
);
6028 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6029 if (indices
[i
] == 0)
6030 signal_error ("Invalid font sort order", order
);
6032 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
6034 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
6035 free_all_realized_faces (Qnil
);
6042 DEFUN ("internal-set-alternative-font-family-alist",
6043 Finternal_set_alternative_font_family_alist
,
6044 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6045 doc
: /* Define alternative font families to try in face font selection.
6046 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6047 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6048 be found. Value is ALIST. */)
6053 Vface_alternative_font_family_alist
= alist
;
6054 free_all_realized_faces (Qnil
);
6059 DEFUN ("internal-set-alternative-font-registry-alist",
6060 Finternal_set_alternative_font_registry_alist
,
6061 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6062 doc
: /* Define alternative font registries to try in face font selection.
6063 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6064 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6065 be found. Value is ALIST. */)
6070 Vface_alternative_font_registry_alist
= alist
;
6071 free_all_realized_faces (Qnil
);
6076 #ifdef HAVE_WINDOW_SYSTEM
6078 /* Value is non-zero if FONT is the name of a scalable font. The
6079 X11R6 XLFD spec says that point size, pixel size, and average width
6080 are zero for scalable fonts. Intlfonts contain at least one
6081 scalable font ("*-muleindian-1") for which this isn't true, so we
6082 just test average width. */
6085 font_scalable_p (font
)
6086 struct font_name
*font
;
6088 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6089 return (*s
== '0' && *(s
+ 1) == '\0')
6091 /* Windows implementation of XLFD is slightly broken for backward
6092 compatibility with previous broken versions, so test for
6093 wildcards as well as 0. */
6100 /* Ignore the difference of font point size less than this value. */
6102 #define FONT_POINT_SIZE_QUANTUM 5
6104 /* Value is non-zero if FONT1 is a better match for font attributes
6105 VALUES than FONT2. VALUES is an array of face attribute values in
6106 font sort order. COMPARE_PT_P zero means don't compare point
6107 sizes. AVGWIDTH, if not zero, is a specified font average width
6111 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6113 struct font_name
*font1
, *font2
;
6114 int compare_pt_p
, avgwidth
;
6118 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6120 int xlfd_idx
= font_sort_order
[i
];
6122 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6126 if (xlfd_idx
== XLFD_POINT_SIZE
)
6128 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6129 / font1
->rescale_ratio
));
6130 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6131 / font2
->rescale_ratio
));
6132 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6137 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6138 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6141 if (delta1
> delta2
)
6143 else if (delta1
< delta2
)
6147 /* The difference may be equal because, e.g., the face
6148 specifies `italic' but we have only `regular' and
6149 `oblique'. Prefer `oblique' in this case. */
6150 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6151 && font1
->numeric
[xlfd_idx
] > values
[i
]
6152 && font2
->numeric
[xlfd_idx
] < values
[i
])
6160 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6161 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6162 if (delta1
> delta2
)
6164 else if (delta1
< delta2
)
6168 return font1
->registry_priority
< font2
->registry_priority
;
6172 /* Value is non-zero if FONT is an exact match for face attributes in
6173 SPECIFIED. SPECIFIED is an array of face attribute values in font
6174 sort order. AVGWIDTH, if non-zero, is an average width to compare
6178 exact_face_match_p (specified
, font
, avgwidth
)
6180 struct font_name
*font
;
6185 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6186 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6189 return (i
== DIM (font_sort_order
)
6191 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6195 /* Value is the name of a scaled font, generated from scalable font
6196 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6197 Value is allocated from heap. */
6200 build_scalable_font_name (f
, font
, specified_pt
)
6202 struct font_name
*font
;
6205 char pixel_size
[20];
6207 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6210 /* If scalable font is for a specific resolution, compute
6211 the point size we must specify from the resolution of
6212 the display and the specified resolution of the font. */
6213 if (font
->numeric
[XLFD_RESY
] != 0)
6215 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6216 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6221 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6223 /* We may need a font of the different size. */
6224 pixel_value
*= font
->rescale_ratio
;
6226 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6227 font of the specified PIXEL_SIZE. */
6229 { /* Set point size of the font. */
6230 char point_size
[20];
6231 sprintf (point_size
, "%d", (int) pt
);
6232 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6233 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6237 /* Set pixel size. */
6238 sprintf (pixel_size
, "%d", pixel_value
);
6239 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6240 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6242 /* If font doesn't specify its resolution, use the
6243 resolution of the display. */
6244 if (font
->numeric
[XLFD_RESY
] == 0)
6247 sprintf (buffer
, "%d", (int) resy
);
6248 font
->fields
[XLFD_RESY
] = buffer
;
6249 font
->numeric
[XLFD_RESY
] = resy
;
6252 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6255 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6256 sprintf (buffer
, "%d", resx
);
6257 font
->fields
[XLFD_RESX
] = buffer
;
6258 font
->numeric
[XLFD_RESX
] = resx
;
6261 return build_font_name (font
);
6265 /* Value is non-zero if we are allowed to use scalable font FONT. We
6266 can't run a Lisp function here since this function may be called
6267 with input blocked. */
6270 may_use_scalable_font_p (font
)
6273 if (EQ (Vscalable_fonts_allowed
, Qt
))
6275 else if (CONSP (Vscalable_fonts_allowed
))
6277 Lisp_Object tail
, regexp
;
6279 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6281 regexp
= XCAR (tail
);
6282 if (STRINGP (regexp
)
6283 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6293 /* Return the name of the best matching font for face attributes ATTRS
6294 in the array of font_name structures FONTS which contains NFONTS
6295 elements. WIDTH_RATIO is a factor with which to multiply average
6296 widths if ATTRS specifies such a width.
6298 Value is a font name which is allocated from the heap. FONTS is
6299 freed by this function.
6301 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6302 indicate whether the resulting font should be drawn using overstrike
6303 to simulate bold-face. */
6306 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6309 struct font_name
*fonts
;
6312 int *needs_overstrike
;
6315 struct font_name
*best
;
6318 int exact_p
, avgwidth
;
6323 /* Make specified font attributes available in `specified',
6324 indexed by sort order. */
6325 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6327 int xlfd_idx
= font_sort_order
[i
];
6329 if (xlfd_idx
== XLFD_SWIDTH
)
6330 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6331 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6332 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6333 else if (xlfd_idx
== XLFD_WEIGHT
)
6334 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6335 else if (xlfd_idx
== XLFD_SLANT
)
6336 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6341 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6343 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6347 if (needs_overstrike
)
6348 *needs_overstrike
= 0;
6350 /* Start with the first non-scalable font in the list. */
6351 for (i
= 0; i
< nfonts
; ++i
)
6352 if (!font_scalable_p (fonts
+ i
))
6355 /* Find the best match among the non-scalable fonts. */
6360 for (i
= 1; i
< nfonts
; ++i
)
6361 if (!font_scalable_p (fonts
+ i
)
6362 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6366 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6374 /* Unless we found an exact match among non-scalable fonts, see if
6375 we can find a better match among scalable fonts. */
6378 /* A scalable font is better if
6380 1. its weight, slant, swidth attributes are better, or.
6382 2. the best non-scalable font doesn't have the required
6383 point size, and the scalable fonts weight, slant, swidth
6386 int non_scalable_has_exact_height_p
;
6388 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6389 non_scalable_has_exact_height_p
= 1;
6391 non_scalable_has_exact_height_p
= 0;
6393 for (i
= 0; i
< nfonts
; ++i
)
6394 if (font_scalable_p (fonts
+ i
))
6397 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6398 || (!non_scalable_has_exact_height_p
6399 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6403 if (needs_overstrike
)
6405 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6406 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6408 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6410 /* We want a bold font, but didn't get one; try to use
6411 overstriking instead to simulate bold-face. However,
6412 don't overstrike an already-bold fontn unless the
6413 desired weight grossly exceeds the available weight. */
6414 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6415 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6417 *needs_overstrike
= 1;
6422 if (font_scalable_p (best
))
6423 font_name
= build_scalable_font_name (f
, best
, pt
);
6425 font_name
= build_font_name (best
);
6427 /* Free font_name structures. */
6428 free_font_names (fonts
, nfonts
);
6434 /* Get a list of matching fonts on frame F, considering FAMILY
6435 and alternative font families from Vface_alternative_font_registry_alist.
6437 FAMILY is the font family whose alternatives are considered.
6439 REGISTRY, if a string, specifies a font registry and encoding to
6440 match. A value of nil means include fonts of any registry and
6443 Return in *FONTS a pointer to a vector of font_name structures for
6444 the fonts matched. Value is the number of fonts found. */
6447 try_alternative_families (f
, family
, registry
, fonts
)
6449 Lisp_Object family
, registry
;
6450 struct font_name
**fonts
;
6455 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6458 /* Try alternative font families. */
6459 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6462 for (alter
= XCDR (alter
);
6463 CONSP (alter
) && nfonts
== 0;
6464 alter
= XCDR (alter
))
6466 if (STRINGP (XCAR (alter
)))
6467 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6471 /* Try all scalable fonts before giving up. */
6472 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6474 int count
= SPECPDL_INDEX ();
6475 specbind (Qscalable_fonts_allowed
, Qt
);
6476 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6477 unbind_to (count
, Qnil
);
6484 /* Get a list of matching fonts on frame F.
6486 PATTERN, if a string, specifies a font name pattern to match while
6487 ignoring FAMILY and REGISTRY.
6489 FAMILY, if a list, specifies a list of font families to try.
6491 REGISTRY, if a list, specifies a list of font registries and
6494 Return in *FONTS a pointer to a vector of font_name structures for
6495 the fonts matched. Value is the number of fonts found. */
6498 try_font_list (f
, pattern
, family
, registry
, fonts
)
6500 Lisp_Object pattern
, family
, registry
;
6501 struct font_name
**fonts
;
6505 if (STRINGP (pattern
))
6506 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6512 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6514 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6515 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6517 /* Try font family of the default face or "fixed". */
6518 if (nfonts
== 0 && !NILP (family
))
6520 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6522 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6524 family
= build_string ("fixed");
6525 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6528 /* Try any family with the given registry. */
6529 if (nfonts
== 0 && !NILP (family
))
6530 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6537 /* Return the fontset id of the base fontset name or alias name given
6538 by the fontset attribute of ATTRS. Value is -1 if the fontset
6539 attribute of ATTRS doesn't name a fontset. */
6542 face_fontset (attrs
)
6547 name
= attrs
[LFACE_FONTSET_INDEX
];
6548 if (!STRINGP (name
))
6550 return fs_query_fontset (name
, 0);
6554 /* Choose a name of font to use on frame F to display characters with
6555 Lisp face attributes specified by ATTRS. The font name is
6556 determined by the font-related attributes in ATTRS and FONT-SPEC
6559 When we are choosing a font for ASCII characters, FONT-SPEC is
6560 always nil. Otherwise FONT-SPEC is a list
6561 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6562 or a string specifying a font name pattern.
6564 If NEEDS_OVERSTRIKE is not NULL, a boolean is returned in it to
6565 indicate whether the resulting font should be drawn using
6566 overstrike to simulate bold-face.
6568 Value is the font name which is allocated from the heap and must be
6569 freed by the caller. */
6572 choose_face_font (f
, attrs
, font_spec
, needs_overstrike
)
6575 Lisp_Object font_spec
;
6576 int *needs_overstrike
;
6578 Lisp_Object pattern
, family
, adstyle
, registry
;
6579 char *font_name
= NULL
;
6580 struct font_name
*fonts
;
6583 if (needs_overstrike
)
6584 *needs_overstrike
= 0;
6586 /* If we are choosing an ASCII font and a font name is explicitly
6587 specified in ATTRS, return it. */
6588 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6589 return xstrdup (SDATA (attrs
[LFACE_FONT_INDEX
]));
6591 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6594 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6596 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6597 ADSTYLE is not used in the font selector for the moment. */
6598 if (VECTORP (font_spec
))
6601 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6602 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6603 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6604 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6606 else if (STRINGP (font_spec
))
6608 pattern
= font_spec
;
6615 /* We are choosing an ASCII font. By default, use the registry
6616 name "iso8859-1". But, if the registry name of the ASCII
6617 font specified in the fontset of ATTRS is not "iso8859-1"
6618 (e.g "iso10646-1"), use also that name with higher
6620 int fontset
= face_fontset (attrs
);
6623 struct font_name font
;
6627 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
6629 ascii
= fontset_ascii (fontset
);
6630 len
= SBYTES (ascii
);
6632 || strcmp (SDATA (ascii
) + len
- 9, "iso8859-1"))
6634 font
.name
= LSTRDUPA (ascii
);
6635 /* Check if the name is in XLFD. */
6636 if (split_font_name (f
, &font
, 0))
6638 font
.fields
[XLFD_ENCODING
][-1] = '-';
6639 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
6645 /* Get a list of fonts matching that pattern and choose the
6646 best match for the specified face attributes from it. */
6647 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6648 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
),
6653 #endif /* HAVE_WINDOW_SYSTEM */
6657 /***********************************************************************
6659 ***********************************************************************/
6661 /* Realize basic faces on frame F. Value is zero if frame parameters
6662 of F don't contain enough information needed to realize the default
6666 realize_basic_faces (f
)
6670 int count
= SPECPDL_INDEX ();
6672 /* Block input here so that we won't be surprised by an X expose
6673 event, for instance, without having the faces set up. */
6675 specbind (Qscalable_fonts_allowed
, Qt
);
6677 if (realize_default_face (f
))
6679 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6680 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6681 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6682 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6683 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6684 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6685 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6686 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6687 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6688 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6690 /* Reflect changes in the `menu' face in menu bars. */
6691 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6693 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6694 #ifdef USE_X_TOOLKIT
6695 x_update_menu_appearance (f
);
6702 unbind_to (count
, Qnil
);
6708 /* Realize the default face on frame F. If the face is not fully
6709 specified, make it fully-specified. Attributes of the default face
6710 that are not explicitly specified are taken from frame parameters. */
6713 realize_default_face (f
)
6716 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6718 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6719 Lisp_Object frame_font
;
6722 /* If the `default' face is not yet known, create it. */
6723 lface
= lface_from_face_name (f
, Qdefault
, 0);
6727 XSETFRAME (frame
, f
);
6728 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6732 #ifdef HAVE_WINDOW_SYSTEM
6733 if (FRAME_WINDOW_P (f
))
6735 /* Set frame_font to the value of the `font' frame parameter. */
6736 frame_font
= Fassq (Qfont
, f
->param_alist
);
6737 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6738 frame_font
= XCDR (frame_font
);
6739 set_lface_from_font_name (f
, lface
, frame_font
,
6740 f
->default_face_done_p
, 1);
6741 f
->default_face_done_p
= 1;
6743 #endif /* HAVE_WINDOW_SYSTEM */
6745 if (!FRAME_WINDOW_P (f
))
6747 LFACE_FAMILY (lface
) = build_string ("default");
6748 LFACE_SWIDTH (lface
) = Qnormal
;
6749 LFACE_HEIGHT (lface
) = make_number (1);
6750 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6751 LFACE_WEIGHT (lface
) = Qnormal
;
6752 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6753 LFACE_SLANT (lface
) = Qnormal
;
6754 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6757 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6758 LFACE_UNDERLINE (lface
) = Qnil
;
6760 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6761 LFACE_OVERLINE (lface
) = Qnil
;
6763 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6764 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6766 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6767 LFACE_BOX (lface
) = Qnil
;
6769 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6770 LFACE_INVERSE (lface
) = Qnil
;
6772 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6774 /* This function is called so early that colors are not yet
6775 set in the frame parameter list. */
6776 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6778 if (CONSP (color
) && STRINGP (XCDR (color
)))
6779 LFACE_FOREGROUND (lface
) = XCDR (color
);
6780 else if (FRAME_WINDOW_P (f
))
6782 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6783 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6788 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6790 /* This function is called so early that colors are not yet
6791 set in the frame parameter list. */
6792 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6793 if (CONSP (color
) && STRINGP (XCDR (color
)))
6794 LFACE_BACKGROUND (lface
) = XCDR (color
);
6795 else if (FRAME_WINDOW_P (f
))
6797 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6798 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6803 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6804 LFACE_STIPPLE (lface
) = Qnil
;
6806 /* Realize the face; it must be fully-specified now. */
6807 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6808 check_lface (lface
);
6809 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6810 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6815 /* Realize basic faces other than the default face in face cache C.
6816 SYMBOL is the face name, ID is the face id the realized face must
6817 have. The default face must have been realized already. */
6820 realize_named_face (f
, symbol
, id
)
6825 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6826 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6827 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6828 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6829 struct face
*new_face
;
6831 /* The default face must exist and be fully specified. */
6832 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6833 check_lface_attrs (attrs
);
6834 xassert (lface_fully_specified_p (attrs
));
6836 /* If SYMBOL isn't know as a face, create it. */
6840 XSETFRAME (frame
, f
);
6841 lface
= Finternal_make_lisp_face (symbol
, frame
);
6844 /* Merge SYMBOL's face with the default face. */
6845 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6846 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6848 /* Realize the face. */
6849 new_face
= realize_face (c
, attrs
, id
);
6853 /* Realize the fully-specified face with attributes ATTRS in face
6854 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6855 non-negative, it is an ID of face to remove before caching the new
6856 face. Value is a pointer to the newly created realized face. */
6858 static struct face
*
6859 realize_face (cache
, attrs
, former_face_id
)
6860 struct face_cache
*cache
;
6866 /* LFACE must be fully specified. */
6867 xassert (cache
!= NULL
);
6868 check_lface_attrs (attrs
);
6870 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6872 /* Remove the former face. */
6873 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6874 uncache_face (cache
, former_face
);
6875 free_realized_face (cache
->f
, former_face
);
6878 if (FRAME_WINDOW_P (cache
->f
))
6879 face
= realize_x_face (cache
, attrs
);
6880 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6881 face
= realize_tty_face (cache
, attrs
);
6885 /* Insert the new face. */
6886 cache_face (cache
, face
, lface_hash (attrs
));
6891 /* Realize the fully-specified face that has the same attributes as
6892 BASE_FACE except for the font on frame F. If FONT_ID is not
6893 negative, it is an ID number of an already opened font that should
6894 be used by the face. If FONT_ID is negative, the face has no font,
6895 i.e., characters are displayed by empty boxes. */
6897 static struct face
*
6898 realize_non_ascii_face (f
, font_id
, base_face
)
6901 struct face
*base_face
;
6903 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6905 struct font_info
*font_info
;
6907 face
= (struct face
*) xmalloc (sizeof *face
);
6911 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6912 face
->colors_copied_bitwise_p
= 1;
6914 face
->font_info_id
= font_id
;
6917 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6918 face
->font
= font_info
->font
;
6919 face
->font_name
= font_info
->full_name
;
6924 face
->font_name
= NULL
;
6929 cache_face (cache
, face
, face
->hash
);
6935 /* Realize the fully-specified face with attributes ATTRS in face
6936 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6937 the new face doesn't share font with the default face, a fontname
6938 is allocated from the heap and set in `font_name' of the new face,
6939 but it is not yet loaded here. Value is a pointer to the newly
6940 created realized face. */
6942 static struct face
*
6943 realize_x_face (cache
, attrs
)
6944 struct face_cache
*cache
;
6947 #ifdef HAVE_WINDOW_SYSTEM
6948 struct face
*face
, *default_face
;
6950 Lisp_Object stipple
, overline
, strike_through
, box
;
6952 xassert (FRAME_WINDOW_P (cache
->f
));
6954 /* Allocate a new realized face. */
6955 face
= make_realized_face (attrs
);
6956 face
->ascii_face
= face
;
6960 /* Determine the font to use. Most of the time, the font will be
6961 the same as the font of the default face, so try that first. */
6962 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6964 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6966 face
->font
= default_face
->font
;
6967 face
->font_info_id
= default_face
->font_info_id
;
6968 face
->font_name
= default_face
->font_name
;
6970 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6974 /* If the face attribute ATTRS specifies a fontset, use it as
6975 the base of a new realized fontset. Otherwise, use the same
6976 base fontset as of the default face. The base determines
6977 registry and encoding of a font. It may also determine
6978 foundry and family. The other fields of font name pattern
6979 are constructed from ATTRS. */
6980 int fontset
= face_fontset (attrs
);
6982 /* If we are realizing the default face, ATTRS should specify a
6983 fontset. In other words, if FONTSET is -1, we are not
6984 realizing the default face, thus the default face should have
6985 already been realized. */
6987 fontset
= default_face
->fontset
;
6990 load_face_font (f
, face
);
6991 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6994 /* Load colors, and set remaining attributes. */
6996 load_face_colors (f
, face
, attrs
);
6999 box
= attrs
[LFACE_BOX_INDEX
];
7002 /* A simple box of line width 1 drawn in color given by
7004 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
7006 face
->box
= FACE_SIMPLE_BOX
;
7007 face
->box_line_width
= 1;
7009 else if (INTEGERP (box
))
7011 /* Simple box of specified line width in foreground color of the
7013 xassert (XINT (box
) != 0);
7014 face
->box
= FACE_SIMPLE_BOX
;
7015 face
->box_line_width
= XINT (box
);
7016 face
->box_color
= face
->foreground
;
7017 face
->box_color_defaulted_p
= 1;
7019 else if (CONSP (box
))
7021 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
7022 being one of `raised' or `sunken'. */
7023 face
->box
= FACE_SIMPLE_BOX
;
7024 face
->box_color
= face
->foreground
;
7025 face
->box_color_defaulted_p
= 1;
7026 face
->box_line_width
= 1;
7030 Lisp_Object keyword
, value
;
7032 keyword
= XCAR (box
);
7040 if (EQ (keyword
, QCline_width
))
7042 if (INTEGERP (value
) && XINT (value
) != 0)
7043 face
->box_line_width
= XINT (value
);
7045 else if (EQ (keyword
, QCcolor
))
7047 if (STRINGP (value
))
7049 face
->box_color
= load_color (f
, face
, value
,
7051 face
->use_box_color_for_shadows_p
= 1;
7054 else if (EQ (keyword
, QCstyle
))
7056 if (EQ (value
, Qreleased_button
))
7057 face
->box
= FACE_RAISED_BOX
;
7058 else if (EQ (value
, Qpressed_button
))
7059 face
->box
= FACE_SUNKEN_BOX
;
7064 /* Text underline, overline, strike-through. */
7066 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7068 /* Use default color (same as foreground color). */
7069 face
->underline_p
= 1;
7070 face
->underline_defaulted_p
= 1;
7071 face
->underline_color
= 0;
7073 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7075 /* Use specified color. */
7076 face
->underline_p
= 1;
7077 face
->underline_defaulted_p
= 0;
7078 face
->underline_color
7079 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7080 LFACE_UNDERLINE_INDEX
);
7082 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7084 face
->underline_p
= 0;
7085 face
->underline_defaulted_p
= 0;
7086 face
->underline_color
= 0;
7089 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7090 if (STRINGP (overline
))
7092 face
->overline_color
7093 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7094 LFACE_OVERLINE_INDEX
);
7095 face
->overline_p
= 1;
7097 else if (EQ (overline
, Qt
))
7099 face
->overline_color
= face
->foreground
;
7100 face
->overline_color_defaulted_p
= 1;
7101 face
->overline_p
= 1;
7104 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7105 if (STRINGP (strike_through
))
7107 face
->strike_through_color
7108 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7109 LFACE_STRIKE_THROUGH_INDEX
);
7110 face
->strike_through_p
= 1;
7112 else if (EQ (strike_through
, Qt
))
7114 face
->strike_through_color
= face
->foreground
;
7115 face
->strike_through_color_defaulted_p
= 1;
7116 face
->strike_through_p
= 1;
7119 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7120 if (!NILP (stipple
))
7121 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7124 #endif /* HAVE_WINDOW_SYSTEM */
7128 /* Map a specified color of face FACE on frame F to a tty color index.
7129 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7130 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7131 default foreground/background colors. */
7134 map_tty_color (f
, face
, idx
, defaulted
)
7137 enum lface_attribute_index idx
;
7140 Lisp_Object frame
, color
, def
;
7141 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7142 unsigned long default_pixel
, default_other_pixel
, pixel
;
7144 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7148 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7149 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7153 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7154 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7157 XSETFRAME (frame
, f
);
7158 color
= face
->lface
[idx
];
7162 && CONSP (Vtty_defined_color_alist
)
7163 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7166 /* Associations in tty-defined-color-alist are of the form
7167 (NAME INDEX R G B). We need the INDEX part. */
7168 pixel
= XINT (XCAR (XCDR (def
)));
7171 if (pixel
== default_pixel
&& STRINGP (color
))
7173 pixel
= load_color (f
, face
, color
, idx
);
7175 #if defined (MSDOS) || defined (WINDOWSNT)
7176 /* If the foreground of the default face is the default color,
7177 use the foreground color defined by the frame. */
7179 if (FRAME_MSDOS_P (f
))
7182 if (pixel
== default_pixel
7183 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7186 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7188 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7189 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7192 else if (pixel
== default_other_pixel
)
7195 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7197 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7198 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7204 #endif /* MSDOS or WINDOWSNT */
7208 face
->foreground
= pixel
;
7210 face
->background
= pixel
;
7214 /* Realize the fully-specified face with attributes ATTRS in face
7215 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
7216 Value is a pointer to the newly created realized face. */
7218 static struct face
*
7219 realize_tty_face (cache
, attrs
)
7220 struct face_cache
*cache
;
7225 int face_colors_defaulted
= 0;
7226 struct frame
*f
= cache
->f
;
7228 /* Frame must be a termcap frame. */
7229 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7231 /* Allocate a new realized face. */
7232 face
= make_realized_face (attrs
);
7233 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7235 /* Map face attributes to TTY appearances. We map slant to
7236 dimmed text because we want italic text to appear differently
7237 and because dimmed text is probably used infrequently. */
7238 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7239 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7241 if (weight
> XLFD_WEIGHT_MEDIUM
)
7242 face
->tty_bold_p
= 1;
7243 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7244 face
->tty_dim_p
= 1;
7245 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7246 face
->tty_underline_p
= 1;
7247 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7248 face
->tty_reverse_p
= 1;
7250 /* Map color names to color indices. */
7251 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7252 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7254 /* Swap colors if face is inverse-video. If the colors are taken
7255 from the frame colors, they are already inverted, since the
7256 frame-creation function calls x-handle-reverse-video. */
7257 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7259 unsigned long tem
= face
->foreground
;
7260 face
->foreground
= face
->background
;
7261 face
->background
= tem
;
7264 if (tty_suppress_bold_inverse_default_colors_p
7266 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7267 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7268 face
->tty_bold_p
= 0;
7274 DEFUN ("tty-suppress-bold-inverse-default-colors",
7275 Ftty_suppress_bold_inverse_default_colors
,
7276 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7277 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7278 SUPPRESS non-nil means suppress it.
7279 This affects bold faces on TTYs whose foreground is the default background
7280 color of the display and whose background is the default foreground color.
7281 For such faces, the bold face attribute is ignored if this variable
7284 Lisp_Object suppress
;
7286 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7287 ++face_change_count
;
7293 /***********************************************************************
7295 ***********************************************************************/
7297 /* Return the ID of the face to use to display character CH with face
7298 property PROP on frame F in current_buffer. */
7301 compute_char_face (f
, ch
, prop
)
7308 if (NILP (current_buffer
->enable_multibyte_characters
))
7313 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7314 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7318 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7319 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7320 bcopy (face
->lface
, attrs
, sizeof attrs
);
7321 merge_face_vector_with_property (f
, attrs
, prop
);
7322 face_id
= lookup_face (f
, attrs
);
7323 if (! ASCII_CHAR_P (ch
))
7325 face
= FACE_FROM_ID (f
, face_id
);
7326 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7333 /* Return the face ID associated with buffer position POS for
7334 displaying ASCII characters. Return in *ENDPTR the position at
7335 which a different face is needed, as far as text properties and
7336 overlays are concerned. W is a window displaying current_buffer.
7338 REGION_BEG, REGION_END delimit the region, so it can be
7341 LIMIT is a position not to scan beyond. That is to limit the time
7342 this function can take.
7344 If MOUSE is non-zero, use the character's mouse-face, not its face.
7346 The face returned is suitable for displaying ASCII characters. */
7349 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7350 endptr
, limit
, mouse
)
7353 int region_beg
, region_end
;
7358 struct frame
*f
= XFRAME (w
->frame
);
7359 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7360 Lisp_Object prop
, position
;
7362 Lisp_Object
*overlay_vec
;
7365 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7366 Lisp_Object limit1
, end
;
7367 struct face
*default_face
;
7369 /* W must display the current buffer. We could write this function
7370 to use the frame and buffer of W, but right now it doesn't. */
7371 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7373 XSETFRAME (frame
, f
);
7374 XSETFASTINT (position
, pos
);
7377 if (pos
< region_beg
&& region_beg
< endpos
)
7378 endpos
= region_beg
;
7380 /* Get the `face' or `mouse_face' text property at POS, and
7381 determine the next position at which the property changes. */
7382 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7383 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7384 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7386 endpos
= XINT (end
);
7388 /* Look at properties from overlays. */
7393 /* First try with room for 40 overlays. */
7395 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7396 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7397 &next_overlay
, NULL
, 0);
7399 /* If there are more than 40, make enough space for all, and try
7401 if (noverlays
> len
)
7404 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7405 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7406 &next_overlay
, NULL
, 0);
7409 if (next_overlay
< endpos
)
7410 endpos
= next_overlay
;
7415 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7417 /* Optimize common cases where we can use the default face. */
7420 && !(pos
>= region_beg
&& pos
< region_end
))
7421 return DEFAULT_FACE_ID
;
7423 /* Begin with attributes from the default face. */
7424 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7426 /* Merge in attributes specified via text properties. */
7428 merge_face_vector_with_property (f
, attrs
, prop
);
7430 /* Now merge the overlay data. */
7431 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7432 for (i
= 0; i
< noverlays
; i
++)
7437 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7439 merge_face_vector_with_property (f
, attrs
, prop
);
7441 oend
= OVERLAY_END (overlay_vec
[i
]);
7442 oendpos
= OVERLAY_POSITION (oend
);
7443 if (oendpos
< endpos
)
7447 /* If in the region, merge in the region face. */
7448 if (pos
>= region_beg
&& pos
< region_end
)
7450 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7451 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7453 if (region_end
< endpos
)
7454 endpos
= region_end
;
7459 /* Look up a realized face with the given face attributes,
7460 or realize a new one for ASCII characters. */
7461 return lookup_face (f
, attrs
);
7465 /* Compute the face at character position POS in Lisp string STRING on
7466 window W, for ASCII characters.
7468 If STRING is an overlay string, it comes from position BUFPOS in
7469 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7470 not an overlay string. W must display the current buffer.
7471 REGION_BEG and REGION_END give the start and end positions of the
7472 region; both are -1 if no region is visible.
7474 BASE_FACE_ID is the id of a face to merge with. For strings coming
7475 from overlays or the `display' property it is the face at BUFPOS.
7477 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7479 Set *ENDPTR to the next position where to check for faces in
7480 STRING; -1 if the face is constant from POS to the end of the
7483 Value is the id of the face to use. The face returned is suitable
7484 for displaying ASCII characters. */
7487 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7488 region_end
, endptr
, base_face_id
, mouse_p
)
7492 int region_beg
, region_end
;
7494 enum face_id base_face_id
;
7497 Lisp_Object prop
, position
, end
, limit
;
7498 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7499 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7500 struct face
*base_face
;
7501 int multibyte_p
= STRING_MULTIBYTE (string
);
7502 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7504 /* Get the value of the face property at the current position within
7505 STRING. Value is nil if there is no face property. */
7506 XSETFASTINT (position
, pos
);
7507 prop
= Fget_text_property (position
, prop_name
, string
);
7509 /* Get the next position at which to check for faces. Value of end
7510 is nil if face is constant all the way to the end of the string.
7511 Otherwise it is a string position where to check faces next.
7512 Limit is the maximum position up to which to check for property
7513 changes in Fnext_single_property_change. Strings are usually
7514 short, so set the limit to the end of the string. */
7515 XSETFASTINT (limit
, SCHARS (string
));
7516 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7518 *endptr
= XFASTINT (end
);
7522 base_face
= FACE_FROM_ID (f
, base_face_id
);
7523 xassert (base_face
);
7525 /* Optimize the default case that there is no face property and we
7526 are not in the region. */
7528 && (base_face_id
!= DEFAULT_FACE_ID
7529 /* BUFPOS <= 0 means STRING is not an overlay string, so
7530 that the region doesn't have to be taken into account. */
7532 || bufpos
< region_beg
7533 || bufpos
>= region_end
)
7535 /* We can't realize faces for different charsets differently
7536 if we don't have fonts, so we can stop here if not working
7537 on a window-system frame. */
7538 || !FRAME_WINDOW_P (f
)
7539 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7540 return base_face
->id
;
7542 /* Begin with attributes from the base face. */
7543 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7545 /* Merge in attributes specified via text properties. */
7547 merge_face_vector_with_property (f
, attrs
, prop
);
7549 /* If in the region, merge in the region face. */
7551 && bufpos
>= region_beg
7552 && bufpos
< region_end
)
7554 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7555 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7558 /* Look up a realized face with the given face attributes,
7559 or realize a new one for ASCII characters. */
7560 return lookup_face (f
, attrs
);
7565 /***********************************************************************
7567 ***********************************************************************/
7571 /* Print the contents of the realized face FACE to stderr. */
7574 dump_realized_face (face
)
7577 fprintf (stderr
, "ID: %d\n", face
->id
);
7578 #ifdef HAVE_X_WINDOWS
7579 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7581 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7583 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7584 fprintf (stderr
, "background: 0x%lx (%s)\n",
7586 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7587 fprintf (stderr
, "font_name: %s (%s)\n",
7589 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7590 #ifdef HAVE_X_WINDOWS
7591 fprintf (stderr
, "font = %p\n", face
->font
);
7593 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7594 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7595 fprintf (stderr
, "underline: %d (%s)\n",
7597 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7598 fprintf (stderr
, "hash: %d\n", face
->hash
);
7602 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7610 fprintf (stderr
, "font selection order: ");
7611 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7612 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7613 fprintf (stderr
, "\n");
7615 fprintf (stderr
, "alternative fonts: ");
7616 debug_print (Vface_alternative_font_family_alist
);
7617 fprintf (stderr
, "\n");
7619 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7620 Fdump_face (make_number (i
));
7626 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7628 error ("Not a valid face");
7629 dump_realized_face (face
);
7636 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7637 0, 0, 0, doc
: /* */)
7640 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7641 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7642 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7646 #endif /* GLYPH_DEBUG != 0 */
7650 /***********************************************************************
7652 ***********************************************************************/
7657 Qface
= intern ("face");
7659 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7660 staticpro (&Qbitmap_spec_p
);
7661 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7662 staticpro (&Qframe_update_face_colors
);
7664 /* Lisp face attribute keywords. */
7665 QCfamily
= intern (":family");
7666 staticpro (&QCfamily
);
7667 QCheight
= intern (":height");
7668 staticpro (&QCheight
);
7669 QCweight
= intern (":weight");
7670 staticpro (&QCweight
);
7671 QCslant
= intern (":slant");
7672 staticpro (&QCslant
);
7673 QCunderline
= intern (":underline");
7674 staticpro (&QCunderline
);
7675 QCinverse_video
= intern (":inverse-video");
7676 staticpro (&QCinverse_video
);
7677 QCreverse_video
= intern (":reverse-video");
7678 staticpro (&QCreverse_video
);
7679 QCforeground
= intern (":foreground");
7680 staticpro (&QCforeground
);
7681 QCbackground
= intern (":background");
7682 staticpro (&QCbackground
);
7683 QCstipple
= intern (":stipple");;
7684 staticpro (&QCstipple
);
7685 QCwidth
= intern (":width");
7686 staticpro (&QCwidth
);
7687 QCfont
= intern (":font");
7688 staticpro (&QCfont
);
7689 QCfontset
= intern (":fontset");
7690 staticpro (&QCfontset
);
7691 QCbold
= intern (":bold");
7692 staticpro (&QCbold
);
7693 QCitalic
= intern (":italic");
7694 staticpro (&QCitalic
);
7695 QCoverline
= intern (":overline");
7696 staticpro (&QCoverline
);
7697 QCstrike_through
= intern (":strike-through");
7698 staticpro (&QCstrike_through
);
7699 QCbox
= intern (":box");
7701 QCinherit
= intern (":inherit");
7702 staticpro (&QCinherit
);
7704 /* Symbols used for Lisp face attribute values. */
7705 QCcolor
= intern (":color");
7706 staticpro (&QCcolor
);
7707 QCline_width
= intern (":line-width");
7708 staticpro (&QCline_width
);
7709 QCstyle
= intern (":style");
7710 staticpro (&QCstyle
);
7711 Qreleased_button
= intern ("released-button");
7712 staticpro (&Qreleased_button
);
7713 Qpressed_button
= intern ("pressed-button");
7714 staticpro (&Qpressed_button
);
7715 Qnormal
= intern ("normal");
7716 staticpro (&Qnormal
);
7717 Qultra_light
= intern ("ultra-light");
7718 staticpro (&Qultra_light
);
7719 Qextra_light
= intern ("extra-light");
7720 staticpro (&Qextra_light
);
7721 Qlight
= intern ("light");
7722 staticpro (&Qlight
);
7723 Qsemi_light
= intern ("semi-light");
7724 staticpro (&Qsemi_light
);
7725 Qsemi_bold
= intern ("semi-bold");
7726 staticpro (&Qsemi_bold
);
7727 Qbold
= intern ("bold");
7729 Qextra_bold
= intern ("extra-bold");
7730 staticpro (&Qextra_bold
);
7731 Qultra_bold
= intern ("ultra-bold");
7732 staticpro (&Qultra_bold
);
7733 Qoblique
= intern ("oblique");
7734 staticpro (&Qoblique
);
7735 Qitalic
= intern ("italic");
7736 staticpro (&Qitalic
);
7737 Qreverse_oblique
= intern ("reverse-oblique");
7738 staticpro (&Qreverse_oblique
);
7739 Qreverse_italic
= intern ("reverse-italic");
7740 staticpro (&Qreverse_italic
);
7741 Qultra_condensed
= intern ("ultra-condensed");
7742 staticpro (&Qultra_condensed
);
7743 Qextra_condensed
= intern ("extra-condensed");
7744 staticpro (&Qextra_condensed
);
7745 Qcondensed
= intern ("condensed");
7746 staticpro (&Qcondensed
);
7747 Qsemi_condensed
= intern ("semi-condensed");
7748 staticpro (&Qsemi_condensed
);
7749 Qsemi_expanded
= intern ("semi-expanded");
7750 staticpro (&Qsemi_expanded
);
7751 Qexpanded
= intern ("expanded");
7752 staticpro (&Qexpanded
);
7753 Qextra_expanded
= intern ("extra-expanded");
7754 staticpro (&Qextra_expanded
);
7755 Qultra_expanded
= intern ("ultra-expanded");
7756 staticpro (&Qultra_expanded
);
7757 Qbackground_color
= intern ("background-color");
7758 staticpro (&Qbackground_color
);
7759 Qforeground_color
= intern ("foreground-color");
7760 staticpro (&Qforeground_color
);
7761 Qunspecified
= intern ("unspecified");
7762 staticpro (&Qunspecified
);
7764 Qface_alias
= intern ("face-alias");
7765 staticpro (&Qface_alias
);
7766 Qdefault
= intern ("default");
7767 staticpro (&Qdefault
);
7768 Qtool_bar
= intern ("tool-bar");
7769 staticpro (&Qtool_bar
);
7770 Qregion
= intern ("region");
7771 staticpro (&Qregion
);
7772 Qfringe
= intern ("fringe");
7773 staticpro (&Qfringe
);
7774 Qheader_line
= intern ("header-line");
7775 staticpro (&Qheader_line
);
7776 Qscroll_bar
= intern ("scroll-bar");
7777 staticpro (&Qscroll_bar
);
7778 Qmenu
= intern ("menu");
7780 Qcursor
= intern ("cursor");
7781 staticpro (&Qcursor
);
7782 Qborder
= intern ("border");
7783 staticpro (&Qborder
);
7784 Qmouse
= intern ("mouse");
7785 staticpro (&Qmouse
);
7786 Qmode_line_inactive
= intern ("mode-line-inactive");
7787 staticpro (&Qmode_line_inactive
);
7788 Qtty_color_desc
= intern ("tty-color-desc");
7789 staticpro (&Qtty_color_desc
);
7790 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7791 staticpro (&Qtty_color_standard_values
);
7792 Qtty_color_by_index
= intern ("tty-color-by-index");
7793 staticpro (&Qtty_color_by_index
);
7794 Qtty_color_alist
= intern ("tty-color-alist");
7795 staticpro (&Qtty_color_alist
);
7796 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7797 staticpro (&Qscalable_fonts_allowed
);
7799 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7800 staticpro (&Vparam_value_alist
);
7801 Vface_alternative_font_family_alist
= Qnil
;
7802 staticpro (&Vface_alternative_font_family_alist
);
7803 Vface_alternative_font_registry_alist
= Qnil
;
7804 staticpro (&Vface_alternative_font_registry_alist
);
7806 defsubr (&Sinternal_make_lisp_face
);
7807 defsubr (&Sinternal_lisp_face_p
);
7808 defsubr (&Sinternal_set_lisp_face_attribute
);
7809 #ifdef HAVE_WINDOW_SYSTEM
7810 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7812 defsubr (&Scolor_gray_p
);
7813 defsubr (&Scolor_supported_p
);
7814 defsubr (&Sface_attribute_relative_p
);
7815 defsubr (&Smerge_face_attribute
);
7816 defsubr (&Sinternal_get_lisp_face_attribute
);
7817 defsubr (&Sinternal_lisp_face_attribute_values
);
7818 defsubr (&Sinternal_lisp_face_equal_p
);
7819 defsubr (&Sinternal_lisp_face_empty_p
);
7820 defsubr (&Sinternal_copy_lisp_face
);
7821 defsubr (&Sinternal_merge_in_global_face
);
7822 defsubr (&Sface_font
);
7823 defsubr (&Sframe_face_alist
);
7824 defsubr (&Stty_supports_face_attributes_p
);
7825 defsubr (&Scolor_distance
);
7826 defsubr (&Sinternal_set_font_selection_order
);
7827 defsubr (&Sinternal_set_alternative_font_family_alist
);
7828 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7829 defsubr (&Sface_attributes_as_vector
);
7831 defsubr (&Sdump_face
);
7832 defsubr (&Sshow_face_resources
);
7833 #endif /* GLYPH_DEBUG */
7834 defsubr (&Sclear_face_cache
);
7835 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7837 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7838 defsubr (&Sdump_colors
);
7841 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7842 doc
: /* *Limit for font matching.
7843 If an integer > 0, font matching functions won't load more than
7844 that number of fonts when searching for a matching font. */);
7845 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7847 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7848 doc
: /* List of global face definitions (for internal use only.) */);
7849 Vface_new_frame_defaults
= Qnil
;
7851 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7852 doc
: /* *Default stipple pattern used on monochrome displays.
7853 This stipple pattern is used on monochrome displays
7854 instead of shades of gray for a face background color.
7855 See `set-face-stipple' for possible values for this variable. */);
7856 Vface_default_stipple
= build_string ("gray3");
7858 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7859 doc
: /* An alist of defined terminal colors and their RGB values. */);
7860 Vtty_defined_color_alist
= Qnil
;
7862 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7863 doc
: /* Allowed scalable fonts.
7864 A value of nil means don't allow any scalable fonts.
7865 A value of t means allow any scalable font.
7866 Otherwise, value must be a list of regular expressions. A font may be
7867 scaled if its name matches a regular expression in the list.
7868 Note that if value is nil, a scalable font might still be used, if no
7869 other font of the appropriate family and registry is available. */);
7870 Vscalable_fonts_allowed
= Qnil
;
7872 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7873 doc
: /* List of ignored fonts.
7874 Each element is a regular expression that matches names of fonts to
7876 Vface_ignored_fonts
= Qnil
;
7878 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7879 doc
: /* Alist of fonts vs the rescaling factors.
7880 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7881 FONT-NAME-PATTERN is a regular expression matching a font name, and
7882 RESCALE-RATIO is a floating point number to specify how much larger
7883 \(or smaller) font we should use. For instance, if a face requests
7884 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7885 Vface_font_rescale_alist
= Qnil
;
7887 #ifdef HAVE_WINDOW_SYSTEM
7888 defsubr (&Sbitmap_spec_p
);
7889 defsubr (&Sx_list_fonts
);
7890 defsubr (&Sinternal_face_x_get_resource
);
7891 defsubr (&Sx_family_fonts
);
7892 defsubr (&Sx_font_family_list
);
7893 #endif /* HAVE_WINDOW_SYSTEM */