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 or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
200 #include "keyboard.h"
203 #ifdef HAVE_WINDOW_SYSTEM
205 #endif /* HAVE_WINDOW_SYSTEM */
207 #ifdef HAVE_X_WINDOWS
211 #include <Xm/XmStrDefs.h>
212 #endif /* USE_MOTIF */
213 #endif /* HAVE_X_WINDOWS */
222 /* Redefine X specifics to W32 equivalents to avoid cluttering the
223 code with #ifdef blocks. */
224 #undef FRAME_X_DISPLAY_INFO
225 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
226 #define x_display_info w32_display_info
227 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
228 #define check_x check_w32
229 #define x_list_fonts w32_list_fonts
230 #define GCGraphicsExposures 0
231 #endif /* WINDOWSNT */
235 #define x_display_info mac_display_info
236 #define check_x check_mac
240 #include "dispextern.h"
241 #include "blockinput.h"
243 #include "intervals.h"
245 #ifdef HAVE_X_WINDOWS
247 /* Compensate for a bug in Xos.h on some systems, on which it requires
248 time.h. On some such systems, Xos.h tries to redefine struct
249 timeval and struct timezone if USG is #defined while it is
252 #ifdef XOS_NEEDS_TIME_H
258 #else /* not XOS_NEEDS_TIME_H */
260 #endif /* not XOS_NEEDS_TIME_H */
262 #endif /* HAVE_X_WINDOWS */
267 #define abs(X) ((X) < 0 ? -(X) : (X))
269 /* Number of pt per inch (from the TeXbook). */
271 #define PT_PER_INCH 72.27
273 /* Non-zero if face attribute ATTR is unspecified. */
275 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
277 /* Value is the number of elements of VECTOR. */
279 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
281 /* Make a copy of string S on the stack using alloca. Value is a pointer
284 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
286 /* Make a copy of the contents of Lisp string S on the stack using
287 alloca. Value is a pointer to the copy. */
289 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
291 /* Size of hash table of realized faces in face caches (should be a
294 #define FACE_CACHE_BUCKETS_SIZE 1001
296 /* Keyword symbols used for face attribute names. */
298 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
299 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
300 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
301 Lisp_Object QCreverse_video
;
302 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
304 /* Symbols used for attribute values. */
306 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
307 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
308 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
309 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
310 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
311 Lisp_Object Qultra_expanded
;
312 Lisp_Object Qreleased_button
, Qpressed_button
;
313 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
314 Lisp_Object Qunspecified
;
316 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
318 /* The name of the function to call when the background of the frame
319 has changed, frame_update_face_colors. */
321 Lisp_Object Qframe_update_face_colors
;
323 /* Names of basic faces. */
325 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
326 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
327 Lisp_Object Qmode_line_inactive
;
328 extern Lisp_Object Qmode_line
;
330 /* The symbol `face-alias'. A symbols having that property is an
331 alias for another face. Value of the property is the name of
334 Lisp_Object Qface_alias
;
336 /* Default stipple pattern used on monochrome displays. This stipple
337 pattern is used on monochrome displays instead of shades of gray
338 for a face background color. See `set-face-stipple' for possible
339 values for this variable. */
341 Lisp_Object Vface_default_stipple
;
343 /* Alist of alternative font families. Each element is of the form
344 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
345 try FAMILY1, then FAMILY2, ... */
347 Lisp_Object Vface_alternative_font_family_alist
;
349 /* Alist of alternative font registries. Each element is of the form
350 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
351 loaded, try REGISTRY1, then REGISTRY2, ... */
353 Lisp_Object Vface_alternative_font_registry_alist
;
355 /* Allowed scalable fonts. A value of nil means don't allow any
356 scalable fonts. A value of t means allow the use of any scalable
357 font. Otherwise, value must be a list of regular expressions. A
358 font may be scaled if its name matches a regular expression in the
361 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
363 /* List of regular expressions that matches names of fonts to ignore. */
365 Lisp_Object Vface_ignored_fonts
;
367 /* Alist of font name patterns vs the rescaling factor. */
369 Lisp_Object Vface_font_rescale_alist
;
371 /* Maximum number of fonts to consider in font_list. If not an
372 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
374 Lisp_Object Vfont_list_limit
;
375 #define DEFAULT_FONT_LIST_LIMIT 100
377 /* The symbols `foreground-color' and `background-color' which can be
378 used as part of a `face' property. This is for compatibility with
381 Lisp_Object Qforeground_color
, Qbackground_color
;
383 /* The symbols `face' and `mouse-face' used as text properties. */
386 extern Lisp_Object Qmouse_face
;
388 /* Error symbol for wrong_type_argument in load_pixmap. */
390 Lisp_Object Qbitmap_spec_p
;
392 /* Alist of global face definitions. Each element is of the form
393 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
394 is a Lisp vector of face attributes. These faces are used
395 to initialize faces for new frames. */
397 Lisp_Object Vface_new_frame_defaults
;
399 /* The next ID to assign to Lisp faces. */
401 static int next_lface_id
;
403 /* A vector mapping Lisp face Id's to face names. */
405 static Lisp_Object
*lface_id_to_name
;
406 static int lface_id_to_name_size
;
408 /* TTY color-related functions (defined in tty-colors.el). */
410 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
412 /* The name of the function used to compute colors on TTYs. */
414 Lisp_Object Qtty_color_alist
;
416 /* An alist of defined terminal colors and their RGB values. */
418 Lisp_Object Vtty_defined_color_alist
;
420 /* Counter for calls to clear_face_cache. If this counter reaches
421 CLEAR_FONT_TABLE_COUNT, and a frame has more than
422 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
424 static int clear_font_table_count
;
425 #define CLEAR_FONT_TABLE_COUNT 100
426 #define CLEAR_FONT_TABLE_NFONTS 10
428 /* Non-zero means face attributes have been changed since the last
429 redisplay. Used in redisplay_internal. */
431 int face_change_count
;
433 /* Non-zero means don't display bold text if a face's foreground
434 and background colors are the inverse of the default colors of the
435 display. This is a kluge to suppress `bold black' foreground text
436 which is hard to read on an LCD monitor. */
438 int tty_suppress_bold_inverse_default_colors_p
;
440 /* A list of the form `((x . y))' used to avoid consing in
441 Finternal_set_lisp_face_attribute. */
443 static Lisp_Object Vparam_value_alist
;
445 /* The total number of colors currently allocated. */
448 static int ncolors_allocated
;
449 static int npixmaps_allocated
;
453 /* Non-zero means the definition of the `menu' face for new frames has
456 int menu_face_changed_default
;
459 /* Function prototypes. */
464 static void map_tty_color
P_ ((struct frame
*, struct face
*,
465 enum lface_attribute_index
, int *));
466 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
467 static int may_use_scalable_font_p
P_ ((const char *));
468 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
469 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
471 static int x_face_list_fonts
P_ ((struct frame
*, char *,
472 struct font_name
**, int, int));
473 static int font_scalable_p
P_ ((struct font_name
*));
474 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
475 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
476 static unsigned char *xstrlwr
P_ ((unsigned char *));
477 static void signal_error
P_ ((char *, Lisp_Object
));
478 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
479 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
480 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
481 static void free_face_colors
P_ ((struct frame
*, struct face
*));
482 static int face_color_gray_p
P_ ((struct frame
*, char *));
483 static char *build_font_name
P_ ((struct font_name
*));
484 static void free_font_names
P_ ((struct font_name
*, int));
485 static int sorted_font_list
P_ ((struct frame
*, char *,
486 int (*cmpfn
) P_ ((const void *, const void *)),
487 struct font_name
**));
488 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
489 Lisp_Object
, struct font_name
**));
490 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
491 Lisp_Object
, struct font_name
**));
492 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
493 Lisp_Object
, Lisp_Object
, struct font_name
**,
495 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
496 Lisp_Object
, struct font_name
**));
497 static int cmp_font_names
P_ ((const void *, const void *));
498 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
499 struct face
*, int));
500 static struct face
*realize_x_face
P_ ((struct face_cache
*,
501 Lisp_Object
*, int, struct face
*));
502 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
503 Lisp_Object
*, int));
504 static int realize_basic_faces
P_ ((struct frame
*));
505 static int realize_default_face
P_ ((struct frame
*));
506 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
507 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
508 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
509 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
510 static unsigned lface_hash
P_ ((Lisp_Object
*));
511 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
512 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
513 static void free_realized_face
P_ ((struct frame
*, struct face
*));
514 static void clear_face_gcs
P_ ((struct face_cache
*));
515 static void free_face_cache
P_ ((struct face_cache
*));
516 static int face_numeric_weight
P_ ((Lisp_Object
));
517 static int face_numeric_slant
P_ ((Lisp_Object
));
518 static int face_numeric_swidth
P_ ((Lisp_Object
));
519 static int face_fontset
P_ ((Lisp_Object
*));
520 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int, int*));
521 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
522 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
523 Lisp_Object
*, Lisp_Object
));
524 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
526 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
527 Lisp_Object
, int, int));
528 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
529 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
530 static void free_realized_faces
P_ ((struct face_cache
*));
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
1220 character C. The name of the font to load is determined by lface
1221 and fontset of FACE. */
1224 load_face_font (f
, face
, c
)
1229 struct font_info
*font_info
= NULL
;
1231 int needs_overstrike
;
1233 face
->font_info_id
= -1;
1236 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
,
1242 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1247 face
->font_info_id
= font_info
->font_idx
;
1248 face
->font
= font_info
->font
;
1249 face
->font_name
= font_info
->full_name
;
1250 face
->overstrike
= needs_overstrike
;
1253 x_free_gc (f
, face
->gc
);
1258 add_to_log ("Unable to load font %s",
1259 build_string (font_name
), Qnil
);
1263 #endif /* HAVE_WINDOW_SYSTEM */
1267 /***********************************************************************
1269 ***********************************************************************/
1271 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1272 RGB_LIST should contain (at least) 3 lisp integers.
1273 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1276 parse_rgb_list (rgb_list
, color
)
1277 Lisp_Object rgb_list
;
1280 #define PARSE_RGB_LIST_FIELD(field) \
1281 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1283 color->field = XINT (XCAR (rgb_list)); \
1284 rgb_list = XCDR (rgb_list); \
1289 PARSE_RGB_LIST_FIELD (red
);
1290 PARSE_RGB_LIST_FIELD (green
);
1291 PARSE_RGB_LIST_FIELD (blue
);
1297 /* Lookup on frame F the color described by the lisp string COLOR.
1298 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1299 non-zero, then the `standard' definition of the same color is
1303 tty_lookup_color (f
, color
, tty_color
, std_color
)
1306 XColor
*tty_color
, *std_color
;
1308 Lisp_Object frame
, color_desc
;
1310 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1313 XSETFRAME (frame
, f
);
1315 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1316 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1320 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1323 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1325 rgb
= XCDR (XCDR (color_desc
));
1326 if (! parse_rgb_list (rgb
, tty_color
))
1329 /* Should we fill in STD_COLOR too? */
1332 /* Default STD_COLOR to the same as TTY_COLOR. */
1333 *std_color
= *tty_color
;
1335 /* Do a quick check to see if the returned descriptor is
1336 actually _exactly_ equal to COLOR, otherwise we have to
1337 lookup STD_COLOR separately. If it's impossible to lookup
1338 a standard color, we just give up and use TTY_COLOR. */
1339 if ((!STRINGP (XCAR (color_desc
))
1340 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1341 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1343 /* Look up STD_COLOR separately. */
1344 rgb
= call1 (Qtty_color_standard_values
, color
);
1345 if (! parse_rgb_list (rgb
, std_color
))
1352 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1353 /* We were called early during startup, and the colors are not
1354 yet set up in tty-defined-color-alist. Don't return a failure
1355 indication, since this produces the annoying "Unable to
1356 load color" messages in the *Messages* buffer. */
1359 /* tty-color-desc seems to have returned a bad value. */
1363 /* A version of defined_color for non-X frames. */
1366 tty_defined_color (f
, color_name
, color_def
, alloc
)
1375 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1377 color_def
->blue
= 0;
1378 color_def
->green
= 0;
1381 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, 0);
1383 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1385 if (strcmp (color_name
, "unspecified-fg") == 0)
1386 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1387 else if (strcmp (color_name
, "unspecified-bg") == 0)
1388 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1391 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1398 /* Decide if color named COLOR_NAME is valid for the display
1399 associated with the frame F; if so, return the rgb values in
1400 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1402 This does the right thing for any type of frame. */
1405 defined_color (f
, color_name
, color_def
, alloc
)
1411 if (!FRAME_WINDOW_P (f
))
1412 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1413 #ifdef HAVE_X_WINDOWS
1414 else if (FRAME_X_P (f
))
1415 return x_defined_color (f
, color_name
, color_def
, alloc
);
1418 else if (FRAME_W32_P (f
))
1419 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1422 else if (FRAME_MAC_P (f
))
1423 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1430 /* Given the index IDX of a tty color on frame F, return its name, a
1434 tty_color_name (f
, idx
)
1438 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1441 Lisp_Object coldesc
;
1443 XSETFRAME (frame
, f
);
1444 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1446 if (!NILP (coldesc
))
1447 return XCAR (coldesc
);
1450 /* We can have an MSDOG frame under -nw for a short window of
1451 opportunity before internal_terminal_init is called. DTRT. */
1452 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1453 return msdos_stdcolor_name (idx
);
1456 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1457 return build_string (unspecified_fg
);
1458 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1459 return build_string (unspecified_bg
);
1462 return vga_stdcolor_name (idx
);
1465 return Qunspecified
;
1469 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1470 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1473 face_color_gray_p (f
, color_name
)
1480 if (defined_color (f
, color_name
, &color
, 0))
1481 gray_p
= ((abs (color
.red
- color
.green
)
1482 < max (color
.red
, color
.green
) / 20)
1483 && (abs (color
.green
- color
.blue
)
1484 < max (color
.green
, color
.blue
) / 20)
1485 && (abs (color
.blue
- color
.red
)
1486 < max (color
.blue
, color
.red
) / 20));
1494 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1495 BACKGROUND_P non-zero means the color will be used as background
1499 face_color_supported_p (f
, color_name
, background_p
)
1507 XSETFRAME (frame
, f
);
1508 return (FRAME_WINDOW_P (f
)
1509 ? (!NILP (Fxw_display_color_p (frame
))
1510 || xstricmp (color_name
, "black") == 0
1511 || xstricmp (color_name
, "white") == 0
1513 && face_color_gray_p (f
, color_name
))
1514 || (!NILP (Fx_display_grayscale_p (frame
))
1515 && face_color_gray_p (f
, color_name
)))
1516 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1520 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1521 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1522 FRAME specifies the frame and thus the display for interpreting COLOR.
1523 If FRAME is nil or omitted, use the selected frame. */)
1525 Lisp_Object color
, frame
;
1529 CHECK_FRAME (frame
);
1530 CHECK_STRING (color
);
1532 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1536 DEFUN ("color-supported-p", Fcolor_supported_p
,
1537 Scolor_supported_p
, 1, 3, 0,
1538 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1539 BACKGROUND-P non-nil means COLOR is used as a background.
1540 If FRAME is nil or omitted, use the selected frame.
1541 COLOR must be a valid color name. */)
1542 (color
, frame
, background_p
)
1543 Lisp_Object frame
, color
, background_p
;
1547 CHECK_FRAME (frame
);
1548 CHECK_STRING (color
);
1550 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1556 /* Load color with name NAME for use by face FACE on frame F.
1557 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1558 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1559 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1560 pixel color. If color cannot be loaded, display a message, and
1561 return the foreground, background or underline color of F, but
1562 record that fact in flags of the face so that we don't try to free
1566 load_color (f
, face
, name
, target_index
)
1570 enum lface_attribute_index target_index
;
1574 xassert (STRINGP (name
));
1575 xassert (target_index
== LFACE_FOREGROUND_INDEX
1576 || target_index
== LFACE_BACKGROUND_INDEX
1577 || target_index
== LFACE_UNDERLINE_INDEX
1578 || target_index
== LFACE_OVERLINE_INDEX
1579 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1580 || target_index
== LFACE_BOX_INDEX
);
1582 /* if the color map is full, defined_color will return a best match
1583 to the values in an existing cell. */
1584 if (!defined_color (f
, SDATA (name
), &color
, 1))
1586 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1588 switch (target_index
)
1590 case LFACE_FOREGROUND_INDEX
:
1591 face
->foreground_defaulted_p
= 1;
1592 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1595 case LFACE_BACKGROUND_INDEX
:
1596 face
->background_defaulted_p
= 1;
1597 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1600 case LFACE_UNDERLINE_INDEX
:
1601 face
->underline_defaulted_p
= 1;
1602 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1605 case LFACE_OVERLINE_INDEX
:
1606 face
->overline_color_defaulted_p
= 1;
1607 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1610 case LFACE_STRIKE_THROUGH_INDEX
:
1611 face
->strike_through_color_defaulted_p
= 1;
1612 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1615 case LFACE_BOX_INDEX
:
1616 face
->box_color_defaulted_p
= 1;
1617 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1626 ++ncolors_allocated
;
1633 #ifdef HAVE_WINDOW_SYSTEM
1635 /* Load colors for face FACE which is used on frame F. Colors are
1636 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1637 of ATTRS. If the background color specified is not supported on F,
1638 try to emulate gray colors with a stipple from Vface_default_stipple. */
1641 load_face_colors (f
, face
, attrs
)
1648 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1649 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1651 /* Swap colors if face is inverse-video. */
1652 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1660 /* Check for support for foreground, not for background because
1661 face_color_supported_p is smart enough to know that grays are
1662 "supported" as background because we are supposed to use stipple
1664 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1665 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1667 x_destroy_bitmap (f
, face
->stipple
);
1668 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1669 &face
->pixmap_w
, &face
->pixmap_h
);
1672 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1673 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1677 /* Free color PIXEL on frame F. */
1680 unload_color (f
, pixel
)
1682 unsigned long pixel
;
1684 #ifdef HAVE_X_WINDOWS
1688 x_free_colors (f
, &pixel
, 1);
1695 /* Free colors allocated for FACE. */
1698 free_face_colors (f
, face
)
1702 #ifdef HAVE_X_WINDOWS
1703 if (face
->colors_copied_bitwise_p
)
1708 if (!face
->foreground_defaulted_p
)
1710 x_free_colors (f
, &face
->foreground
, 1);
1711 IF_DEBUG (--ncolors_allocated
);
1714 if (!face
->background_defaulted_p
)
1716 x_free_colors (f
, &face
->background
, 1);
1717 IF_DEBUG (--ncolors_allocated
);
1720 if (face
->underline_p
1721 && !face
->underline_defaulted_p
)
1723 x_free_colors (f
, &face
->underline_color
, 1);
1724 IF_DEBUG (--ncolors_allocated
);
1727 if (face
->overline_p
1728 && !face
->overline_color_defaulted_p
)
1730 x_free_colors (f
, &face
->overline_color
, 1);
1731 IF_DEBUG (--ncolors_allocated
);
1734 if (face
->strike_through_p
1735 && !face
->strike_through_color_defaulted_p
)
1737 x_free_colors (f
, &face
->strike_through_color
, 1);
1738 IF_DEBUG (--ncolors_allocated
);
1741 if (face
->box
!= FACE_NO_BOX
1742 && !face
->box_color_defaulted_p
)
1744 x_free_colors (f
, &face
->box_color
, 1);
1745 IF_DEBUG (--ncolors_allocated
);
1749 #endif /* HAVE_X_WINDOWS */
1752 #endif /* HAVE_WINDOW_SYSTEM */
1756 /***********************************************************************
1758 ***********************************************************************/
1760 /* An enumerator for each field of an XLFD font name. */
1781 /* An enumerator for each possible slant value of a font. Taken from
1782 the XLFD specification. */
1790 XLFD_SLANT_REVERSE_ITALIC
,
1791 XLFD_SLANT_REVERSE_OBLIQUE
,
1795 /* Relative font weight according to XLFD documentation. */
1799 XLFD_WEIGHT_UNKNOWN
,
1800 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1801 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1802 XLFD_WEIGHT_LIGHT
, /* 30 */
1803 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1804 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1805 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1806 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1807 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1808 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1811 /* Relative proportionate width. */
1815 XLFD_SWIDTH_UNKNOWN
,
1816 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1817 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1818 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1819 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1820 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1821 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1822 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1823 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1824 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1827 /* Structure used for tables mapping XLFD weight, slant, and width
1828 names to numeric and symbolic values. */
1834 Lisp_Object
*symbol
;
1837 /* Table of XLFD slant names and their numeric and symbolic
1838 representations. This table must be sorted by slant names in
1841 static struct table_entry slant_table
[] =
1843 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1844 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1845 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1846 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1847 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1848 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1851 /* Table of XLFD weight names. This table must be sorted by weight
1852 names in ascending order. */
1854 static struct table_entry weight_table
[] =
1856 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1857 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1858 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1859 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1860 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1861 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1862 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1863 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1864 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1865 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1866 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1867 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1868 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1869 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1870 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1871 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1874 /* Table of XLFD width names. This table must be sorted by width
1875 names in ascending order. */
1877 static struct table_entry swidth_table
[] =
1879 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1880 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1881 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1882 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1883 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1884 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1885 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1886 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1887 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1888 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1889 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1890 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1891 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1892 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1893 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1896 /* Structure used to hold the result of splitting font names in XLFD
1897 format into their fields. */
1901 /* The original name which is modified destructively by
1902 split_font_name. The pointer is kept here to be able to free it
1903 if it was allocated from the heap. */
1906 /* Font name fields. Each vector element points into `name' above.
1907 Fields are NUL-terminated. */
1908 char *fields
[XLFD_LAST
];
1910 /* Numeric values for those fields that interest us. See
1911 split_font_name for which these are. */
1912 int numeric
[XLFD_LAST
];
1914 /* If the original name matches one of Vface_font_rescale_alist,
1915 the value is the corresponding rescale ratio. Otherwise, the
1917 double rescale_ratio
;
1919 /* Lower value mean higher priority. */
1920 int registry_priority
;
1923 /* The frame in effect when sorting font names. Set temporarily in
1924 sort_fonts so that it is available in font comparison functions. */
1926 static struct frame
*font_frame
;
1928 /* Order by which font selection chooses fonts. The default values
1929 mean `first, find a best match for the font width, then for the
1930 font height, then for weight, then for slant.' This variable can be
1931 set via set-face-font-sort-order. */
1934 static int font_sort_order
[4] = {
1935 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1938 static int font_sort_order
[4];
1941 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1942 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1943 is a pointer to the matching table entry or null if no table entry
1946 static struct table_entry
*
1947 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1948 struct table_entry
*table
;
1950 struct font_name
*font
;
1953 /* Function split_font_name converts fields to lower-case, so there
1954 is no need to use xstrlwr or xstricmp here. */
1955 char *s
= font
->fields
[field_index
];
1956 int low
, mid
, high
, cmp
;
1963 mid
= (low
+ high
) / 2;
1964 cmp
= strcmp (table
[mid
].name
, s
);
1978 /* Return a numeric representation for font name field
1979 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1980 has DIM entries. Value is the numeric value found or DFLT if no
1981 table entry matches. This function is used to translate weight,
1982 slant, and swidth names of XLFD font names to numeric values. */
1985 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1986 struct table_entry
*table
;
1988 struct font_name
*font
;
1992 struct table_entry
*p
;
1993 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1994 return p
? p
->numeric
: dflt
;
1998 /* Return a symbolic representation for font name field
1999 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2000 has DIM entries. Value is the symbolic value found or DFLT if no
2001 table entry matches. This function is used to translate weight,
2002 slant, and swidth names of XLFD font names to symbols. */
2004 static INLINE Lisp_Object
2005 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2006 struct table_entry
*table
;
2008 struct font_name
*font
;
2012 struct table_entry
*p
;
2013 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2014 return p
? *p
->symbol
: dflt
;
2018 /* Return a numeric value for the slant of the font given by FONT. */
2021 xlfd_numeric_slant (font
)
2022 struct font_name
*font
;
2024 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2025 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2029 /* Return a symbol representing the weight of the font given by FONT. */
2031 static INLINE Lisp_Object
2032 xlfd_symbolic_slant (font
)
2033 struct font_name
*font
;
2035 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2036 font
, XLFD_SLANT
, Qnormal
);
2040 /* Return a numeric value for the weight of the font given by FONT. */
2043 xlfd_numeric_weight (font
)
2044 struct font_name
*font
;
2046 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2047 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2051 /* Return a symbol representing the slant of the font given by FONT. */
2053 static INLINE Lisp_Object
2054 xlfd_symbolic_weight (font
)
2055 struct font_name
*font
;
2057 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2058 font
, XLFD_WEIGHT
, Qnormal
);
2062 /* Return a numeric value for the swidth of the font whose XLFD font
2063 name fields are found in FONT. */
2066 xlfd_numeric_swidth (font
)
2067 struct font_name
*font
;
2069 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2070 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2074 /* Return a symbolic value for the swidth of FONT. */
2076 static INLINE Lisp_Object
2077 xlfd_symbolic_swidth (font
)
2078 struct font_name
*font
;
2080 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2081 font
, XLFD_SWIDTH
, Qnormal
);
2085 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2086 entries. Value is a pointer to the matching table entry or null if
2087 no element of TABLE contains SYMBOL. */
2089 static struct table_entry
*
2090 face_value (table
, dim
, symbol
)
2091 struct table_entry
*table
;
2097 xassert (SYMBOLP (symbol
));
2099 for (i
= 0; i
< dim
; ++i
)
2100 if (EQ (*table
[i
].symbol
, symbol
))
2103 return i
< dim
? table
+ i
: NULL
;
2107 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2108 entries. Value is -1 if SYMBOL is not found in TABLE. */
2111 face_numeric_value (table
, dim
, symbol
)
2112 struct table_entry
*table
;
2116 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2117 return p
? p
->numeric
: -1;
2121 /* Return a numeric value representing the weight specified by Lisp
2122 symbol WEIGHT. Value is one of the enumerators of enum
2126 face_numeric_weight (weight
)
2129 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2133 /* Return a numeric value representing the slant specified by Lisp
2134 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2137 face_numeric_slant (slant
)
2140 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2144 /* Return a numeric value representing the swidth specified by Lisp
2145 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2148 face_numeric_swidth (width
)
2151 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2155 #ifdef HAVE_WINDOW_SYSTEM
2157 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2161 struct font_name
*font
;
2163 /* Function split_font_name converts fields to lower-case, so there
2164 is no need to use tolower here. */
2165 return *font
->fields
[XLFD_SPACING
] != 'p';
2169 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2171 The actual height of the font when displayed on F depends on the
2172 resolution of both the font and frame. For example, a 10pt font
2173 designed for a 100dpi display will display larger than 10pt on a
2174 75dpi display. (It's not unusual to use fonts not designed for the
2175 display one is using. For example, some intlfonts are available in
2176 72dpi versions, only.)
2178 Value is the real point size of FONT on frame F, or 0 if it cannot
2182 xlfd_point_size (f
, font
)
2184 struct font_name
*font
;
2186 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2187 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2191 if (*pixel_field
== '[')
2193 /* The pixel size field is `[A B C D]' which specifies
2194 a transformation matrix.
2200 by which all glyphs of the font are transformed. The spec
2201 says that s scalar value N for the pixel size is equivalent
2202 to A = N * resx/resy, B = C = 0, D = N. */
2203 char *start
= pixel_field
+ 1, *end
;
2207 for (i
= 0; i
< 4; ++i
)
2209 matrix
[i
] = strtod (start
, &end
);
2216 pixel
= atoi (pixel_field
);
2221 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2227 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2228 of frame F. This function is used to guess a point size of font
2229 when only the pixel height of the font is available. */
2232 pixel_point_size (f
, pixel
)
2236 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2240 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2241 point size of one dot. */
2242 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2243 int_pt
= real_pt
+ 0.5;
2249 /* Return a rescaling ratio of a font of NAME. */
2252 font_rescale_ratio (name
)
2255 Lisp_Object tail
, elt
;
2257 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2260 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2261 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2262 return XFLOAT_DATA (XCDR (elt
));
2268 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2269 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2270 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2271 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2272 zero if the font name doesn't have the format we expect. The
2273 expected format is a font name that starts with a `-' and has
2274 XLFD_LAST fields separated by `-'. */
2277 split_font_name (f
, font
, numeric_p
)
2279 struct font_name
*font
;
2284 double rescale_ratio
;
2287 /* This must be done before splitting the font name. */
2288 rescale_ratio
= font_rescale_ratio (font
->name
);
2290 if (*font
->name
== '-')
2292 char *p
= xstrlwr (font
->name
) + 1;
2294 while (i
< XLFD_LAST
)
2296 font
->fields
[i
] = p
;
2299 /* Pixel and point size may be of the form `[....]'. For
2300 BNF, see XLFD spec, chapter 4. Negative values are
2301 indicated by tilde characters which we replace with
2302 `-' characters, here. */
2304 && (i
- 1 == XLFD_PIXEL_SIZE
2305 || i
- 1 == XLFD_POINT_SIZE
))
2310 for (++p
; *p
&& *p
!= ']'; ++p
)
2314 /* Check that the matrix contains 4 floating point
2316 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2319 if (strtod (start
, &end
) == 0 && start
== end
)
2326 while (*p
&& *p
!= '-')
2336 success_p
= i
== XLFD_LAST
;
2338 /* If requested, and font name was in the expected format,
2339 compute numeric values for some fields. */
2340 if (numeric_p
&& success_p
)
2342 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2343 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2344 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2345 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2346 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2347 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2348 font
->rescale_ratio
= rescale_ratio
;
2351 /* Initialize it to zero. It will be overridden by font_list while
2352 trying alternate registries. */
2353 font
->registry_priority
= 0;
2359 /* Build an XLFD font name from font name fields in FONT. Value is a
2360 pointer to the font name, which is allocated via xmalloc. */
2363 build_font_name (font
)
2364 struct font_name
*font
;
2368 char *font_name
= (char *) xmalloc (size
);
2369 int total_length
= 0;
2371 for (i
= 0; i
< XLFD_LAST
; ++i
)
2373 /* Add 1 because of the leading `-'. */
2374 int len
= strlen (font
->fields
[i
]) + 1;
2376 /* Reallocate font_name if necessary. Add 1 for the final
2378 if (total_length
+ len
+ 1 >= size
)
2380 int new_size
= max (2 * size
, size
+ len
+ 1);
2381 int sz
= new_size
* sizeof *font_name
;
2382 font_name
= (char *) xrealloc (font_name
, sz
);
2386 font_name
[total_length
] = '-';
2387 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2388 total_length
+= len
;
2391 font_name
[total_length
] = 0;
2396 /* Free an array FONTS of N font_name structures. This frees FONTS
2397 itself and all `name' fields in its elements. */
2400 free_font_names (fonts
, n
)
2401 struct font_name
*fonts
;
2405 xfree (fonts
[--n
].name
);
2410 /* Sort vector FONTS of font_name structures which contains NFONTS
2411 elements using qsort and comparison function CMPFN. F is the frame
2412 on which the fonts will be used. The global variable font_frame
2413 is temporarily set to F to make it available in CMPFN. */
2416 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2418 struct font_name
*fonts
;
2420 int (*cmpfn
) P_ ((const void *, const void *));
2423 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2428 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2429 display in x_display_list. FONTS is a pointer to a vector of
2430 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2431 alternative patterns from Valternate_fontname_alist if no fonts are
2432 found matching PATTERN.
2434 For all fonts found, set FONTS[i].name to the name of the font,
2435 allocated via xmalloc, and split font names into fields. Ignore
2436 fonts that we can't parse. Value is the number of fonts found. */
2439 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2442 struct font_name
**pfonts
;
2443 int nfonts
, try_alternatives_p
;
2447 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2448 better to do it the other way around. */
2450 Lisp_Object lpattern
, tem
;
2451 struct font_name
*fonts
= 0;
2452 int num_fonts
= nfonts
;
2455 lpattern
= build_string (pattern
);
2457 /* Get the list of fonts matching PATTERN. */
2460 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2463 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2466 if (nfonts
< 0 && CONSP (lfonts
))
2467 num_fonts
= XFASTINT (Flength (lfonts
));
2469 /* Make a copy of the font names we got from X, and
2470 split them into fields. */
2472 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2474 Lisp_Object elt
, tail
;
2475 const char *name
= SDATA (XCAR (tem
));
2477 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2478 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2482 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2493 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2497 /* Make a copy of the font name. */
2498 fonts
[n
].name
= xstrdup (name
);
2500 if (split_font_name (f
, fonts
+ n
, 1))
2502 if (font_scalable_p (fonts
+ n
)
2503 && !may_use_scalable_font_p (name
))
2506 xfree (fonts
[n
].name
);
2512 xfree (fonts
[n
].name
);
2515 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2516 if (n
== 0 && try_alternatives_p
)
2518 Lisp_Object list
= Valternate_fontname_alist
;
2526 while (CONSP (list
))
2528 Lisp_Object entry
= XCAR (list
);
2530 && STRINGP (XCAR (entry
))
2531 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2538 Lisp_Object patterns
= XCAR (list
);
2541 while (CONSP (patterns
)
2542 /* If list is screwed up, give up. */
2543 && (name
= XCAR (patterns
),
2545 /* Ignore patterns equal to PATTERN because we tried that
2546 already with no success. */
2547 && (strcmp (SDATA (name
), pattern
) == 0
2548 || (n
= x_face_list_fonts (f
, SDATA (name
),
2551 patterns
= XCDR (patterns
);
2559 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2560 using comparison function CMPFN. Value is the number of fonts
2561 found. If value is non-zero, *FONTS is set to a vector of
2562 font_name structures allocated from the heap containing matching
2563 fonts. Each element of *FONTS contains a name member that is also
2564 allocated from the heap. Font names in these structures are split
2565 into fields. Use free_font_names to free such an array. */
2568 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2571 int (*cmpfn
) P_ ((const void *, const void *));
2572 struct font_name
**fonts
;
2576 /* Get the list of fonts matching pattern. 100 should suffice. */
2577 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2578 if (INTEGERP (Vfont_list_limit
))
2579 nfonts
= XINT (Vfont_list_limit
);
2582 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2584 /* Sort the resulting array and return it in *FONTS. If no
2585 fonts were found, make sure to set *FONTS to null. */
2587 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2598 /* Compare two font_name structures *A and *B. Value is analogous to
2599 strcmp. Sort order is given by the global variable
2600 font_sort_order. Font names are sorted so that, everything else
2601 being equal, fonts with a resolution closer to that of the frame on
2602 which they are used are listed first. The global variable
2603 font_frame is the frame on which we operate. */
2606 cmp_font_names (a
, b
)
2609 struct font_name
*x
= (struct font_name
*) a
;
2610 struct font_name
*y
= (struct font_name
*) b
;
2613 /* All strings have been converted to lower-case by split_font_name,
2614 so we can use strcmp here. */
2615 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2620 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2622 int j
= font_sort_order
[i
];
2623 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2628 /* Everything else being equal, we prefer fonts with an
2629 y-resolution closer to that of the frame. */
2630 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2631 int x_resy
= x
->numeric
[XLFD_RESY
];
2632 int y_resy
= y
->numeric
[XLFD_RESY
];
2633 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2641 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2642 is non-nil list fonts matching that pattern. Otherwise, if
2643 REGISTRY is non-nil return only fonts with that registry, otherwise
2644 return fonts of any registry. Set *FONTS to a vector of font_name
2645 structures allocated from the heap containing the fonts found.
2646 Value is the number of fonts found. */
2649 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2651 Lisp_Object pattern
, family
, registry
;
2652 struct font_name
**fonts
;
2654 char *pattern_str
, *family_str
, *registry_str
;
2658 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2659 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2661 pattern_str
= (char *) alloca (strlen (family_str
)
2662 + strlen (registry_str
)
2664 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2665 strcat (pattern_str
, family_str
);
2666 strcat (pattern_str
, "-*-");
2667 strcat (pattern_str
, registry_str
);
2668 if (!index (registry_str
, '-'))
2670 if (registry_str
[strlen (registry_str
) - 1] == '*')
2671 strcat (pattern_str
, "-*");
2673 strcat (pattern_str
, "*-*");
2677 pattern_str
= (char *) SDATA (pattern
);
2679 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2683 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2684 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2685 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2688 static struct font_name
*
2689 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2690 struct font_name
*fonts1
, *fonts2
;
2691 int nfonts1
, nfonts2
;
2693 int new_nfonts
= nfonts1
+ nfonts2
;
2694 struct font_name
*new_fonts
;
2696 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2697 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2698 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2705 /* Get a sorted list of fonts of family FAMILY on frame F.
2707 If PATTERN is non-nil list fonts matching that pattern.
2709 If REGISTRY is non-nil, return fonts with that registry and the
2710 alternative registries from Vface_alternative_font_registry_alist.
2712 If REGISTRY is nil return fonts of any registry.
2714 Set *FONTS to a vector of font_name structures allocated from the
2715 heap containing the fonts found. Value is the number of fonts
2719 font_list (f
, pattern
, family
, registry
, fonts
)
2721 Lisp_Object pattern
, family
, registry
;
2722 struct font_name
**fonts
;
2724 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2726 if (!NILP (registry
)
2727 && CONSP (Vface_alternative_font_registry_alist
))
2731 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2736 for (alter
= XCDR (alter
), reg_prio
= 1;
2738 alter
= XCDR (alter
), reg_prio
++)
2739 if (STRINGP (XCAR (alter
)))
2742 struct font_name
*fonts2
;
2744 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2746 for (i
= 0; i
< nfonts2
; i
++)
2747 fonts2
[i
].registry_priority
= reg_prio
;
2748 *fonts
= (nfonts
> 0
2749 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2760 /* Remove elements from LIST whose cars are `equal'. Called from
2761 x-family-fonts and x-font-family-list to remove duplicate font
2765 remove_duplicates (list
)
2768 Lisp_Object tail
= list
;
2770 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2772 Lisp_Object next
= XCDR (tail
);
2773 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2774 XSETCDR (tail
, XCDR (next
));
2781 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2782 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2783 If FAMILY is omitted or nil, list all families.
2784 Otherwise, FAMILY must be a string, possibly containing wildcards
2786 If FRAME is omitted or nil, use the selected frame.
2787 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2788 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2789 FAMILY is the font family name. POINT-SIZE is the size of the
2790 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2791 width, weight and slant of the font. These symbols are the same as for
2792 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2793 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2794 giving the registry and encoding of the font.
2795 The result list is sorted according to the current setting of
2796 the face font sort order. */)
2798 Lisp_Object family
, frame
;
2800 struct frame
*f
= check_x_frame (frame
);
2801 struct font_name
*fonts
;
2804 struct gcpro gcpro1
;
2807 CHECK_STRING (family
);
2811 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2812 for (i
= nfonts
- 1; i
>= 0; --i
)
2814 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2817 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2818 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2819 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2820 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2821 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2822 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2823 tem
= build_font_name (fonts
+ i
);
2824 ASET (v
, 6, build_string (tem
));
2825 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2826 fonts
[i
].fields
[XLFD_ENCODING
]);
2827 ASET (v
, 7, build_string (tem
));
2830 result
= Fcons (v
, result
);
2833 remove_duplicates (result
);
2834 free_font_names (fonts
, nfonts
);
2840 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2842 doc
: /* Return a list of available font families on FRAME.
2843 If FRAME is omitted or nil, use the selected frame.
2844 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2845 is a font family, and FIXED-P is non-nil if fonts of that family
2846 are fixed-pitch. */)
2850 struct frame
*f
= check_x_frame (frame
);
2852 struct font_name
*fonts
;
2854 struct gcpro gcpro1
;
2855 int count
= SPECPDL_INDEX ();
2857 /* Let's consider all fonts. */
2858 specbind (intern ("font-list-limit"), make_number (-1));
2859 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2863 for (i
= nfonts
- 1; i
>= 0; --i
)
2864 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2865 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2868 remove_duplicates (result
);
2869 free_font_names (fonts
, nfonts
);
2871 return unbind_to (count
, result
);
2875 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2876 doc
: /* Return a list of the names of available fonts matching PATTERN.
2877 If optional arguments FACE and FRAME are specified, return only fonts
2878 the same size as FACE on FRAME.
2879 PATTERN is a string, perhaps with wildcard characters;
2880 the * character matches any substring, and
2881 the ? character matches any single character.
2882 PATTERN is case-insensitive.
2883 FACE is a face name--a symbol.
2885 The return value is a list of strings, suitable as arguments to
2888 Fonts Emacs can't use may or may not be excluded
2889 even if they match PATTERN and FACE.
2890 The optional fourth argument MAXIMUM sets a limit on how many
2891 fonts to match. The first MAXIMUM fonts are reported.
2892 The optional fifth argument WIDTH, if specified, is a number of columns
2893 occupied by a character of a font. In that case, return only fonts
2894 the WIDTH times as wide as FACE on FRAME. */)
2895 (pattern
, face
, frame
, maximum
, width
)
2896 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2903 CHECK_STRING (pattern
);
2909 CHECK_NATNUM (maximum
);
2910 maxnames
= XINT (maximum
);
2914 CHECK_NUMBER (width
);
2916 /* We can't simply call check_x_frame because this function may be
2917 called before any frame is created. */
2918 f
= frame_or_selected_frame (frame
, 2);
2919 if (!FRAME_WINDOW_P (f
))
2921 /* Perhaps we have not yet created any frame. */
2926 /* Determine the width standard for comparison with the fonts we find. */
2932 /* This is of limited utility since it works with character
2933 widths. Keep it for compatibility. --gerd. */
2934 int face_id
= lookup_named_face (f
, face
, 0);
2935 struct face
*face
= (face_id
< 0
2937 : FACE_FROM_ID (f
, face_id
));
2940 /* For historic reasons, FONT_WIDTH refers to average width on W32,
2941 not maximum as on X. Redefine here. */
2943 #define FONT_WIDTH FONT_MAX_WIDTH
2946 if (face
&& face
->font
)
2947 size
= FONT_WIDTH (face
->font
);
2949 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
2952 size
*= XINT (width
);
2956 Lisp_Object args
[2];
2958 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2960 /* We don't have to check fontsets. */
2962 args
[1] = list_fontsets (f
, pattern
, size
);
2963 return Fnconc (2, args
);
2967 #endif /* HAVE_WINDOW_SYSTEM */
2971 /***********************************************************************
2973 ***********************************************************************/
2975 /* Access face attributes of face LFACE, a Lisp vector. */
2977 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2978 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2979 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2980 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2981 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2982 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2983 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2984 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2985 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2986 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2987 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2988 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2989 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2990 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2991 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2992 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2994 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2995 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2997 #define LFACEP(LFACE) \
2999 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3000 && EQ (AREF (LFACE, 0), Qface))
3005 /* Check consistency of Lisp face attribute vector ATTRS. */
3008 check_lface_attrs (attrs
)
3011 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3012 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3013 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3014 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3015 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3016 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3017 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3018 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3019 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3020 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3021 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3022 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3023 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3024 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3025 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3026 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3027 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3028 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3029 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3030 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3031 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3032 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3033 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3034 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3035 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3036 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3037 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3038 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3039 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3040 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3041 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3042 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3043 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3044 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3045 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3046 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3047 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3048 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3049 #ifdef HAVE_WINDOW_SYSTEM
3050 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3051 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3052 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3053 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3054 || NILP (attrs
[LFACE_FONT_INDEX
])
3055 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3060 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3068 xassert (LFACEP (lface
));
3069 check_lface_attrs (XVECTOR (lface
)->contents
);
3073 #else /* GLYPH_DEBUG == 0 */
3075 #define check_lface_attrs(attrs) (void) 0
3076 #define check_lface(lface) (void) 0
3078 #endif /* GLYPH_DEBUG == 0 */
3081 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3082 to make it a symvol. If FACE_NAME is an alias for another face,
3083 return that face's name. */
3086 resolve_face_name (face_name
)
3087 Lisp_Object face_name
;
3089 Lisp_Object aliased
;
3091 if (STRINGP (face_name
))
3092 face_name
= intern (SDATA (face_name
));
3094 while (SYMBOLP (face_name
))
3096 aliased
= Fget (face_name
, Qface_alias
);
3100 face_name
= aliased
;
3107 /* Return the face definition of FACE_NAME on frame F. F null means
3108 return the definition for new frames. FACE_NAME may be a string or
3109 a symbol (apparently Emacs 20.2 allowed strings as face names in
3110 face text properties; Ediff uses that). If FACE_NAME is an alias
3111 for another face, return that face's definition. If SIGNAL_P is
3112 non-zero, signal an error if FACE_NAME is not a valid face name.
3113 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3116 static INLINE Lisp_Object
3117 lface_from_face_name (f
, face_name
, signal_p
)
3119 Lisp_Object face_name
;
3124 face_name
= resolve_face_name (face_name
);
3127 lface
= assq_no_quit (face_name
, f
->face_alist
);
3129 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3132 lface
= XCDR (lface
);
3134 signal_error ("Invalid face", face_name
);
3136 check_lface (lface
);
3141 /* Get face attributes of face FACE_NAME from frame-local faces on
3142 frame F. Store the resulting attributes in ATTRS which must point
3143 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3144 is non-zero, signal an error if FACE_NAME does not name a face.
3145 Otherwise, value is zero if FACE_NAME is not a face. */
3148 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3150 Lisp_Object face_name
;
3157 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3160 bcopy (XVECTOR (lface
)->contents
, attrs
,
3161 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3171 /* Non-zero if all attributes in face attribute vector ATTRS are
3172 specified, i.e. are non-nil. */
3175 lface_fully_specified_p (attrs
)
3180 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3181 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3182 && i
!= LFACE_AVGWIDTH_INDEX
)
3183 if (UNSPECIFIEDP (attrs
[i
]))
3186 return i
== LFACE_VECTOR_SIZE
;
3189 #ifdef HAVE_WINDOW_SYSTEM
3191 /* Set font-related attributes of Lisp face LFACE from the fullname of
3192 the font opened by FONTNAME. If FORCE_P is zero, set only
3193 unspecified attributes of LFACE. The exception is `font'
3194 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3196 If FONTNAME is not available on frame F,
3197 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3198 If the fullname is not in a valid XLFD format,
3199 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3200 in LFACE and return 1.
3201 Otherwise, return 1. */
3204 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3207 Lisp_Object fontname
;
3208 int force_p
, may_fail_p
;
3210 struct font_name font
;
3215 char *font_name
= SDATA (fontname
);
3216 struct font_info
*font_info
;
3218 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3219 fontset
= fs_query_fontset (fontname
, 0);
3221 font_name
= SDATA (fontset_ascii (fontset
));
3223 /* Check if FONT_NAME is surely available on the system. Usually
3224 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3225 returns quickly. But, even if FONT_NAME is not yet cached,
3226 caching it now is not futail because we anyway load the font
3229 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3239 font
.name
= STRDUPA (font_info
->full_name
);
3240 have_xlfd_p
= split_font_name (f
, &font
, 1);
3242 /* Set attributes only if unspecified, otherwise face defaults for
3243 new frames would never take effect. If we couldn't get a font
3244 name conforming to XLFD, set normal values. */
3246 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3251 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3252 + strlen (font
.fields
[XLFD_FOUNDRY
])
3254 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3255 font
.fields
[XLFD_FAMILY
]);
3256 val
= build_string (buffer
);
3259 val
= build_string ("*");
3260 LFACE_FAMILY (lface
) = val
;
3263 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3266 pt
= xlfd_point_size (f
, &font
);
3268 pt
= pixel_point_size (f
, font_info
->height
* 10);
3270 LFACE_HEIGHT (lface
) = make_number (pt
);
3273 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3274 LFACE_SWIDTH (lface
)
3275 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3277 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3278 LFACE_AVGWIDTH (lface
)
3280 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3283 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3284 LFACE_WEIGHT (lface
)
3285 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3287 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3289 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3291 LFACE_FONT (lface
) = fontname
;
3296 #endif /* HAVE_WINDOW_SYSTEM */
3299 /* Merges the face height FROM with the face height TO, and returns the
3300 merged height. If FROM is an invalid height, then INVALID is
3301 returned instead. FROM and TO may be either absolute face heights or
3302 `relative' heights; the returned value is always an absolute height
3303 unless both FROM and TO are relative. GCPRO is a lisp value that
3304 will be protected from garbage-collection if this function makes a
3308 merge_face_heights (from
, to
, invalid
, gcpro
)
3309 Lisp_Object from
, to
, invalid
, gcpro
;
3311 Lisp_Object result
= invalid
;
3313 if (INTEGERP (from
))
3314 /* FROM is absolute, just use it as is. */
3316 else if (FLOATP (from
))
3317 /* FROM is a scale, use it to adjust TO. */
3320 /* relative X absolute => absolute */
3321 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3322 else if (FLOATP (to
))
3323 /* relative X relative => relative */
3324 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3326 else if (FUNCTIONP (from
))
3327 /* FROM is a function, which use to adjust TO. */
3329 /* Call function with current height as argument.
3330 From is the new height. */
3331 Lisp_Object args
[2];
3332 struct gcpro gcpro1
;
3338 result
= safe_call (2, args
);
3342 /* Ensure that if TO was absolute, so is the result. */
3343 if (INTEGERP (to
) && !INTEGERP (result
))
3351 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3352 store the resulting attributes in TO, which must be already be
3353 completely specified and contain only absolute attributes. Every
3354 specified attribute of FROM overrides the corresponding attribute of
3355 TO; relative attributes in FROM are merged with the absolute value in
3356 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3357 face inheritance; it should be Qnil when called from other places. */
3360 merge_face_vectors (f
, from
, to
, cycle_check
)
3362 Lisp_Object
*from
, *to
;
3363 Lisp_Object cycle_check
;
3367 /* If FROM inherits from some other faces, merge their attributes into
3368 TO before merging FROM's direct attributes. Note that an :inherit
3369 attribute of `unspecified' is the same as one of nil; we never
3370 merge :inherit attributes, so nil is more correct, but lots of
3371 other code uses `unspecified' as a generic value for face attributes. */
3372 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3373 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3374 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3376 /* If TO specifies a :font attribute, and FROM specifies some
3377 font-related attribute, we need to clear TO's :font attribute
3378 (because it will be inconsistent with whatever FROM specifies, and
3379 FROM takes precedence). */
3380 if (!NILP (to
[LFACE_FONT_INDEX
])
3381 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3382 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3383 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3384 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3385 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3386 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3387 to
[LFACE_FONT_INDEX
] = Qnil
;
3389 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3390 if (!UNSPECIFIEDP (from
[i
]))
3392 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3393 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3398 /* TO is always an absolute face, which should inherit from nothing.
3399 We blindly copy the :inherit attribute above and fix it up here. */
3400 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3404 /* Checks the `cycle check' variable CHECK to see if it indicates that
3405 EL is part of a cycle; CHECK must be either Qnil or a value returned
3406 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3407 elements after which a cycle might be suspected; after that many
3408 elements, this macro begins consing in order to keep more precise
3411 Returns nil if a cycle was detected, otherwise a new value for CHECK
3414 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3415 the caller should make sure that's ok. */
3417 #define CYCLE_CHECK(check, el, suspicious) \
3420 : (INTEGERP (check) \
3421 ? (XFASTINT (check) < (suspicious) \
3422 ? make_number (XFASTINT (check) + 1) \
3423 : Fcons (el, Qnil)) \
3424 : (!NILP (Fmemq ((el), (check))) \
3426 : Fcons ((el), (check)))))
3429 /* Merge face attributes from the face on frame F whose name is
3430 INHERITS, into the vector of face attributes TO; INHERITS may also be
3431 a list of face names, in which case they are applied in order.
3432 CYCLE_CHECK is used to detect loops in face inheritance.
3433 Returns true if any of the inherited attributes are `font-related'. */
3436 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3438 Lisp_Object inherit
;
3440 Lisp_Object cycle_check
;
3442 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3443 /* Inherit from the named face INHERIT. */
3447 /* Make sure we're not in an inheritance loop. */
3448 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3449 if (NILP (cycle_check
))
3450 /* Cycle detected, ignore any further inheritance. */
3453 lface
= lface_from_face_name (f
, inherit
, 0);
3455 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3457 else if (CONSP (inherit
))
3458 /* Handle a list of inherited faces by calling ourselves recursively
3459 on each element. Note that we only do so for symbol elements, so
3460 it's not possible to infinitely recurse. */
3462 while (CONSP (inherit
))
3464 if (SYMBOLP (XCAR (inherit
)))
3465 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3467 /* Check for a circular inheritance list. */
3468 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3469 if (NILP (cycle_check
))
3470 /* Cycle detected. */
3473 inherit
= XCDR (inherit
);
3479 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3480 is a face property, determine the resulting face attributes on
3481 frame F, and store them in TO. PROP may be a single face
3482 specification or a list of such specifications. Each face
3483 specification can be
3485 1. A symbol or string naming a Lisp face.
3487 2. A property list of the form (KEYWORD VALUE ...) where each
3488 KEYWORD is a face attribute name, and value is an appropriate value
3491 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3492 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3493 for compatibility with 20.2.
3495 Face specifications earlier in lists take precedence over later
3499 merge_face_vector_with_property (f
, to
, prop
)
3506 Lisp_Object first
= XCAR (prop
);
3508 if (EQ (first
, Qforeground_color
)
3509 || EQ (first
, Qbackground_color
))
3511 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3512 . COLOR). COLOR must be a string. */
3513 Lisp_Object color_name
= XCDR (prop
);
3514 Lisp_Object color
= first
;
3516 if (STRINGP (color_name
))
3518 if (EQ (color
, Qforeground_color
))
3519 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3521 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3524 add_to_log ("Invalid face color", color_name
, Qnil
);
3526 else if (SYMBOLP (first
)
3527 && *SDATA (SYMBOL_NAME (first
)) == ':')
3529 /* Assume this is the property list form. */
3530 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3532 Lisp_Object keyword
= XCAR (prop
);
3533 Lisp_Object value
= XCAR (XCDR (prop
));
3535 if (EQ (keyword
, QCfamily
))
3537 if (STRINGP (value
))
3538 to
[LFACE_FAMILY_INDEX
] = value
;
3540 add_to_log ("Invalid face font family", value
, Qnil
);
3542 else if (EQ (keyword
, QCheight
))
3544 Lisp_Object new_height
=
3545 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3548 if (NILP (new_height
))
3549 add_to_log ("Invalid face font height", value
, Qnil
);
3551 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3553 else if (EQ (keyword
, QCweight
))
3556 && face_numeric_weight (value
) >= 0)
3557 to
[LFACE_WEIGHT_INDEX
] = value
;
3559 add_to_log ("Invalid face weight", value
, Qnil
);
3561 else if (EQ (keyword
, QCslant
))
3564 && face_numeric_slant (value
) >= 0)
3565 to
[LFACE_SLANT_INDEX
] = value
;
3567 add_to_log ("Invalid face slant", value
, Qnil
);
3569 else if (EQ (keyword
, QCunderline
))
3574 to
[LFACE_UNDERLINE_INDEX
] = value
;
3576 add_to_log ("Invalid face underline", value
, Qnil
);
3578 else if (EQ (keyword
, QCoverline
))
3583 to
[LFACE_OVERLINE_INDEX
] = value
;
3585 add_to_log ("Invalid face overline", value
, Qnil
);
3587 else if (EQ (keyword
, QCstrike_through
))
3592 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3594 add_to_log ("Invalid face strike-through", value
, Qnil
);
3596 else if (EQ (keyword
, QCbox
))
3599 value
= make_number (1);
3600 if (INTEGERP (value
)
3604 to
[LFACE_BOX_INDEX
] = value
;
3606 add_to_log ("Invalid face box", value
, Qnil
);
3608 else if (EQ (keyword
, QCinverse_video
)
3609 || EQ (keyword
, QCreverse_video
))
3611 if (EQ (value
, Qt
) || NILP (value
))
3612 to
[LFACE_INVERSE_INDEX
] = value
;
3614 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3616 else if (EQ (keyword
, QCforeground
))
3618 if (STRINGP (value
))
3619 to
[LFACE_FOREGROUND_INDEX
] = value
;
3621 add_to_log ("Invalid face foreground", value
, Qnil
);
3623 else if (EQ (keyword
, QCbackground
))
3625 if (STRINGP (value
))
3626 to
[LFACE_BACKGROUND_INDEX
] = value
;
3628 add_to_log ("Invalid face background", value
, Qnil
);
3630 else if (EQ (keyword
, QCstipple
))
3632 #ifdef HAVE_X_WINDOWS
3633 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3634 if (!NILP (pixmap_p
))
3635 to
[LFACE_STIPPLE_INDEX
] = value
;
3637 add_to_log ("Invalid face stipple", value
, Qnil
);
3640 else if (EQ (keyword
, QCwidth
))
3643 && face_numeric_swidth (value
) >= 0)
3644 to
[LFACE_SWIDTH_INDEX
] = value
;
3646 add_to_log ("Invalid face width", value
, Qnil
);
3648 else if (EQ (keyword
, QCinherit
))
3650 if (SYMBOLP (value
))
3651 to
[LFACE_INHERIT_INDEX
] = value
;
3655 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3656 if (!SYMBOLP (XCAR (tail
)))
3659 to
[LFACE_INHERIT_INDEX
] = value
;
3661 add_to_log ("Invalid face inherit", value
, Qnil
);
3665 add_to_log ("Invalid attribute %s in face property",
3668 prop
= XCDR (XCDR (prop
));
3673 /* This is a list of face specs. Specifications at the
3674 beginning of the list take precedence over later
3675 specifications, so we have to merge starting with the
3676 last specification. */
3677 Lisp_Object next
= XCDR (prop
);
3679 merge_face_vector_with_property (f
, to
, next
);
3680 merge_face_vector_with_property (f
, to
, first
);
3685 /* PROP ought to be a face name. */
3686 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3688 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3690 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3695 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3696 Sinternal_make_lisp_face
, 1, 2, 0,
3697 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3698 If FACE was not known as a face before, create a new one.
3699 If optional argument FRAME is specified, make a frame-local face
3700 for that frame. Otherwise operate on the global face definition.
3701 Value is a vector of face attributes. */)
3703 Lisp_Object face
, frame
;
3705 Lisp_Object global_lface
, lface
;
3709 CHECK_SYMBOL (face
);
3710 global_lface
= lface_from_face_name (NULL
, face
, 0);
3714 CHECK_LIVE_FRAME (frame
);
3716 lface
= lface_from_face_name (f
, face
, 0);
3719 f
= NULL
, lface
= Qnil
;
3721 /* Add a global definition if there is none. */
3722 if (NILP (global_lface
))
3724 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3726 AREF (global_lface
, 0) = Qface
;
3727 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3728 Vface_new_frame_defaults
);
3730 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3731 face id to Lisp face is given by the vector lface_id_to_name.
3732 The mapping from Lisp face to Lisp face id is given by the
3733 property `face' of the Lisp face name. */
3734 if (next_lface_id
== lface_id_to_name_size
)
3736 int new_size
= max (50, 2 * lface_id_to_name_size
);
3737 int sz
= new_size
* sizeof *lface_id_to_name
;
3738 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3739 lface_id_to_name_size
= new_size
;
3742 lface_id_to_name
[next_lface_id
] = face
;
3743 Fput (face
, Qface
, make_number (next_lface_id
));
3747 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3748 AREF (global_lface
, i
) = Qunspecified
;
3750 /* Add a frame-local definition. */
3755 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3757 AREF (lface
, 0) = Qface
;
3758 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3761 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3762 AREF (lface
, i
) = Qunspecified
;
3765 lface
= global_lface
;
3767 /* Changing a named face means that all realized faces depending on
3768 that face are invalid. Since we cannot tell which realized faces
3769 depend on the face, make sure they are all removed. This is done
3770 by incrementing face_change_count. The next call to
3771 init_iterator will then free realized faces. */
3772 ++face_change_count
;
3773 ++windows_or_buffers_changed
;
3775 xassert (LFACEP (lface
));
3776 check_lface (lface
);
3781 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3782 Sinternal_lisp_face_p
, 1, 2, 0,
3783 doc
: /* Return non-nil if FACE names a face.
3784 If optional second parameter FRAME is non-nil, check for the
3785 existence of a frame-local face with name FACE on that frame.
3786 Otherwise check for the existence of a global face. */)
3788 Lisp_Object face
, frame
;
3794 CHECK_LIVE_FRAME (frame
);
3795 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3798 lface
= lface_from_face_name (NULL
, face
, 0);
3804 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3805 Sinternal_copy_lisp_face
, 4, 4, 0,
3806 doc
: /* Copy face FROM to TO.
3807 If FRAME it t, copy the global face definition of FROM to the
3808 global face definition of TO. Otherwise, copy the frame-local
3809 definition of FROM on FRAME to the frame-local definition of TO
3810 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3813 (from
, to
, frame
, new_frame
)
3814 Lisp_Object from
, to
, frame
, new_frame
;
3816 Lisp_Object lface
, copy
;
3818 CHECK_SYMBOL (from
);
3820 if (NILP (new_frame
))
3825 /* Copy global definition of FROM. We don't make copies of
3826 strings etc. because 20.2 didn't do it either. */
3827 lface
= lface_from_face_name (NULL
, from
, 1);
3828 copy
= Finternal_make_lisp_face (to
, Qnil
);
3832 /* Copy frame-local definition of FROM. */
3833 CHECK_LIVE_FRAME (frame
);
3834 CHECK_LIVE_FRAME (new_frame
);
3835 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3836 copy
= Finternal_make_lisp_face (to
, new_frame
);
3839 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3840 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3842 /* Changing a named face means that all realized faces depending on
3843 that face are invalid. Since we cannot tell which realized faces
3844 depend on the face, make sure they are all removed. This is done
3845 by incrementing face_change_count. The next call to
3846 init_iterator will then free realized faces. */
3847 ++face_change_count
;
3848 ++windows_or_buffers_changed
;
3854 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3855 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3856 doc
: /* Set attribute ATTR of FACE to VALUE.
3857 FRAME being a frame means change the face on that frame.
3858 FRAME nil means change the face of the selected frame.
3859 FRAME t means change the default for new frames.
3860 FRAME 0 means change the face on all frames, and change the default
3862 (face
, attr
, value
, frame
)
3863 Lisp_Object face
, attr
, value
, frame
;
3866 Lisp_Object old_value
= Qnil
;
3867 /* Set 1 if ATTR is QCfont. */
3868 int font_attr_p
= 0;
3869 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3870 int font_related_attr_p
= 0;
3872 CHECK_SYMBOL (face
);
3873 CHECK_SYMBOL (attr
);
3875 face
= resolve_face_name (face
);
3877 /* If FRAME is 0, change face on all frames, and change the
3878 default for new frames. */
3879 if (INTEGERP (frame
) && XINT (frame
) == 0)
3882 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3883 FOR_EACH_FRAME (tail
, frame
)
3884 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3888 /* Set lface to the Lisp attribute vector of FACE. */
3890 lface
= lface_from_face_name (NULL
, face
, 1);
3894 frame
= selected_frame
;
3896 CHECK_LIVE_FRAME (frame
);
3897 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3899 /* If a frame-local face doesn't exist yet, create one. */
3901 lface
= Finternal_make_lisp_face (face
, frame
);
3904 if (EQ (attr
, QCfamily
))
3906 if (!UNSPECIFIEDP (value
))
3908 CHECK_STRING (value
);
3909 if (SCHARS (value
) == 0)
3910 signal_error ("Invalid face family", value
);
3912 old_value
= LFACE_FAMILY (lface
);
3913 LFACE_FAMILY (lface
) = value
;
3914 font_related_attr_p
= 1;
3916 else if (EQ (attr
, QCheight
))
3918 if (!UNSPECIFIEDP (value
))
3922 test
= (EQ (face
, Qdefault
)
3924 /* The default face must have an absolute size,
3925 otherwise, we do a test merge with a random
3926 height to see if VALUE's ok. */
3927 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3929 if (!INTEGERP (test
) || XINT (test
) <= 0)
3930 signal_error ("Invalid face height", value
);
3933 old_value
= LFACE_HEIGHT (lface
);
3934 LFACE_HEIGHT (lface
) = value
;
3935 font_related_attr_p
= 1;
3937 else if (EQ (attr
, QCweight
))
3939 if (!UNSPECIFIEDP (value
))
3941 CHECK_SYMBOL (value
);
3942 if (face_numeric_weight (value
) < 0)
3943 signal_error ("Invalid face weight", value
);
3945 old_value
= LFACE_WEIGHT (lface
);
3946 LFACE_WEIGHT (lface
) = value
;
3947 font_related_attr_p
= 1;
3949 else if (EQ (attr
, QCslant
))
3951 if (!UNSPECIFIEDP (value
))
3953 CHECK_SYMBOL (value
);
3954 if (face_numeric_slant (value
) < 0)
3955 signal_error ("Invalid face slant", value
);
3957 old_value
= LFACE_SLANT (lface
);
3958 LFACE_SLANT (lface
) = value
;
3959 font_related_attr_p
= 1;
3961 else if (EQ (attr
, QCunderline
))
3963 if (!UNSPECIFIEDP (value
))
3964 if ((SYMBOLP (value
)
3966 && !EQ (value
, Qnil
))
3967 /* Underline color. */
3969 && SCHARS (value
) == 0))
3970 signal_error ("Invalid face underline", value
);
3972 old_value
= LFACE_UNDERLINE (lface
);
3973 LFACE_UNDERLINE (lface
) = value
;
3975 else if (EQ (attr
, QCoverline
))
3977 if (!UNSPECIFIEDP (value
))
3978 if ((SYMBOLP (value
)
3980 && !EQ (value
, Qnil
))
3981 /* Overline color. */
3983 && SCHARS (value
) == 0))
3984 signal_error ("Invalid face overline", value
);
3986 old_value
= LFACE_OVERLINE (lface
);
3987 LFACE_OVERLINE (lface
) = value
;
3989 else if (EQ (attr
, QCstrike_through
))
3991 if (!UNSPECIFIEDP (value
))
3992 if ((SYMBOLP (value
)
3994 && !EQ (value
, Qnil
))
3995 /* Strike-through color. */
3997 && SCHARS (value
) == 0))
3998 signal_error ("Invalid face strike-through", value
);
4000 old_value
= LFACE_STRIKE_THROUGH (lface
);
4001 LFACE_STRIKE_THROUGH (lface
) = value
;
4003 else if (EQ (attr
, QCbox
))
4007 /* Allow t meaning a simple box of width 1 in foreground color
4010 value
= make_number (1);
4012 if (UNSPECIFIEDP (value
))
4014 else if (NILP (value
))
4016 else if (INTEGERP (value
))
4017 valid_p
= XINT (value
) != 0;
4018 else if (STRINGP (value
))
4019 valid_p
= SCHARS (value
) > 0;
4020 else if (CONSP (value
))
4036 if (EQ (k
, QCline_width
))
4038 if (!INTEGERP (v
) || XINT (v
) == 0)
4041 else if (EQ (k
, QCcolor
))
4043 if (!STRINGP (v
) || SCHARS (v
) == 0)
4046 else if (EQ (k
, QCstyle
))
4048 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4055 valid_p
= NILP (tem
);
4061 signal_error ("Invalid face box", value
);
4063 old_value
= LFACE_BOX (lface
);
4064 LFACE_BOX (lface
) = value
;
4066 else if (EQ (attr
, QCinverse_video
)
4067 || EQ (attr
, QCreverse_video
))
4069 if (!UNSPECIFIEDP (value
))
4071 CHECK_SYMBOL (value
);
4072 if (!EQ (value
, Qt
) && !NILP (value
))
4073 signal_error ("Invalid inverse-video face attribute value", value
);
4075 old_value
= LFACE_INVERSE (lface
);
4076 LFACE_INVERSE (lface
) = value
;
4078 else if (EQ (attr
, QCforeground
))
4080 if (!UNSPECIFIEDP (value
))
4082 /* Don't check for valid color names here because it depends
4083 on the frame (display) whether the color will be valid
4084 when the face is realized. */
4085 CHECK_STRING (value
);
4086 if (SCHARS (value
) == 0)
4087 signal_error ("Empty foreground color value", value
);
4089 old_value
= LFACE_FOREGROUND (lface
);
4090 LFACE_FOREGROUND (lface
) = value
;
4092 else if (EQ (attr
, QCbackground
))
4094 if (!UNSPECIFIEDP (value
))
4096 /* Don't check for valid color names here because it depends
4097 on the frame (display) whether the color will be valid
4098 when the face is realized. */
4099 CHECK_STRING (value
);
4100 if (SCHARS (value
) == 0)
4101 signal_error ("Empty background color value", value
);
4103 old_value
= LFACE_BACKGROUND (lface
);
4104 LFACE_BACKGROUND (lface
) = value
;
4106 else if (EQ (attr
, QCstipple
))
4108 #ifdef HAVE_X_WINDOWS
4109 if (!UNSPECIFIEDP (value
)
4111 && NILP (Fbitmap_spec_p (value
)))
4112 signal_error ("Invalid stipple attribute", value
);
4113 old_value
= LFACE_STIPPLE (lface
);
4114 LFACE_STIPPLE (lface
) = value
;
4115 #endif /* HAVE_X_WINDOWS */
4117 else if (EQ (attr
, QCwidth
))
4119 if (!UNSPECIFIEDP (value
))
4121 CHECK_SYMBOL (value
);
4122 if (face_numeric_swidth (value
) < 0)
4123 signal_error ("Invalid face width", value
);
4125 old_value
= LFACE_SWIDTH (lface
);
4126 LFACE_SWIDTH (lface
) = value
;
4127 font_related_attr_p
= 1;
4129 else if (EQ (attr
, QCfont
))
4131 #ifdef HAVE_WINDOW_SYSTEM
4132 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4134 /* Set font-related attributes of the Lisp face from an XLFD
4140 f
= SELECTED_FRAME ();
4142 f
= check_x_frame (frame
);
4144 if (!UNSPECIFIEDP (value
))
4146 CHECK_STRING (value
);
4148 /* VALUE may be a fontset name or an alias of fontset. In
4149 such a case, use the base fontset name. */
4150 tmp
= Fquery_fontset (value
, Qnil
);
4154 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4155 signal_error ("Invalid font or fontset name", value
);
4160 #endif /* HAVE_WINDOW_SYSTEM */
4162 else if (EQ (attr
, QCinherit
))
4165 if (SYMBOLP (value
))
4168 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4169 if (!SYMBOLP (XCAR (tail
)))
4172 LFACE_INHERIT (lface
) = value
;
4174 signal_error ("Invalid face inheritance", value
);
4176 else if (EQ (attr
, QCbold
))
4178 old_value
= LFACE_WEIGHT (lface
);
4179 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4180 font_related_attr_p
= 1;
4182 else if (EQ (attr
, QCitalic
))
4184 old_value
= LFACE_SLANT (lface
);
4185 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4186 font_related_attr_p
= 1;
4189 signal_error ("Invalid face attribute name", attr
);
4191 if (font_related_attr_p
4192 && !UNSPECIFIEDP (value
))
4193 /* If a font-related attribute other than QCfont is specified, the
4194 original `font' attribute nor that of default face is useless
4195 to determine a new font. Thus, we set it to nil so that font
4196 selection mechanism doesn't use it. */
4197 LFACE_FONT (lface
) = Qnil
;
4199 /* Changing a named face means that all realized faces depending on
4200 that face are invalid. Since we cannot tell which realized faces
4201 depend on the face, make sure they are all removed. This is done
4202 by incrementing face_change_count. The next call to
4203 init_iterator will then free realized faces. */
4205 && (EQ (attr
, QCfont
)
4206 || NILP (Fequal (old_value
, value
))))
4208 ++face_change_count
;
4209 ++windows_or_buffers_changed
;
4212 if (!UNSPECIFIEDP (value
)
4213 && NILP (Fequal (old_value
, value
)))
4219 if (EQ (face
, Qdefault
))
4221 #ifdef HAVE_WINDOW_SYSTEM
4222 /* Changed font-related attributes of the `default' face are
4223 reflected in changed `font' frame parameters. */
4225 && (font_related_attr_p
|| font_attr_p
)
4226 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4227 set_font_frame_param (frame
, lface
);
4229 #endif /* HAVE_WINDOW_SYSTEM */
4231 if (EQ (attr
, QCforeground
))
4232 param
= Qforeground_color
;
4233 else if (EQ (attr
, QCbackground
))
4234 param
= Qbackground_color
;
4236 #ifdef HAVE_WINDOW_SYSTEM
4238 else if (EQ (face
, Qscroll_bar
))
4240 /* Changing the colors of `scroll-bar' sets frame parameters
4241 `scroll-bar-foreground' and `scroll-bar-background'. */
4242 if (EQ (attr
, QCforeground
))
4243 param
= Qscroll_bar_foreground
;
4244 else if (EQ (attr
, QCbackground
))
4245 param
= Qscroll_bar_background
;
4247 #endif /* not WINDOWSNT */
4248 else if (EQ (face
, Qborder
))
4250 /* Changing background color of `border' sets frame parameter
4252 if (EQ (attr
, QCbackground
))
4253 param
= Qborder_color
;
4255 else if (EQ (face
, Qcursor
))
4257 /* Changing background color of `cursor' sets frame parameter
4259 if (EQ (attr
, QCbackground
))
4260 param
= Qcursor_color
;
4262 else if (EQ (face
, Qmouse
))
4264 /* Changing background color of `mouse' sets frame parameter
4266 if (EQ (attr
, QCbackground
))
4267 param
= Qmouse_color
;
4269 #endif /* HAVE_WINDOW_SYSTEM */
4270 else if (EQ (face
, Qmenu
))
4272 /* Indicate that we have to update the menu bar when
4273 realizing faces on FRAME. FRAME t change the
4274 default for new frames. We do this by setting
4275 setting the flag in new face caches */
4278 struct frame
*f
= XFRAME (frame
);
4279 if (FRAME_FACE_CACHE (f
) == NULL
)
4280 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4281 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4284 menu_face_changed_default
= 1;
4290 /* Update `default-frame-alist', which is used for new frames. */
4292 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4295 /* Update the current frame's parameters. */
4298 cons
= XCAR (Vparam_value_alist
);
4299 XSETCAR (cons
, param
);
4300 XSETCDR (cons
, value
);
4301 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4310 #ifdef HAVE_WINDOW_SYSTEM
4312 /* Set the `font' frame parameter of FRAME determined from `default'
4313 face attributes LFACE. If a face or fontset name is explicitely
4314 specfied in LFACE, use it as is. Otherwise, determine a font name
4315 from the other font-related atrributes of LFACE. In that case, if
4316 there's no matching font, signals an error. */
4319 set_font_frame_param (frame
, lface
)
4320 Lisp_Object frame
, lface
;
4322 struct frame
*f
= XFRAME (frame
);
4324 if (FRAME_WINDOW_P (f
))
4326 Lisp_Object font_name
;
4329 if (STRINGP (LFACE_FONT (lface
)))
4330 font_name
= LFACE_FONT (lface
);
4333 /* Choose a font name that reflects LFACE's attributes and has
4334 the registry and encoding pattern specified in the default
4335 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4336 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0, 0);
4338 error ("No font matches the specified attribute");
4339 font_name
= build_string (font
);
4343 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4348 /* Update the corresponding face when frame parameter PARAM on frame F
4349 has been assigned the value NEW_VALUE. */
4352 update_face_from_frame_parameter (f
, param
, new_value
)
4354 Lisp_Object param
, new_value
;
4358 /* If there are no faces yet, give up. This is the case when called
4359 from Fx_create_frame, and we do the necessary things later in
4360 face-set-after-frame-defaults. */
4361 if (NILP (f
->face_alist
))
4364 /* Changing a named face means that all realized faces depending on
4365 that face are invalid. Since we cannot tell which realized faces
4366 depend on the face, make sure they are all removed. This is done
4367 by incrementing face_change_count. The next call to
4368 init_iterator will then free realized faces. */
4369 ++face_change_count
;
4370 ++windows_or_buffers_changed
;
4372 if (EQ (param
, Qforeground_color
))
4374 lface
= lface_from_face_name (f
, Qdefault
, 1);
4375 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4376 ? new_value
: Qunspecified
);
4377 realize_basic_faces (f
);
4379 else if (EQ (param
, Qbackground_color
))
4383 /* Changing the background color might change the background
4384 mode, so that we have to load new defface specs. Call
4385 frame-update-face-colors to do that. */
4386 XSETFRAME (frame
, f
);
4387 call1 (Qframe_update_face_colors
, frame
);
4389 lface
= lface_from_face_name (f
, Qdefault
, 1);
4390 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4391 ? new_value
: Qunspecified
);
4392 realize_basic_faces (f
);
4394 if (EQ (param
, Qborder_color
))
4396 lface
= lface_from_face_name (f
, Qborder
, 1);
4397 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4398 ? new_value
: Qunspecified
);
4400 else if (EQ (param
, Qcursor_color
))
4402 lface
= lface_from_face_name (f
, Qcursor
, 1);
4403 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4404 ? new_value
: Qunspecified
);
4406 else if (EQ (param
, Qmouse_color
))
4408 lface
= lface_from_face_name (f
, Qmouse
, 1);
4409 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4410 ? new_value
: Qunspecified
);
4415 /* Get the value of X resource RESOURCE, class CLASS for the display
4416 of frame FRAME. This is here because ordinary `x-get-resource'
4417 doesn't take a frame argument. */
4419 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4420 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4421 (resource
, class, frame
)
4422 Lisp_Object resource
, class, frame
;
4424 Lisp_Object value
= Qnil
;
4427 CHECK_STRING (resource
);
4428 CHECK_STRING (class);
4429 CHECK_LIVE_FRAME (frame
);
4431 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4432 resource
, class, Qnil
, Qnil
);
4434 #endif /* not MAC_OS */
4435 #endif /* not WINDOWSNT */
4440 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4441 If VALUE is "on" or "true", return t. If VALUE is "off" or
4442 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4443 error; if SIGNAL_P is zero, return 0. */
4446 face_boolean_x_resource_value (value
, signal_p
)
4450 Lisp_Object result
= make_number (0);
4452 xassert (STRINGP (value
));
4454 if (xstricmp (SDATA (value
), "on") == 0
4455 || xstricmp (SDATA (value
), "true") == 0)
4457 else if (xstricmp (SDATA (value
), "off") == 0
4458 || xstricmp (SDATA (value
), "false") == 0)
4460 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4461 result
= Qunspecified
;
4463 signal_error ("Invalid face attribute value from X resource", value
);
4469 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4470 Finternal_set_lisp_face_attribute_from_resource
,
4471 Sinternal_set_lisp_face_attribute_from_resource
,
4472 3, 4, 0, doc
: /* */)
4473 (face
, attr
, value
, frame
)
4474 Lisp_Object face
, attr
, value
, frame
;
4476 CHECK_SYMBOL (face
);
4477 CHECK_SYMBOL (attr
);
4478 CHECK_STRING (value
);
4480 if (xstricmp (SDATA (value
), "unspecified") == 0)
4481 value
= Qunspecified
;
4482 else if (EQ (attr
, QCheight
))
4484 value
= Fstring_to_number (value
, make_number (10));
4485 if (XINT (value
) <= 0)
4486 signal_error ("Invalid face height from X resource", value
);
4488 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4489 value
= face_boolean_x_resource_value (value
, 1);
4490 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4491 value
= intern (SDATA (value
));
4492 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4493 value
= face_boolean_x_resource_value (value
, 1);
4494 else if (EQ (attr
, QCunderline
)
4495 || EQ (attr
, QCoverline
)
4496 || EQ (attr
, QCstrike_through
))
4498 Lisp_Object boolean_value
;
4500 /* If the result of face_boolean_x_resource_value is t or nil,
4501 VALUE does NOT specify a color. */
4502 boolean_value
= face_boolean_x_resource_value (value
, 0);
4503 if (SYMBOLP (boolean_value
))
4504 value
= boolean_value
;
4506 else if (EQ (attr
, QCbox
))
4507 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4509 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4512 #endif /* HAVE_WINDOW_SYSTEM */
4515 /***********************************************************************
4517 ***********************************************************************/
4519 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4521 /* Make menus on frame F appear as specified by the `menu' face. */
4524 x_update_menu_appearance (f
)
4527 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4531 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4535 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4536 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4537 const char *myname
= SDATA (Vx_resource_name
);
4540 const char *popup_path
= "popup_menu";
4542 const char *popup_path
= "menu.popup";
4545 if (STRINGP (LFACE_FOREGROUND (lface
)))
4547 sprintf (line
, "%s.%s*foreground: %s",
4549 SDATA (LFACE_FOREGROUND (lface
)));
4550 XrmPutLineResource (&rdb
, line
);
4551 sprintf (line
, "%s.pane.menubar*foreground: %s",
4552 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4553 XrmPutLineResource (&rdb
, line
);
4557 if (STRINGP (LFACE_BACKGROUND (lface
)))
4559 sprintf (line
, "%s.%s*background: %s",
4561 SDATA (LFACE_BACKGROUND (lface
)));
4562 XrmPutLineResource (&rdb
, line
);
4563 sprintf (line
, "%s.pane.menubar*background: %s",
4564 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4565 XrmPutLineResource (&rdb
, line
);
4570 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4571 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4572 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4573 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4574 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4575 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4578 const char *suffix
= "List";
4580 const char *suffix
= "";
4582 sprintf (line
, "%s.pane.menubar*font%s: %s",
4583 myname
, suffix
, face
->font_name
);
4584 XrmPutLineResource (&rdb
, line
);
4585 sprintf (line
, "%s.%s*font%s: %s",
4586 myname
, popup_path
, suffix
, face
->font_name
);
4587 XrmPutLineResource (&rdb
, line
);
4591 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4592 free_frame_menubar (f
);
4596 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4599 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4600 Sface_attribute_relative_p
,
4602 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4604 Lisp_Object attribute
, value
;
4606 if (EQ (value
, Qunspecified
))
4608 else if (EQ (attribute
, QCheight
))
4609 return INTEGERP (value
) ? Qnil
: Qt
;
4614 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4616 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4617 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4618 the result will be absolute, otherwise it will be relative. */)
4619 (attribute
, value1
, value2
)
4620 Lisp_Object attribute
, value1
, value2
;
4622 if (EQ (value1
, Qunspecified
))
4624 else if (EQ (attribute
, QCheight
))
4625 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4631 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4632 Sinternal_get_lisp_face_attribute
,
4634 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4635 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4636 face attribute name, signal an error.
4637 If the optional argument FRAME is given, report on face FACE in that
4638 frame. If FRAME is t, report on the defaults for face FACE (for new
4639 frames). If FRAME is omitted or nil, use the selected frame. */)
4640 (symbol
, keyword
, frame
)
4641 Lisp_Object symbol
, keyword
, frame
;
4643 Lisp_Object lface
, value
= Qnil
;
4645 CHECK_SYMBOL (symbol
);
4646 CHECK_SYMBOL (keyword
);
4649 lface
= lface_from_face_name (NULL
, symbol
, 1);
4653 frame
= selected_frame
;
4654 CHECK_LIVE_FRAME (frame
);
4655 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4658 if (EQ (keyword
, QCfamily
))
4659 value
= LFACE_FAMILY (lface
);
4660 else if (EQ (keyword
, QCheight
))
4661 value
= LFACE_HEIGHT (lface
);
4662 else if (EQ (keyword
, QCweight
))
4663 value
= LFACE_WEIGHT (lface
);
4664 else if (EQ (keyword
, QCslant
))
4665 value
= LFACE_SLANT (lface
);
4666 else if (EQ (keyword
, QCunderline
))
4667 value
= LFACE_UNDERLINE (lface
);
4668 else if (EQ (keyword
, QCoverline
))
4669 value
= LFACE_OVERLINE (lface
);
4670 else if (EQ (keyword
, QCstrike_through
))
4671 value
= LFACE_STRIKE_THROUGH (lface
);
4672 else if (EQ (keyword
, QCbox
))
4673 value
= LFACE_BOX (lface
);
4674 else if (EQ (keyword
, QCinverse_video
)
4675 || EQ (keyword
, QCreverse_video
))
4676 value
= LFACE_INVERSE (lface
);
4677 else if (EQ (keyword
, QCforeground
))
4678 value
= LFACE_FOREGROUND (lface
);
4679 else if (EQ (keyword
, QCbackground
))
4680 value
= LFACE_BACKGROUND (lface
);
4681 else if (EQ (keyword
, QCstipple
))
4682 value
= LFACE_STIPPLE (lface
);
4683 else if (EQ (keyword
, QCwidth
))
4684 value
= LFACE_SWIDTH (lface
);
4685 else if (EQ (keyword
, QCinherit
))
4686 value
= LFACE_INHERIT (lface
);
4687 else if (EQ (keyword
, QCfont
))
4688 value
= LFACE_FONT (lface
);
4690 signal_error ("Invalid face attribute name", keyword
);
4696 DEFUN ("internal-lisp-face-attribute-values",
4697 Finternal_lisp_face_attribute_values
,
4698 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4699 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4700 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4704 Lisp_Object result
= Qnil
;
4706 CHECK_SYMBOL (attr
);
4708 if (EQ (attr
, QCweight
)
4709 || EQ (attr
, QCslant
)
4710 || EQ (attr
, QCwidth
))
4712 /* Extract permissible symbols from tables. */
4713 struct table_entry
*table
;
4716 if (EQ (attr
, QCweight
))
4717 table
= weight_table
, dim
= DIM (weight_table
);
4718 else if (EQ (attr
, QCslant
))
4719 table
= slant_table
, dim
= DIM (slant_table
);
4721 table
= swidth_table
, dim
= DIM (swidth_table
);
4723 for (i
= 0; i
< dim
; ++i
)
4725 Lisp_Object symbol
= *table
[i
].symbol
;
4726 Lisp_Object tail
= result
;
4729 && !EQ (XCAR (tail
), symbol
))
4733 result
= Fcons (symbol
, result
);
4736 else if (EQ (attr
, QCunderline
))
4737 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4738 else if (EQ (attr
, QCoverline
))
4739 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4740 else if (EQ (attr
, QCstrike_through
))
4741 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4742 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4743 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4749 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4750 Sinternal_merge_in_global_face
, 2, 2, 0,
4751 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4752 Default face attributes override any local face attributes. */)
4754 Lisp_Object face
, frame
;
4757 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4759 CHECK_LIVE_FRAME (frame
);
4760 global_lface
= lface_from_face_name (NULL
, face
, 1);
4761 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4762 if (NILP (local_lface
))
4763 local_lface
= Finternal_make_lisp_face (face
, frame
);
4765 /* Make every specified global attribute override the local one.
4766 BEWARE!! This is only used from `face-set-after-frame-default' where
4767 the local frame is defined from default specs in `face-defface-spec'
4768 and those should be overridden by global settings. Hence the strange
4769 "global before local" priority. */
4770 lvec
= XVECTOR (local_lface
)->contents
;
4771 gvec
= XVECTOR (global_lface
)->contents
;
4772 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4773 if (! UNSPECIFIEDP (gvec
[i
]))
4780 /* The following function is implemented for compatibility with 20.2.
4781 The function is used in x-resolve-fonts when it is asked to
4782 return fonts with the same size as the font of a face. This is
4783 done in fontset.el. */
4785 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4786 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4787 If the optional argument FRAME is given, report on face FACE in that frame.
4788 If FRAME is t, report on the defaults for face FACE (for new frames).
4789 The font default for a face is either nil, or a list
4790 of the form (bold), (italic) or (bold italic).
4791 If FRAME is omitted or nil, use the selected frame. */)
4793 Lisp_Object face
, frame
;
4797 Lisp_Object result
= Qnil
;
4798 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4800 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4801 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4802 result
= Fcons (Qbold
, result
);
4804 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4805 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4806 result
= Fcons (Qitalic
, result
);
4812 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4813 int face_id
= lookup_named_face (f
, face
, 0);
4814 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4815 return face
? build_string (face
->font_name
) : Qnil
;
4820 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4821 all attributes are `equal'. Tries to be fast because this function
4822 is called quite often. */
4825 lface_equal_p (v1
, v2
)
4826 Lisp_Object
*v1
, *v2
;
4830 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4832 Lisp_Object a
= v1
[i
];
4833 Lisp_Object b
= v2
[i
];
4835 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4836 and the other is specified. */
4837 equal_p
= XTYPE (a
) == XTYPE (b
);
4846 equal_p
= ((SBYTES (a
)
4848 && bcmp (SDATA (a
), SDATA (b
),
4858 equal_p
= !NILP (Fequal (a
, b
));
4868 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4869 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4870 doc
: /* True if FACE1 and FACE2 are equal.
4871 If the optional argument FRAME is given, report on face FACE in that frame.
4872 If FRAME is t, report on the defaults for face FACE (for new frames).
4873 If FRAME is omitted or nil, use the selected frame. */)
4874 (face1
, face2
, frame
)
4875 Lisp_Object face1
, face2
, frame
;
4879 Lisp_Object lface1
, lface2
;
4884 /* Don't use check_x_frame here because this function is called
4885 before X frames exist. At that time, if FRAME is nil,
4886 selected_frame will be used which is the frame dumped with
4887 Emacs. That frame is not an X frame. */
4888 f
= frame_or_selected_frame (frame
, 2);
4890 lface1
= lface_from_face_name (NULL
, face1
, 1);
4891 lface2
= lface_from_face_name (NULL
, face2
, 1);
4892 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4893 XVECTOR (lface2
)->contents
);
4894 return equal_p
? Qt
: Qnil
;
4898 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4899 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4900 doc
: /* True if FACE has no attribute specified.
4901 If the optional argument FRAME is given, report on face FACE in that frame.
4902 If FRAME is t, report on the defaults for face FACE (for new frames).
4903 If FRAME is omitted or nil, use the selected frame. */)
4905 Lisp_Object face
, frame
;
4912 frame
= selected_frame
;
4913 CHECK_LIVE_FRAME (frame
);
4917 lface
= lface_from_face_name (NULL
, face
, 1);
4919 lface
= lface_from_face_name (f
, face
, 1);
4921 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4922 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4925 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4929 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4931 doc
: /* Return an alist of frame-local faces defined on FRAME.
4932 For internal use only. */)
4936 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4937 return f
->face_alist
;
4941 /* Return a hash code for Lisp string STRING with case ignored. Used
4942 below in computing a hash value for a Lisp face. */
4944 static INLINE
unsigned
4945 hash_string_case_insensitive (string
)
4948 const unsigned char *s
;
4950 xassert (STRINGP (string
));
4951 for (s
= SDATA (string
); *s
; ++s
)
4952 hash
= (hash
<< 1) ^ tolower (*s
);
4957 /* Return a hash code for face attribute vector V. */
4959 static INLINE
unsigned
4963 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4964 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4965 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4966 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4967 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4968 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4969 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4973 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4974 considering charsets/registries). They do if they specify the same
4975 family, point size, weight, width, slant, and fontset. Both LFACE1
4976 and LFACE2 must be fully-specified. */
4979 lface_same_font_attributes_p (lface1
, lface2
)
4980 Lisp_Object
*lface1
, *lface2
;
4982 xassert (lface_fully_specified_p (lface1
)
4983 && lface_fully_specified_p (lface2
));
4984 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
4985 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
4986 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4987 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4988 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4989 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4990 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4991 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4992 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4993 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4994 && xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
4995 SDATA (lface2
[LFACE_FONT_INDEX
])))));
5000 /***********************************************************************
5002 ***********************************************************************/
5004 /* Allocate and return a new realized face for Lisp face attribute
5007 static struct face
*
5008 make_realized_face (attr
)
5011 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5012 bzero (face
, sizeof *face
);
5013 face
->ascii_face
= face
;
5014 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5019 /* Free realized face FACE, including its X resources. FACE may
5023 free_realized_face (f
, face
)
5029 #ifdef HAVE_WINDOW_SYSTEM
5030 if (FRAME_WINDOW_P (f
))
5032 /* Free fontset of FACE if it is ASCII face. */
5033 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5034 free_face_fontset (f
, face
);
5037 x_free_gc (f
, face
->gc
);
5041 free_face_colors (f
, face
);
5042 x_destroy_bitmap (f
, face
->stipple
);
5044 #endif /* HAVE_WINDOW_SYSTEM */
5051 /* Prepare face FACE for subsequent display on frame F. This
5052 allocated GCs if they haven't been allocated yet or have been freed
5053 by clearing the face cache. */
5056 prepare_face_for_display (f
, face
)
5060 #ifdef HAVE_WINDOW_SYSTEM
5061 xassert (FRAME_WINDOW_P (f
));
5066 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5068 xgcv
.foreground
= face
->foreground
;
5069 xgcv
.background
= face
->background
;
5070 #ifdef HAVE_X_WINDOWS
5071 xgcv
.graphics_exposures
= False
;
5073 /* The font of FACE may be null if we couldn't load it. */
5076 #ifdef HAVE_X_WINDOWS
5077 xgcv
.font
= face
->font
->fid
;
5080 xgcv
.font
= face
->font
;
5083 xgcv
.font
= face
->font
;
5089 #ifdef HAVE_X_WINDOWS
5092 xgcv
.fill_style
= FillOpaqueStippled
;
5093 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5094 mask
|= GCFillStyle
| GCStipple
;
5097 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5100 #endif /* HAVE_WINDOW_SYSTEM */
5104 /* Returns the `distance' between the colors X and Y. */
5107 color_distance (x
, y
)
5110 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5111 Quoting from that paper:
5113 This formula has results that are very close to L*u*v* (with the
5114 modified lightness curve) and, more importantly, it is a more even
5115 algorithm: it does not have a range of colours where it suddenly
5116 gives far from optimal results.
5118 See <http://www.compuphase.com/cmetric.htm> for more info. */
5120 long r
= (x
->red
- y
->red
) >> 8;
5121 long g
= (x
->green
- y
->green
) >> 8;
5122 long b
= (x
->blue
- y
->blue
) >> 8;
5123 long r_mean
= (x
->red
+ y
->red
) >> 9;
5126 (((512 + r_mean
) * r
* r
) >> 8)
5128 + (((767 - r_mean
) * b
* b
) >> 8);
5132 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5133 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5134 COLOR1 and COLOR2 may be either strings containing the color name,
5135 or lists of the form (RED GREEN BLUE).
5136 If FRAME is unspecified or nil, the current frame is used. */)
5137 (color1
, color2
, frame
)
5138 Lisp_Object color1
, color2
, frame
;
5141 XColor cdef1
, cdef2
;
5144 frame
= selected_frame
;
5145 CHECK_LIVE_FRAME (frame
);
5148 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5149 || !STRINGP (color1
)
5150 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5151 signal_error ("Invalid color", color1
);
5152 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5153 || !STRINGP (color2
)
5154 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5155 signal_error ("Invalid color", color2
);
5157 return make_number (color_distance (&cdef1
, &cdef2
));
5161 /***********************************************************************
5162 Face capability testing for ttys
5163 ***********************************************************************/
5166 /* If the distance (as returned by color_distance) between two colors is
5167 less than this, then they are considered the same, for determining
5168 whether a color is supported or not. The range of values is 0-65535. */
5170 #define TTY_SAME_COLOR_THRESHOLD 10000
5173 DEFUN ("tty-supports-face-attributes-p",
5174 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5176 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5177 The optional argument FRAME is the frame on which to test; if it is nil
5178 or unspecified, then the current frame is used. If FRAME is not a tty
5179 frame, then nil is returned.
5181 The definition of `supported' is somewhat heuristic, but basically means
5182 that a face containing all the attributes in ATTRIBUTES, when merged
5183 with the default face for display, can be represented in a way that's
5185 \(1) different in appearance than the default face, and
5186 \(2) `close in spirit' to what the attributes specify, if not exact.
5188 Point (2) implies that a `:weight black' attribute will be satisified
5189 by any terminal that can display bold, and a `:foreground "yellow"' as
5190 long as the terminal can display a yellowish color, but `:slant italic'
5191 will _not_ be satisified by the tty display code's automatic
5192 substitution of a `dim' face for italic. */)
5194 Lisp_Object attributes
, frame
;
5198 Lisp_Object val
, fg
, bg
;
5199 XColor fg_tty_color
, fg_std_color
;
5200 XColor bg_tty_color
, bg_std_color
;
5201 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5202 unsigned test_caps
= 0;
5205 frame
= selected_frame
;
5206 CHECK_LIVE_FRAME (frame
);
5209 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5210 attrs
[i
] = Qunspecified
;
5211 merge_face_vector_with_property (f
, attrs
, attributes
);
5213 /* This function only works on ttys. */
5214 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5217 /* First check some easy-to-check stuff; ttys support none of the
5218 following attributes, so we can just return nil if any are requested. */
5221 val
= attrs
[LFACE_STIPPLE_INDEX
];
5222 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5226 val
= attrs
[LFACE_HEIGHT_INDEX
];
5227 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5231 val
= attrs
[LFACE_SWIDTH_INDEX
];
5232 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5233 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5237 val
= attrs
[LFACE_OVERLINE_INDEX
];
5238 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5241 /* strike-through */
5242 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5243 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5247 val
= attrs
[LFACE_BOX_INDEX
];
5248 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5251 /* slant (italics/oblique); We consider any non-default value
5252 unsupportable on ttys, even though the face code actually `fakes'
5253 them using a dim attribute if possible. This is because the faked
5254 result is too different from what the face specifies. */
5255 val
= attrs
[LFACE_SLANT_INDEX
];
5256 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5257 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5261 /* Test for terminal `capabilities' (non-color character attributes). */
5263 /* font weight (bold/dim) */
5264 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5267 if (weight
> XLFD_WEIGHT_MEDIUM
)
5268 test_caps
= TTY_CAP_BOLD
;
5269 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5270 test_caps
= TTY_CAP_DIM
;
5274 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5275 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5278 return Qnil
; /* ttys don't support colored underlines */
5280 test_caps
|= TTY_CAP_UNDERLINE
;
5284 val
= attrs
[LFACE_INVERSE_INDEX
];
5285 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5286 test_caps
|= TTY_CAP_INVERSE
;
5289 /* Color testing. */
5291 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5292 we use them when calling `tty_capable_p' below, even if the face
5293 specifies no colors. */
5294 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5295 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5297 /* Check if foreground color is close enough. */
5298 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5301 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5303 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5304 > TTY_SAME_COLOR_THRESHOLD
)
5308 /* Check if background color is close enough. */
5309 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5312 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5314 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5315 > TTY_SAME_COLOR_THRESHOLD
)
5319 /* If both foreground and background are requested, see if the
5320 distance between them is OK. We just check to see if the distance
5321 between the tty's foreground and background is close enough to the
5322 distance between the standard foreground and background. */
5323 if (STRINGP (fg
) && STRINGP (bg
))
5326 = (color_distance (&fg_std_color
, &bg_std_color
)
5327 - color_distance (&fg_tty_color
, &bg_tty_color
));
5328 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5329 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5334 /* See if the capabilities we selected above are supported, with the
5336 if (test_caps
!= 0 &&
5337 ! tty_capable_p (f
, test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5341 /* Hmmm, everything checks out, this terminal must support this face. */
5347 /***********************************************************************
5349 ***********************************************************************/
5351 /* Return a new face cache for frame F. */
5353 static struct face_cache
*
5357 struct face_cache
*c
;
5360 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5361 bzero (c
, sizeof *c
);
5362 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5363 c
->buckets
= (struct face
**) xmalloc (size
);
5364 bzero (c
->buckets
, size
);
5366 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5368 c
->menu_face_changed_p
= menu_face_changed_default
;
5373 /* Clear out all graphics contexts for all realized faces, except for
5374 the basic faces. This should be done from time to time just to avoid
5375 keeping too many graphics contexts that are no longer needed. */
5379 struct face_cache
*c
;
5381 if (c
&& FRAME_WINDOW_P (c
->f
))
5383 #ifdef HAVE_WINDOW_SYSTEM
5385 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5387 struct face
*face
= c
->faces_by_id
[i
];
5388 if (face
&& face
->gc
)
5390 x_free_gc (c
->f
, face
->gc
);
5394 #endif /* HAVE_WINDOW_SYSTEM */
5399 /* Free all realized faces in face cache C, including basic faces. C
5400 may be null. If faces are freed, make sure the frame's current
5401 matrix is marked invalid, so that a display caused by an expose
5402 event doesn't try to use faces we destroyed. */
5405 free_realized_faces (c
)
5406 struct face_cache
*c
;
5411 struct frame
*f
= c
->f
;
5413 /* We must block input here because we can't process X events
5414 safely while only some faces are freed, or when the frame's
5415 current matrix still references freed faces. */
5418 for (i
= 0; i
< c
->used
; ++i
)
5420 free_realized_face (f
, c
->faces_by_id
[i
]);
5421 c
->faces_by_id
[i
] = NULL
;
5425 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5426 bzero (c
->buckets
, size
);
5428 /* Must do a thorough redisplay the next time. Mark current
5429 matrices as invalid because they will reference faces freed
5430 above. This function is also called when a frame is
5431 destroyed. In this case, the root window of F is nil. */
5432 if (WINDOWP (f
->root_window
))
5434 clear_current_matrices (f
);
5435 ++windows_or_buffers_changed
;
5443 /* Free all faces realized for multibyte characters on frame F that
5447 free_realized_multibyte_face (f
, fontset
)
5451 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5455 /* We must block input here because we can't process X events safely
5456 while only some faces are freed, or when the frame's current
5457 matrix still references freed faces. */
5460 for (i
= 0; i
< cache
->used
; i
++)
5462 face
= cache
->faces_by_id
[i
];
5464 && face
!= face
->ascii_face
5465 && face
->fontset
== fontset
)
5467 uncache_face (cache
, face
);
5468 free_realized_face (f
, face
);
5472 /* Must do a thorough redisplay the next time. Mark current
5473 matrices as invalid because they will reference faces freed
5474 above. This function is also called when a frame is destroyed.
5475 In this case, the root window of F is nil. */
5476 if (WINDOWP (f
->root_window
))
5478 clear_current_matrices (f
);
5479 ++windows_or_buffers_changed
;
5486 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5487 This is done after attributes of a named face have been changed,
5488 because we can't tell which realized faces depend on that face. */
5491 free_all_realized_faces (frame
)
5497 FOR_EACH_FRAME (rest
, frame
)
5498 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5501 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5505 /* Free face cache C and faces in it, including their X resources. */
5509 struct face_cache
*c
;
5513 free_realized_faces (c
);
5515 xfree (c
->faces_by_id
);
5521 /* Cache realized face FACE in face cache C. HASH is the hash value
5522 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5523 collision list of the face hash table of C. This is done because
5524 otherwise lookup_face would find FACE for every character, even if
5525 faces with the same attributes but for specific characters exist. */
5528 cache_face (c
, face
, hash
)
5529 struct face_cache
*c
;
5533 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5537 if (face
->fontset
>= 0)
5539 struct face
*last
= c
->buckets
[i
];
5550 c
->buckets
[i
] = face
;
5551 face
->prev
= face
->next
= NULL
;
5557 face
->next
= c
->buckets
[i
];
5559 face
->next
->prev
= face
;
5560 c
->buckets
[i
] = face
;
5563 /* Find a free slot in C->faces_by_id and use the index of the free
5564 slot as FACE->id. */
5565 for (i
= 0; i
< c
->used
; ++i
)
5566 if (c
->faces_by_id
[i
] == NULL
)
5570 /* Maybe enlarge C->faces_by_id. */
5571 if (i
== c
->used
&& c
->used
== c
->size
)
5573 int new_size
= 2 * c
->size
;
5574 int sz
= new_size
* sizeof *c
->faces_by_id
;
5575 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5580 /* Check that FACE got a unique id. */
5585 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5586 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5592 #endif /* GLYPH_DEBUG */
5594 c
->faces_by_id
[i
] = face
;
5600 /* Remove face FACE from cache C. */
5603 uncache_face (c
, face
)
5604 struct face_cache
*c
;
5607 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5610 face
->prev
->next
= face
->next
;
5612 c
->buckets
[i
] = face
->next
;
5615 face
->next
->prev
= face
->prev
;
5617 c
->faces_by_id
[face
->id
] = NULL
;
5618 if (face
->id
== c
->used
)
5623 /* Look up a realized face with face attributes ATTR in the face cache
5624 of frame F. The face will be used to display character C. Value
5625 is the ID of the face found. If no suitable face is found, realize
5626 a new one. In that case, if C is a multibyte character, BASE_FACE
5627 is a face that has the same attributes. */
5630 lookup_face (f
, attr
, c
, base_face
)
5634 struct face
*base_face
;
5636 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5641 xassert (cache
!= NULL
);
5642 check_lface_attrs (attr
);
5644 /* Look up ATTR in the face cache. */
5645 hash
= lface_hash (attr
);
5646 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5648 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5649 if (face
->hash
== hash
5650 && (!FRAME_WINDOW_P (f
)
5651 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5652 && lface_equal_p (face
->lface
, attr
))
5655 /* If not found, realize a new face. */
5657 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5660 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5662 /* When this function is called from face_for_char (in this case, C is
5663 a multibyte character), a fontset of a face returned by
5664 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5665 C) is not sutisfied. The fontset is set for this face by
5666 face_for_char later. */
5668 if (FRAME_WINDOW_P (f
))
5669 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5671 #endif /* GLYPH_DEBUG */
5677 /* Return the face id of the realized face for named face SYMBOL on
5678 frame F suitable for displaying character C. Value is -1 if the
5679 face couldn't be determined, which might happen if the default face
5680 isn't realized and cannot be realized. */
5683 lookup_named_face (f
, symbol
, c
)
5688 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5689 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5690 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5692 if (default_face
== NULL
)
5694 if (!realize_basic_faces (f
))
5696 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5699 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5700 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5701 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5702 return lookup_face (f
, attrs
, c
, NULL
);
5706 /* Return the ID of the realized ASCII face of Lisp face with ID
5707 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5710 ascii_face_of_lisp_face (f
, lface_id
)
5716 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5718 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5719 face_id
= lookup_named_face (f
, face_name
, 0);
5728 /* Return a face for charset ASCII that is like the face with id
5729 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5730 STEPS < 0 means larger. Value is the id of the face. */
5733 smaller_face (f
, face_id
, steps
)
5737 #ifdef HAVE_WINDOW_SYSTEM
5739 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5740 int pt
, last_pt
, last_height
;
5743 struct face
*new_face
;
5745 /* If not called for an X frame, just return the original face. */
5746 if (FRAME_TERMCAP_P (f
))
5749 /* Try in increments of 1/2 pt. */
5750 delta
= steps
< 0 ? 5 : -5;
5751 steps
= abs (steps
);
5753 face
= FACE_FROM_ID (f
, face_id
);
5754 bcopy (face
->lface
, attrs
, sizeof attrs
);
5755 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5756 new_face_id
= face_id
;
5757 last_height
= FONT_HEIGHT (face
->font
);
5761 /* Give up if we cannot find a font within 10pt. */
5762 && abs (last_pt
- pt
) < 100)
5764 /* Look up a face for a slightly smaller/larger font. */
5766 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5767 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5768 new_face
= FACE_FROM_ID (f
, new_face_id
);
5770 /* If height changes, count that as one step. */
5771 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5772 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5775 last_height
= FONT_HEIGHT (new_face
->font
);
5782 #else /* not HAVE_WINDOW_SYSTEM */
5786 #endif /* not HAVE_WINDOW_SYSTEM */
5790 /* Return a face for charset ASCII that is like the face with id
5791 FACE_ID on frame F, but has height HEIGHT. */
5794 face_with_height (f
, face_id
, height
)
5799 #ifdef HAVE_WINDOW_SYSTEM
5801 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5803 if (FRAME_TERMCAP_P (f
)
5807 face
= FACE_FROM_ID (f
, face_id
);
5808 bcopy (face
->lface
, attrs
, sizeof attrs
);
5809 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5810 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5811 #endif /* HAVE_WINDOW_SYSTEM */
5817 /* Return the face id of the realized face for named face SYMBOL on
5818 frame F suitable for displaying character C, and use attributes of
5819 the face FACE_ID for attributes that aren't completely specified by
5820 SYMBOL. This is like lookup_named_face, except that the default
5821 attributes come from FACE_ID, not from the default face. FACE_ID
5822 is assumed to be already realized. */
5825 lookup_derived_face (f
, symbol
, c
, face_id
)
5831 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5832 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5833 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5838 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5839 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5840 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5841 return lookup_face (f
, attrs
, c
, default_face
);
5844 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5845 Sface_attributes_as_vector
, 1, 1, 0,
5846 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5851 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5853 merge_face_vector_with_property (XFRAME (selected_frame
),
5854 XVECTOR (lface
)->contents
,
5861 /***********************************************************************
5863 ***********************************************************************/
5865 DEFUN ("internal-set-font-selection-order",
5866 Finternal_set_font_selection_order
,
5867 Sinternal_set_font_selection_order
, 1, 1, 0,
5868 doc
: /* Set font selection order for face font selection to ORDER.
5869 ORDER must be a list of length 4 containing the symbols `:width',
5870 `:height', `:weight', and `:slant'. Face attributes appearing
5871 first in ORDER are matched first, e.g. if `:height' appears before
5872 `:weight' in ORDER, font selection first tries to find a font with
5873 a suitable height, and then tries to match the font weight.
5880 int indices
[DIM (font_sort_order
)];
5883 bzero (indices
, sizeof indices
);
5887 CONSP (list
) && i
< DIM (indices
);
5888 list
= XCDR (list
), ++i
)
5890 Lisp_Object attr
= XCAR (list
);
5893 if (EQ (attr
, QCwidth
))
5895 else if (EQ (attr
, QCheight
))
5896 xlfd
= XLFD_POINT_SIZE
;
5897 else if (EQ (attr
, QCweight
))
5899 else if (EQ (attr
, QCslant
))
5904 if (indices
[i
] != 0)
5909 if (!NILP (list
) || i
!= DIM (indices
))
5910 signal_error ("Invalid font sort order", order
);
5911 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5912 if (indices
[i
] == 0)
5913 signal_error ("Invalid font sort order", order
);
5915 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5917 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5918 free_all_realized_faces (Qnil
);
5925 DEFUN ("internal-set-alternative-font-family-alist",
5926 Finternal_set_alternative_font_family_alist
,
5927 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5928 doc
: /* Define alternative font families to try in face font selection.
5929 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5930 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5931 be found. Value is ALIST. */)
5936 Vface_alternative_font_family_alist
= alist
;
5937 free_all_realized_faces (Qnil
);
5942 DEFUN ("internal-set-alternative-font-registry-alist",
5943 Finternal_set_alternative_font_registry_alist
,
5944 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5945 doc
: /* Define alternative font registries to try in face font selection.
5946 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5947 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5948 be found. Value is ALIST. */)
5953 Vface_alternative_font_registry_alist
= alist
;
5954 free_all_realized_faces (Qnil
);
5959 #ifdef HAVE_WINDOW_SYSTEM
5961 /* Value is non-zero if FONT is the name of a scalable font. The
5962 X11R6 XLFD spec says that point size, pixel size, and average width
5963 are zero for scalable fonts. Intlfonts contain at least one
5964 scalable font ("*-muleindian-1") for which this isn't true, so we
5965 just test average width. */
5968 font_scalable_p (font
)
5969 struct font_name
*font
;
5971 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5972 return (*s
== '0' && *(s
+ 1) == '\0')
5974 /* Windows implementation of XLFD is slightly broken for backward
5975 compatibility with previous broken versions, so test for
5976 wildcards as well as 0. */
5983 /* Ignore the difference of font point size less than this value. */
5985 #define FONT_POINT_SIZE_QUANTUM 5
5987 /* Value is non-zero if FONT1 is a better match for font attributes
5988 VALUES than FONT2. VALUES is an array of face attribute values in
5989 font sort order. COMPARE_PT_P zero means don't compare point
5990 sizes. AVGWIDTH, if not zero, is a specified font average width
5994 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5996 struct font_name
*font1
, *font2
;
5997 int compare_pt_p
, avgwidth
;
6001 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6003 int xlfd_idx
= font_sort_order
[i
];
6005 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6009 if (xlfd_idx
== XLFD_POINT_SIZE
)
6011 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6012 / font1
->rescale_ratio
));
6013 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6014 / font2
->rescale_ratio
));
6015 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6020 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6021 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6024 if (delta1
> delta2
)
6026 else if (delta1
< delta2
)
6030 /* The difference may be equal because, e.g., the face
6031 specifies `italic' but we have only `regular' and
6032 `oblique'. Prefer `oblique' in this case. */
6033 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6034 && font1
->numeric
[xlfd_idx
] > values
[i
]
6035 && font2
->numeric
[xlfd_idx
] < values
[i
])
6043 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6044 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6045 if (delta1
> delta2
)
6047 else if (delta1
< delta2
)
6051 return font1
->registry_priority
< font2
->registry_priority
;
6055 /* Value is non-zero if FONT is an exact match for face attributes in
6056 SPECIFIED. SPECIFIED is an array of face attribute values in font
6057 sort order. AVGWIDTH, if non-zero, is an average width to compare
6061 exact_face_match_p (specified
, font
, avgwidth
)
6063 struct font_name
*font
;
6068 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6069 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6072 return (i
== DIM (font_sort_order
)
6074 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6078 /* Value is the name of a scaled font, generated from scalable font
6079 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6080 Value is allocated from heap. */
6083 build_scalable_font_name (f
, font
, specified_pt
)
6085 struct font_name
*font
;
6088 char pixel_size
[20];
6090 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6093 /* If scalable font is for a specific resolution, compute
6094 the point size we must specify from the resolution of
6095 the display and the specified resolution of the font. */
6096 if (font
->numeric
[XLFD_RESY
] != 0)
6098 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6099 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6104 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6106 /* We may need a font of the different size. */
6107 pixel_value
*= font
->rescale_ratio
;
6109 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6110 font of the specified PIXEL_SIZE. */
6112 { /* Set point size of the font. */
6113 char point_size
[20];
6114 sprintf (point_size
, "%d", (int) pt
);
6115 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6116 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6120 /* Set pixel size. */
6121 sprintf (pixel_size
, "%d", pixel_value
);
6122 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6123 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6125 /* If font doesn't specify its resolution, use the
6126 resolution of the display. */
6127 if (font
->numeric
[XLFD_RESY
] == 0)
6130 sprintf (buffer
, "%d", (int) resy
);
6131 font
->fields
[XLFD_RESY
] = buffer
;
6132 font
->numeric
[XLFD_RESY
] = resy
;
6135 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6138 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6139 sprintf (buffer
, "%d", resx
);
6140 font
->fields
[XLFD_RESX
] = buffer
;
6141 font
->numeric
[XLFD_RESX
] = resx
;
6144 return build_font_name (font
);
6148 /* Value is non-zero if we are allowed to use scalable font FONT. We
6149 can't run a Lisp function here since this function may be called
6150 with input blocked. */
6153 may_use_scalable_font_p (font
)
6156 if (EQ (Vscalable_fonts_allowed
, Qt
))
6158 else if (CONSP (Vscalable_fonts_allowed
))
6160 Lisp_Object tail
, regexp
;
6162 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6164 regexp
= XCAR (tail
);
6165 if (STRINGP (regexp
)
6166 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6176 /* Return the name of the best matching font for face attributes ATTRS
6177 in the array of font_name structures FONTS which contains NFONTS
6178 elements. WIDTH_RATIO is a factor with which to multiply average
6179 widths if ATTRS specifies such a width.
6181 Value is a font name which is allocated from the heap. FONTS is
6182 freed by this function.
6184 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6185 indicate whether the resulting font should be drawn using overstrike
6186 to simulate bold-face. */
6189 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6192 struct font_name
*fonts
;
6195 int *needs_overstrike
;
6198 struct font_name
*best
;
6201 int exact_p
, avgwidth
;
6206 /* Make specified font attributes available in `specified',
6207 indexed by sort order. */
6208 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6210 int xlfd_idx
= font_sort_order
[i
];
6212 if (xlfd_idx
== XLFD_SWIDTH
)
6213 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6214 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6215 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6216 else if (xlfd_idx
== XLFD_WEIGHT
)
6217 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6218 else if (xlfd_idx
== XLFD_SLANT
)
6219 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6224 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6226 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6230 if (needs_overstrike
)
6231 *needs_overstrike
= 0;
6233 /* Start with the first non-scalable font in the list. */
6234 for (i
= 0; i
< nfonts
; ++i
)
6235 if (!font_scalable_p (fonts
+ i
))
6238 /* Find the best match among the non-scalable fonts. */
6243 for (i
= 1; i
< nfonts
; ++i
)
6244 if (!font_scalable_p (fonts
+ i
)
6245 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6249 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6257 /* Unless we found an exact match among non-scalable fonts, see if
6258 we can find a better match among scalable fonts. */
6261 /* A scalable font is better if
6263 1. its weight, slant, swidth attributes are better, or.
6265 2. the best non-scalable font doesn't have the required
6266 point size, and the scalable fonts weight, slant, swidth
6269 int non_scalable_has_exact_height_p
;
6271 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6272 non_scalable_has_exact_height_p
= 1;
6274 non_scalable_has_exact_height_p
= 0;
6276 for (i
= 0; i
< nfonts
; ++i
)
6277 if (font_scalable_p (fonts
+ i
))
6280 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6281 || (!non_scalable_has_exact_height_p
6282 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6286 if (needs_overstrike
)
6288 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6289 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6291 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6293 /* We want a bold font, but didn't get one; try to use
6294 overstriking instead to simulate bold-face. However,
6295 don't overstrike an already-bold fontn unless the
6296 desired weight grossly exceeds the available weight. */
6297 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6298 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6300 *needs_overstrike
= 1;
6305 if (font_scalable_p (best
))
6306 font_name
= build_scalable_font_name (f
, best
, pt
);
6308 font_name
= build_font_name (best
);
6310 /* Free font_name structures. */
6311 free_font_names (fonts
, nfonts
);
6317 /* Get a list of matching fonts on frame F, considering FAMILY
6318 and alternative font families from Vface_alternative_font_registry_alist.
6320 FAMILY is the font family whose alternatives are considered.
6322 REGISTRY, if a string, specifies a font registry and encoding to
6323 match. A value of nil means include fonts of any registry and
6326 Return in *FONTS a pointer to a vector of font_name structures for
6327 the fonts matched. Value is the number of fonts found. */
6330 try_alternative_families (f
, family
, registry
, fonts
)
6332 Lisp_Object family
, registry
;
6333 struct font_name
**fonts
;
6338 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6341 /* Try alternative font families. */
6342 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6345 for (alter
= XCDR (alter
);
6346 CONSP (alter
) && nfonts
== 0;
6347 alter
= XCDR (alter
))
6349 if (STRINGP (XCAR (alter
)))
6350 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6354 /* Try all scalable fonts before giving up. */
6355 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6357 int count
= SPECPDL_INDEX ();
6358 specbind (Qscalable_fonts_allowed
, Qt
);
6359 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6360 unbind_to (count
, Qnil
);
6367 /* Get a list of matching fonts on frame F.
6369 FAMILY, if a string, specifies a font family derived from the fontset.
6370 It is only used if the face does not specify any family in ATTRS or
6371 if we cannot find any font of the face's family.
6373 REGISTRY, if a string, specifies a font registry and encoding to
6374 match. A value of nil means include fonts of any registry and
6377 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6378 Otherwise, prefer FAMILY.
6380 Return in *FONTS a pointer to a vector of font_name structures for
6381 the fonts matched. Value is the number of fonts found. */
6384 try_font_list (f
, attrs
, family
, registry
, fonts
, prefer_face_family
)
6387 Lisp_Object family
, registry
;
6388 struct font_name
**fonts
;
6389 int prefer_face_family
;
6392 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6393 Lisp_Object try_family
;
6395 try_family
= (prefer_face_family
|| NILP (family
)) ? face_family
: family
;
6397 if (STRINGP (try_family
))
6398 nfonts
= try_alternative_families (f
, try_family
, registry
, fonts
);
6401 /* When realizing the default face and a font spec does not matched
6402 exactly, Emacs looks for ones with the same registry as the
6403 default font. On the Mac, this is mac-roman, which does not work
6404 if the family is -etl-fixed, e.g. The following widens the
6405 choices and fixes that problem. */
6406 if (nfonts
== 0 && STRINGP (try_family
) && STRINGP (registry
)
6407 && xstricmp (SDATA (registry
), "mac-roman") == 0)
6408 nfonts
= try_alternative_families (f
, try_family
, Qnil
, fonts
);
6411 if (EQ (try_family
, family
))
6412 family
= face_family
;
6414 if (nfonts
== 0 && STRINGP (family
))
6415 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6417 /* Try font family of the default face or "fixed". */
6420 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6422 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6424 family
= build_string ("fixed");
6425 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6428 /* Try any family with the given registry. */
6430 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6436 /* Return the fontset id of the base fontset name or alias name given
6437 by the fontset attribute of ATTRS. Value is -1 if the fontset
6438 attribute of ATTRS doesn't name a fontset. */
6441 face_fontset (attrs
)
6446 name
= attrs
[LFACE_FONT_INDEX
];
6447 if (!STRINGP (name
))
6449 return fs_query_fontset (name
, 0);
6453 /* Choose a name of font to use on frame F to display character C with
6454 Lisp face attributes specified by ATTRS. The font name is
6455 determined by the font-related attributes in ATTRS and the name
6456 pattern for C in FONTSET. Value is the font name which is
6457 allocated from the heap and must be freed by the caller, or NULL if
6458 we can get no information about the font name of C. It is assured
6459 that we always get some information for a single byte
6462 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6463 indicate whether the resulting font should be drawn using overstrike
6464 to simulate bold-face. */
6467 choose_face_font (f
, attrs
, fontset
, c
, needs_overstrike
)
6471 int *needs_overstrike
;
6473 Lisp_Object pattern
;
6474 char *font_name
= NULL
;
6475 struct font_name
*fonts
;
6476 int nfonts
, width_ratio
;
6478 if (needs_overstrike
)
6479 *needs_overstrike
= 0;
6481 /* Get (foundry and) family name and registry (and encoding) name of
6483 pattern
= fontset_font_pattern (f
, fontset
, c
);
6486 xassert (!SINGLE_BYTE_CHAR_P (c
));
6490 /* If what we got is a name pattern, return it. */
6491 if (STRINGP (pattern
))
6492 return xstrdup (SDATA (pattern
));
6494 /* Get a list of fonts matching that pattern and choose the
6495 best match for the specified face attributes from it. */
6496 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
,
6497 (SINGLE_BYTE_CHAR_P (c
)
6498 || CHAR_CHARSET (c
) == charset_latin_iso8859_1
));
6499 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6501 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6502 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
,
6507 #endif /* HAVE_WINDOW_SYSTEM */
6511 /***********************************************************************
6513 ***********************************************************************/
6515 /* Realize basic faces on frame F. Value is zero if frame parameters
6516 of F don't contain enough information needed to realize the default
6520 realize_basic_faces (f
)
6524 int count
= SPECPDL_INDEX ();
6526 /* Block input here so that we won't be surprised by an X expose
6527 event, for instance, without having the faces set up. */
6529 specbind (Qscalable_fonts_allowed
, Qt
);
6531 if (realize_default_face (f
))
6533 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6534 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6535 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6536 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6537 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6538 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6539 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6540 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6541 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6542 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6544 /* Reflect changes in the `menu' face in menu bars. */
6545 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6547 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6548 #ifdef USE_X_TOOLKIT
6549 x_update_menu_appearance (f
);
6556 unbind_to (count
, Qnil
);
6562 /* Realize the default face on frame F. If the face is not fully
6563 specified, make it fully-specified. Attributes of the default face
6564 that are not explicitly specified are taken from frame parameters. */
6567 realize_default_face (f
)
6570 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6572 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6573 Lisp_Object frame_font
;
6576 /* If the `default' face is not yet known, create it. */
6577 lface
= lface_from_face_name (f
, Qdefault
, 0);
6581 XSETFRAME (frame
, f
);
6582 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6586 #ifdef HAVE_WINDOW_SYSTEM
6587 if (FRAME_WINDOW_P (f
))
6589 /* Set frame_font to the value of the `font' frame parameter. */
6590 frame_font
= Fassq (Qfont
, f
->param_alist
);
6591 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6592 frame_font
= XCDR (frame_font
);
6593 /* Specify 0 for FORCE_P here, so that we don't override
6594 a :family attribute specified for `default' for new frames. */
6595 set_lface_from_font_name (f
, lface
, frame_font
, 0, 1);
6597 #endif /* HAVE_WINDOW_SYSTEM */
6599 if (!FRAME_WINDOW_P (f
))
6601 LFACE_FAMILY (lface
) = build_string ("default");
6602 LFACE_SWIDTH (lface
) = Qnormal
;
6603 LFACE_HEIGHT (lface
) = make_number (1);
6604 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6605 LFACE_WEIGHT (lface
) = Qnormal
;
6606 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6607 LFACE_SLANT (lface
) = Qnormal
;
6608 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6611 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6612 LFACE_UNDERLINE (lface
) = Qnil
;
6614 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6615 LFACE_OVERLINE (lface
) = Qnil
;
6617 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6618 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6620 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6621 LFACE_BOX (lface
) = Qnil
;
6623 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6624 LFACE_INVERSE (lface
) = Qnil
;
6626 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6628 /* This function is called so early that colors are not yet
6629 set in the frame parameter list. */
6630 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6632 if (CONSP (color
) && STRINGP (XCDR (color
)))
6633 LFACE_FOREGROUND (lface
) = XCDR (color
);
6634 else if (FRAME_WINDOW_P (f
))
6636 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6637 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6642 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6644 /* This function is called so early that colors are not yet
6645 set in the frame parameter list. */
6646 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6647 if (CONSP (color
) && STRINGP (XCDR (color
)))
6648 LFACE_BACKGROUND (lface
) = XCDR (color
);
6649 else if (FRAME_WINDOW_P (f
))
6651 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6652 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6657 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6658 LFACE_STIPPLE (lface
) = Qnil
;
6660 /* Realize the face; it must be fully-specified now. */
6661 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6662 check_lface (lface
);
6663 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6664 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6669 /* Realize basic faces other than the default face in face cache C.
6670 SYMBOL is the face name, ID is the face id the realized face must
6671 have. The default face must have been realized already. */
6674 realize_named_face (f
, symbol
, id
)
6679 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6680 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6681 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6682 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6683 struct face
*new_face
;
6685 /* The default face must exist and be fully specified. */
6686 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6687 check_lface_attrs (attrs
);
6688 xassert (lface_fully_specified_p (attrs
));
6690 /* If SYMBOL isn't know as a face, create it. */
6694 XSETFRAME (frame
, f
);
6695 lface
= Finternal_make_lisp_face (symbol
, frame
);
6698 /* Merge SYMBOL's face with the default face. */
6699 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6700 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6702 /* Realize the face. */
6703 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6707 /* Realize the fully-specified face with attributes ATTRS in face
6708 cache CACHE for character C. If C is a multibyte character,
6709 BASE_FACE is a face that has the same attributes. Otherwise,
6710 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6711 ID of face to remove before caching the new face. Value is a
6712 pointer to the newly created realized face. */
6714 static struct face
*
6715 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6716 struct face_cache
*cache
;
6719 struct face
*base_face
;
6724 /* LFACE must be fully specified. */
6725 xassert (cache
!= NULL
);
6726 check_lface_attrs (attrs
);
6728 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6730 /* Remove the former face. */
6731 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6732 uncache_face (cache
, former_face
);
6733 free_realized_face (cache
->f
, former_face
);
6736 if (FRAME_WINDOW_P (cache
->f
))
6737 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6738 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6739 face
= realize_tty_face (cache
, attrs
, c
);
6743 /* Insert the new face. */
6744 cache_face (cache
, face
, lface_hash (attrs
));
6745 #ifdef HAVE_WINDOW_SYSTEM
6746 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6747 load_face_font (cache
->f
, face
, c
);
6748 #endif /* HAVE_WINDOW_SYSTEM */
6753 /* Realize the fully-specified face with attributes ATTRS in face
6754 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6755 a multibyte character, BASE_FACE is a face that has the same
6756 attributes. Otherwise, BASE_FACE is ignored. If the new face
6757 doesn't share font with the default face, a fontname is allocated
6758 from the heap and set in `font_name' of the new face, but it is not
6759 yet loaded here. Value is a pointer to the newly created realized
6762 static struct face
*
6763 realize_x_face (cache
, attrs
, c
, base_face
)
6764 struct face_cache
*cache
;
6767 struct face
*base_face
;
6769 #ifdef HAVE_WINDOW_SYSTEM
6770 struct face
*face
, *default_face
;
6772 Lisp_Object stipple
, overline
, strike_through
, box
;
6774 xassert (FRAME_WINDOW_P (cache
->f
));
6775 xassert (SINGLE_BYTE_CHAR_P (c
)
6778 /* Allocate a new realized face. */
6779 face
= make_realized_face (attrs
);
6783 /* If C is a multibyte character, we share all face attirbutes with
6784 BASE_FACE including the realized fontset. But, we must load a
6786 if (!SINGLE_BYTE_CHAR_P (c
))
6788 bcopy (base_face
, face
, sizeof *face
);
6791 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6792 face
->colors_copied_bitwise_p
= 1;
6794 /* to force realize_face to load font */
6799 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6801 /* Determine the font to use. Most of the time, the font will be
6802 the same as the font of the default face, so try that first. */
6803 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6805 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6806 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6808 face
->font
= default_face
->font
;
6809 face
->fontset
= default_face
->fontset
;
6810 face
->font_info_id
= default_face
->font_info_id
;
6811 face
->font_name
= default_face
->font_name
;
6812 face
->ascii_face
= face
;
6814 /* But, as we can't share the fontset, make a new realized
6815 fontset that has the same base fontset as of the default
6818 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6822 /* If the face attribute ATTRS specifies a fontset, use it as
6823 the base of a new realized fontset. Otherwise, use the same
6824 base fontset as of the default face. The base determines
6825 registry and encoding of a font. It may also determine
6826 foundry and family. The other fields of font name pattern
6827 are constructed from ATTRS. */
6828 int fontset
= face_fontset (attrs
);
6830 if ((fontset
== -1) && default_face
)
6831 fontset
= default_face
->fontset
;
6832 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6833 face
->font
= NULL
; /* to force realize_face to load font */
6836 /* Load colors, and set remaining attributes. */
6838 load_face_colors (f
, face
, attrs
);
6841 box
= attrs
[LFACE_BOX_INDEX
];
6844 /* A simple box of line width 1 drawn in color given by
6846 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6848 face
->box
= FACE_SIMPLE_BOX
;
6849 face
->box_line_width
= 1;
6851 else if (INTEGERP (box
))
6853 /* Simple box of specified line width in foreground color of the
6855 xassert (XINT (box
) != 0);
6856 face
->box
= FACE_SIMPLE_BOX
;
6857 face
->box_line_width
= XINT (box
);
6858 face
->box_color
= face
->foreground
;
6859 face
->box_color_defaulted_p
= 1;
6861 else if (CONSP (box
))
6863 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6864 being one of `raised' or `sunken'. */
6865 face
->box
= FACE_SIMPLE_BOX
;
6866 face
->box_color
= face
->foreground
;
6867 face
->box_color_defaulted_p
= 1;
6868 face
->box_line_width
= 1;
6872 Lisp_Object keyword
, value
;
6874 keyword
= XCAR (box
);
6882 if (EQ (keyword
, QCline_width
))
6884 if (INTEGERP (value
) && XINT (value
) != 0)
6885 face
->box_line_width
= XINT (value
);
6887 else if (EQ (keyword
, QCcolor
))
6889 if (STRINGP (value
))
6891 face
->box_color
= load_color (f
, face
, value
,
6893 face
->use_box_color_for_shadows_p
= 1;
6896 else if (EQ (keyword
, QCstyle
))
6898 if (EQ (value
, Qreleased_button
))
6899 face
->box
= FACE_RAISED_BOX
;
6900 else if (EQ (value
, Qpressed_button
))
6901 face
->box
= FACE_SUNKEN_BOX
;
6906 /* Text underline, overline, strike-through. */
6908 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6910 /* Use default color (same as foreground color). */
6911 face
->underline_p
= 1;
6912 face
->underline_defaulted_p
= 1;
6913 face
->underline_color
= 0;
6915 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6917 /* Use specified color. */
6918 face
->underline_p
= 1;
6919 face
->underline_defaulted_p
= 0;
6920 face
->underline_color
6921 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6922 LFACE_UNDERLINE_INDEX
);
6924 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6926 face
->underline_p
= 0;
6927 face
->underline_defaulted_p
= 0;
6928 face
->underline_color
= 0;
6931 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6932 if (STRINGP (overline
))
6934 face
->overline_color
6935 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6936 LFACE_OVERLINE_INDEX
);
6937 face
->overline_p
= 1;
6939 else if (EQ (overline
, Qt
))
6941 face
->overline_color
= face
->foreground
;
6942 face
->overline_color_defaulted_p
= 1;
6943 face
->overline_p
= 1;
6946 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6947 if (STRINGP (strike_through
))
6949 face
->strike_through_color
6950 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6951 LFACE_STRIKE_THROUGH_INDEX
);
6952 face
->strike_through_p
= 1;
6954 else if (EQ (strike_through
, Qt
))
6956 face
->strike_through_color
= face
->foreground
;
6957 face
->strike_through_color_defaulted_p
= 1;
6958 face
->strike_through_p
= 1;
6961 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6962 if (!NILP (stipple
))
6963 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6965 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6967 #endif /* HAVE_WINDOW_SYSTEM */
6971 /* Map a specified color of face FACE on frame F to a tty color index.
6972 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6973 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6974 default foreground/background colors. */
6977 map_tty_color (f
, face
, idx
, defaulted
)
6980 enum lface_attribute_index idx
;
6983 Lisp_Object frame
, color
, def
;
6984 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6985 unsigned long default_pixel
, default_other_pixel
, pixel
;
6987 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6991 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6992 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6996 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6997 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7000 XSETFRAME (frame
, f
);
7001 color
= face
->lface
[idx
];
7005 && CONSP (Vtty_defined_color_alist
)
7006 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7009 /* Associations in tty-defined-color-alist are of the form
7010 (NAME INDEX R G B). We need the INDEX part. */
7011 pixel
= XINT (XCAR (XCDR (def
)));
7014 if (pixel
== default_pixel
&& STRINGP (color
))
7016 pixel
= load_color (f
, face
, color
, idx
);
7018 #if defined (MSDOS) || defined (WINDOWSNT)
7019 /* If the foreground of the default face is the default color,
7020 use the foreground color defined by the frame. */
7022 if (FRAME_MSDOS_P (f
))
7025 if (pixel
== default_pixel
7026 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7029 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7031 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7032 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7035 else if (pixel
== default_other_pixel
)
7038 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7040 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7041 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7047 #endif /* MSDOS or WINDOWSNT */
7051 face
->foreground
= pixel
;
7053 face
->background
= pixel
;
7057 /* Realize the fully-specified face with attributes ATTRS in face
7058 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7059 pointer to the newly created realized face. */
7061 static struct face
*
7062 realize_tty_face (cache
, attrs
, c
)
7063 struct face_cache
*cache
;
7069 int face_colors_defaulted
= 0;
7070 struct frame
*f
= cache
->f
;
7072 /* Frame must be a termcap frame. */
7073 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7075 /* Allocate a new realized face. */
7076 face
= make_realized_face (attrs
);
7077 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7079 /* Map face attributes to TTY appearances. We map slant to
7080 dimmed text because we want italic text to appear differently
7081 and because dimmed text is probably used infrequently. */
7082 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7083 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7085 if (weight
> XLFD_WEIGHT_MEDIUM
)
7086 face
->tty_bold_p
= 1;
7087 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7088 face
->tty_dim_p
= 1;
7089 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7090 face
->tty_underline_p
= 1;
7091 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7092 face
->tty_reverse_p
= 1;
7094 /* Map color names to color indices. */
7095 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7096 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7098 /* Swap colors if face is inverse-video. If the colors are taken
7099 from the frame colors, they are already inverted, since the
7100 frame-creation function calls x-handle-reverse-video. */
7101 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7103 unsigned long tem
= face
->foreground
;
7104 face
->foreground
= face
->background
;
7105 face
->background
= tem
;
7108 if (tty_suppress_bold_inverse_default_colors_p
7110 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7111 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7112 face
->tty_bold_p
= 0;
7118 DEFUN ("tty-suppress-bold-inverse-default-colors",
7119 Ftty_suppress_bold_inverse_default_colors
,
7120 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7121 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7122 SUPPRESS non-nil means suppress it.
7123 This affects bold faces on TTYs whose foreground is the default background
7124 color of the display and whose background is the default foreground color.
7125 For such faces, the bold face attribute is ignored if this variable
7128 Lisp_Object suppress
;
7130 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7131 ++face_change_count
;
7137 /***********************************************************************
7139 ***********************************************************************/
7141 /* Return the ID of the face to use to display character CH with face
7142 property PROP on frame F in current_buffer. */
7145 compute_char_face (f
, ch
, prop
)
7152 if (NILP (current_buffer
->enable_multibyte_characters
))
7157 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7158 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7162 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7163 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7164 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7165 merge_face_vector_with_property (f
, attrs
, prop
);
7166 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
7172 /* Return the face ID associated with buffer position POS for
7173 displaying ASCII characters. Return in *ENDPTR the position at
7174 which a different face is needed, as far as text properties and
7175 overlays are concerned. W is a window displaying current_buffer.
7177 REGION_BEG, REGION_END delimit the region, so it can be
7180 LIMIT is a position not to scan beyond. That is to limit the time
7181 this function can take.
7183 If MOUSE is non-zero, use the character's mouse-face, not its face.
7185 The face returned is suitable for displaying ASCII characters. */
7188 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7189 endptr
, limit
, mouse
)
7192 int region_beg
, region_end
;
7197 struct frame
*f
= XFRAME (w
->frame
);
7198 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7199 Lisp_Object prop
, position
;
7201 Lisp_Object
*overlay_vec
;
7204 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7205 Lisp_Object limit1
, end
;
7206 struct face
*default_face
;
7208 /* W must display the current buffer. We could write this function
7209 to use the frame and buffer of W, but right now it doesn't. */
7210 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7212 XSETFRAME (frame
, f
);
7213 XSETFASTINT (position
, pos
);
7216 if (pos
< region_beg
&& region_beg
< endpos
)
7217 endpos
= region_beg
;
7219 /* Get the `face' or `mouse_face' text property at POS, and
7220 determine the next position at which the property changes. */
7221 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7222 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7223 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7225 endpos
= XINT (end
);
7227 /* Look at properties from overlays. */
7232 /* First try with room for 40 overlays. */
7234 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7235 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7236 &next_overlay
, NULL
, 0);
7238 /* If there are more than 40, make enough space for all, and try
7240 if (noverlays
> len
)
7243 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7244 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7245 &next_overlay
, NULL
, 0);
7248 if (next_overlay
< endpos
)
7249 endpos
= next_overlay
;
7254 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7256 /* Optimize common cases where we can use the default face. */
7259 && !(pos
>= region_beg
&& pos
< region_end
))
7260 return DEFAULT_FACE_ID
;
7262 /* Begin with attributes from the default face. */
7263 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7265 /* Merge in attributes specified via text properties. */
7267 merge_face_vector_with_property (f
, attrs
, prop
);
7269 /* Now merge the overlay data. */
7270 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7271 for (i
= 0; i
< noverlays
; i
++)
7276 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7278 merge_face_vector_with_property (f
, attrs
, prop
);
7280 oend
= OVERLAY_END (overlay_vec
[i
]);
7281 oendpos
= OVERLAY_POSITION (oend
);
7282 if (oendpos
< endpos
)
7286 /* If in the region, merge in the region face. */
7287 if (pos
>= region_beg
&& pos
< region_end
)
7289 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7290 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7292 if (region_end
< endpos
)
7293 endpos
= region_end
;
7298 /* Look up a realized face with the given face attributes,
7299 or realize a new one for ASCII characters. */
7300 return lookup_face (f
, attrs
, 0, NULL
);
7304 /* Compute the face at character position POS in Lisp string STRING on
7305 window W, for ASCII characters.
7307 If STRING is an overlay string, it comes from position BUFPOS in
7308 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7309 not an overlay string. W must display the current buffer.
7310 REGION_BEG and REGION_END give the start and end positions of the
7311 region; both are -1 if no region is visible.
7313 BASE_FACE_ID is the id of a face to merge with. For strings coming
7314 from overlays or the `display' property it is the face at BUFPOS.
7316 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7318 Set *ENDPTR to the next position where to check for faces in
7319 STRING; -1 if the face is constant from POS to the end of the
7322 Value is the id of the face to use. The face returned is suitable
7323 for displaying ASCII characters. */
7326 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7327 region_end
, endptr
, base_face_id
, mouse_p
)
7331 int region_beg
, region_end
;
7333 enum face_id base_face_id
;
7336 Lisp_Object prop
, position
, end
, limit
;
7337 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7338 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7339 struct face
*base_face
;
7340 int multibyte_p
= STRING_MULTIBYTE (string
);
7341 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7343 /* Get the value of the face property at the current position within
7344 STRING. Value is nil if there is no face property. */
7345 XSETFASTINT (position
, pos
);
7346 prop
= Fget_text_property (position
, prop_name
, string
);
7348 /* Get the next position at which to check for faces. Value of end
7349 is nil if face is constant all the way to the end of the string.
7350 Otherwise it is a string position where to check faces next.
7351 Limit is the maximum position up to which to check for property
7352 changes in Fnext_single_property_change. Strings are usually
7353 short, so set the limit to the end of the string. */
7354 XSETFASTINT (limit
, SCHARS (string
));
7355 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7357 *endptr
= XFASTINT (end
);
7361 base_face
= FACE_FROM_ID (f
, base_face_id
);
7362 xassert (base_face
);
7364 /* Optimize the default case that there is no face property and we
7365 are not in the region. */
7367 && (base_face_id
!= DEFAULT_FACE_ID
7368 /* BUFPOS <= 0 means STRING is not an overlay string, so
7369 that the region doesn't have to be taken into account. */
7371 || bufpos
< region_beg
7372 || bufpos
>= region_end
)
7374 /* We can't realize faces for different charsets differently
7375 if we don't have fonts, so we can stop here if not working
7376 on a window-system frame. */
7377 || !FRAME_WINDOW_P (f
)
7378 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7379 return base_face
->id
;
7381 /* Begin with attributes from the base face. */
7382 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7384 /* Merge in attributes specified via text properties. */
7386 merge_face_vector_with_property (f
, attrs
, prop
);
7388 /* If in the region, merge in the region face. */
7390 && bufpos
>= region_beg
7391 && bufpos
< region_end
)
7393 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7394 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7397 /* Look up a realized face with the given face attributes,
7398 or realize a new one for ASCII characters. */
7399 return lookup_face (f
, attrs
, 0, NULL
);
7404 /***********************************************************************
7406 ***********************************************************************/
7410 /* Print the contents of the realized face FACE to stderr. */
7413 dump_realized_face (face
)
7416 fprintf (stderr
, "ID: %d\n", face
->id
);
7417 #ifdef HAVE_X_WINDOWS
7418 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7420 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7422 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7423 fprintf (stderr
, "background: 0x%lx (%s)\n",
7425 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7426 fprintf (stderr
, "font_name: %s (%s)\n",
7428 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7429 #ifdef HAVE_X_WINDOWS
7430 fprintf (stderr
, "font = %p\n", face
->font
);
7432 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7433 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7434 fprintf (stderr
, "underline: %d (%s)\n",
7436 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7437 fprintf (stderr
, "hash: %d\n", face
->hash
);
7438 fprintf (stderr
, "charset: %d\n", face
->charset
);
7442 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7450 fprintf (stderr
, "font selection order: ");
7451 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7452 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7453 fprintf (stderr
, "\n");
7455 fprintf (stderr
, "alternative fonts: ");
7456 debug_print (Vface_alternative_font_family_alist
);
7457 fprintf (stderr
, "\n");
7459 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7460 Fdump_face (make_number (i
));
7466 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7468 error ("Not a valid face");
7469 dump_realized_face (face
);
7476 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7477 0, 0, 0, doc
: /* */)
7480 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7481 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7482 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7486 #endif /* GLYPH_DEBUG != 0 */
7490 /***********************************************************************
7492 ***********************************************************************/
7497 Qface
= intern ("face");
7499 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7500 staticpro (&Qbitmap_spec_p
);
7501 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7502 staticpro (&Qframe_update_face_colors
);
7504 /* Lisp face attribute keywords. */
7505 QCfamily
= intern (":family");
7506 staticpro (&QCfamily
);
7507 QCheight
= intern (":height");
7508 staticpro (&QCheight
);
7509 QCweight
= intern (":weight");
7510 staticpro (&QCweight
);
7511 QCslant
= intern (":slant");
7512 staticpro (&QCslant
);
7513 QCunderline
= intern (":underline");
7514 staticpro (&QCunderline
);
7515 QCinverse_video
= intern (":inverse-video");
7516 staticpro (&QCinverse_video
);
7517 QCreverse_video
= intern (":reverse-video");
7518 staticpro (&QCreverse_video
);
7519 QCforeground
= intern (":foreground");
7520 staticpro (&QCforeground
);
7521 QCbackground
= intern (":background");
7522 staticpro (&QCbackground
);
7523 QCstipple
= intern (":stipple");;
7524 staticpro (&QCstipple
);
7525 QCwidth
= intern (":width");
7526 staticpro (&QCwidth
);
7527 QCfont
= intern (":font");
7528 staticpro (&QCfont
);
7529 QCbold
= intern (":bold");
7530 staticpro (&QCbold
);
7531 QCitalic
= intern (":italic");
7532 staticpro (&QCitalic
);
7533 QCoverline
= intern (":overline");
7534 staticpro (&QCoverline
);
7535 QCstrike_through
= intern (":strike-through");
7536 staticpro (&QCstrike_through
);
7537 QCbox
= intern (":box");
7539 QCinherit
= intern (":inherit");
7540 staticpro (&QCinherit
);
7542 /* Symbols used for Lisp face attribute values. */
7543 QCcolor
= intern (":color");
7544 staticpro (&QCcolor
);
7545 QCline_width
= intern (":line-width");
7546 staticpro (&QCline_width
);
7547 QCstyle
= intern (":style");
7548 staticpro (&QCstyle
);
7549 Qreleased_button
= intern ("released-button");
7550 staticpro (&Qreleased_button
);
7551 Qpressed_button
= intern ("pressed-button");
7552 staticpro (&Qpressed_button
);
7553 Qnormal
= intern ("normal");
7554 staticpro (&Qnormal
);
7555 Qultra_light
= intern ("ultra-light");
7556 staticpro (&Qultra_light
);
7557 Qextra_light
= intern ("extra-light");
7558 staticpro (&Qextra_light
);
7559 Qlight
= intern ("light");
7560 staticpro (&Qlight
);
7561 Qsemi_light
= intern ("semi-light");
7562 staticpro (&Qsemi_light
);
7563 Qsemi_bold
= intern ("semi-bold");
7564 staticpro (&Qsemi_bold
);
7565 Qbold
= intern ("bold");
7567 Qextra_bold
= intern ("extra-bold");
7568 staticpro (&Qextra_bold
);
7569 Qultra_bold
= intern ("ultra-bold");
7570 staticpro (&Qultra_bold
);
7571 Qoblique
= intern ("oblique");
7572 staticpro (&Qoblique
);
7573 Qitalic
= intern ("italic");
7574 staticpro (&Qitalic
);
7575 Qreverse_oblique
= intern ("reverse-oblique");
7576 staticpro (&Qreverse_oblique
);
7577 Qreverse_italic
= intern ("reverse-italic");
7578 staticpro (&Qreverse_italic
);
7579 Qultra_condensed
= intern ("ultra-condensed");
7580 staticpro (&Qultra_condensed
);
7581 Qextra_condensed
= intern ("extra-condensed");
7582 staticpro (&Qextra_condensed
);
7583 Qcondensed
= intern ("condensed");
7584 staticpro (&Qcondensed
);
7585 Qsemi_condensed
= intern ("semi-condensed");
7586 staticpro (&Qsemi_condensed
);
7587 Qsemi_expanded
= intern ("semi-expanded");
7588 staticpro (&Qsemi_expanded
);
7589 Qexpanded
= intern ("expanded");
7590 staticpro (&Qexpanded
);
7591 Qextra_expanded
= intern ("extra-expanded");
7592 staticpro (&Qextra_expanded
);
7593 Qultra_expanded
= intern ("ultra-expanded");
7594 staticpro (&Qultra_expanded
);
7595 Qbackground_color
= intern ("background-color");
7596 staticpro (&Qbackground_color
);
7597 Qforeground_color
= intern ("foreground-color");
7598 staticpro (&Qforeground_color
);
7599 Qunspecified
= intern ("unspecified");
7600 staticpro (&Qunspecified
);
7602 Qface_alias
= intern ("face-alias");
7603 staticpro (&Qface_alias
);
7604 Qdefault
= intern ("default");
7605 staticpro (&Qdefault
);
7606 Qtool_bar
= intern ("tool-bar");
7607 staticpro (&Qtool_bar
);
7608 Qregion
= intern ("region");
7609 staticpro (&Qregion
);
7610 Qfringe
= intern ("fringe");
7611 staticpro (&Qfringe
);
7612 Qheader_line
= intern ("header-line");
7613 staticpro (&Qheader_line
);
7614 Qscroll_bar
= intern ("scroll-bar");
7615 staticpro (&Qscroll_bar
);
7616 Qmenu
= intern ("menu");
7618 Qcursor
= intern ("cursor");
7619 staticpro (&Qcursor
);
7620 Qborder
= intern ("border");
7621 staticpro (&Qborder
);
7622 Qmouse
= intern ("mouse");
7623 staticpro (&Qmouse
);
7624 Qmode_line_inactive
= intern ("mode-line-inactive");
7625 staticpro (&Qmode_line_inactive
);
7626 Qtty_color_desc
= intern ("tty-color-desc");
7627 staticpro (&Qtty_color_desc
);
7628 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7629 staticpro (&Qtty_color_standard_values
);
7630 Qtty_color_by_index
= intern ("tty-color-by-index");
7631 staticpro (&Qtty_color_by_index
);
7632 Qtty_color_alist
= intern ("tty-color-alist");
7633 staticpro (&Qtty_color_alist
);
7634 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7635 staticpro (&Qscalable_fonts_allowed
);
7637 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7638 staticpro (&Vparam_value_alist
);
7639 Vface_alternative_font_family_alist
= Qnil
;
7640 staticpro (&Vface_alternative_font_family_alist
);
7641 Vface_alternative_font_registry_alist
= Qnil
;
7642 staticpro (&Vface_alternative_font_registry_alist
);
7644 defsubr (&Sinternal_make_lisp_face
);
7645 defsubr (&Sinternal_lisp_face_p
);
7646 defsubr (&Sinternal_set_lisp_face_attribute
);
7647 #ifdef HAVE_WINDOW_SYSTEM
7648 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7650 defsubr (&Scolor_gray_p
);
7651 defsubr (&Scolor_supported_p
);
7652 defsubr (&Sface_attribute_relative_p
);
7653 defsubr (&Smerge_face_attribute
);
7654 defsubr (&Sinternal_get_lisp_face_attribute
);
7655 defsubr (&Sinternal_lisp_face_attribute_values
);
7656 defsubr (&Sinternal_lisp_face_equal_p
);
7657 defsubr (&Sinternal_lisp_face_empty_p
);
7658 defsubr (&Sinternal_copy_lisp_face
);
7659 defsubr (&Sinternal_merge_in_global_face
);
7660 defsubr (&Sface_font
);
7661 defsubr (&Sframe_face_alist
);
7662 defsubr (&Stty_supports_face_attributes_p
);
7663 defsubr (&Scolor_distance
);
7664 defsubr (&Sinternal_set_font_selection_order
);
7665 defsubr (&Sinternal_set_alternative_font_family_alist
);
7666 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7667 defsubr (&Sface_attributes_as_vector
);
7669 defsubr (&Sdump_face
);
7670 defsubr (&Sshow_face_resources
);
7671 #endif /* GLYPH_DEBUG */
7672 defsubr (&Sclear_face_cache
);
7673 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7675 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7676 defsubr (&Sdump_colors
);
7679 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7680 doc
: /* *Limit for font matching.
7681 If an integer > 0, font matching functions won't load more than
7682 that number of fonts when searching for a matching font. */);
7683 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7685 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7686 doc
: /* List of global face definitions (for internal use only.) */);
7687 Vface_new_frame_defaults
= Qnil
;
7689 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7690 doc
: /* *Default stipple pattern used on monochrome displays.
7691 This stipple pattern is used on monochrome displays
7692 instead of shades of gray for a face background color.
7693 See `set-face-stipple' for possible values for this variable. */);
7694 Vface_default_stipple
= build_string ("gray3");
7696 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7697 doc
: /* An alist of defined terminal colors and their RGB values. */);
7698 Vtty_defined_color_alist
= Qnil
;
7700 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7701 doc
: /* Allowed scalable fonts.
7702 A value of nil means don't allow any scalable fonts.
7703 A value of t means allow any scalable font.
7704 Otherwise, value must be a list of regular expressions. A font may be
7705 scaled if its name matches a regular expression in the list.
7706 Note that if value is nil, a scalable font might still be used, if no
7707 other font of the appropriate family and registry is available. */);
7708 Vscalable_fonts_allowed
= Qnil
;
7710 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7711 doc
: /* List of ignored fonts.
7712 Each element is a regular expression that matches names of fonts to
7714 Vface_ignored_fonts
= Qnil
;
7716 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7717 doc
: /* Alist of fonts vs the rescaling factors.
7718 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7719 FONT-NAME-PATTERN is a regular expression matching a font name, and
7720 RESCALE-RATIO is a floating point number to specify how much larger
7721 \(or smaller) font we should use. For instance, if a face requests
7722 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7723 Vface_font_rescale_alist
= Qnil
;
7725 #ifdef HAVE_WINDOW_SYSTEM
7726 defsubr (&Sbitmap_spec_p
);
7727 defsubr (&Sx_list_fonts
);
7728 defsubr (&Sinternal_face_x_get_resource
);
7729 defsubr (&Sx_family_fonts
);
7730 defsubr (&Sx_font_family_list
);
7731 #endif /* HAVE_WINDOW_SYSTEM */