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. */
196 #include <sys/types.h>
197 #include <sys/stat.h>
198 #include <stdio.h> /* This needs to be before termchar.h */
202 #include "keyboard.h"
204 #include "termhooks.h"
206 #ifdef HAVE_WINDOW_SYSTEM
208 #endif /* HAVE_WINDOW_SYSTEM */
210 #ifdef HAVE_X_WINDOWS
214 #include <Xm/XmStrDefs.h>
215 #endif /* USE_MOTIF */
216 #endif /* HAVE_X_WINDOWS */
225 /* Redefine X specifics to W32 equivalents to avoid cluttering the
226 code with #ifdef blocks. */
227 #undef FRAME_X_DISPLAY_INFO
228 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
229 #define x_display_info w32_display_info
230 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
231 #define check_x check_w32
232 #define x_list_fonts w32_list_fonts
233 #define GCGraphicsExposures 0
234 #endif /* WINDOWSNT */
238 #define x_display_info mac_display_info
239 #define check_x check_mac
243 #include "dispextern.h"
244 #include "blockinput.h"
246 #include "intervals.h"
247 #include "termchar.h"
249 #ifdef HAVE_X_WINDOWS
251 /* Compensate for a bug in Xos.h on some systems, on which it requires
252 time.h. On some such systems, Xos.h tries to redefine struct
253 timeval and struct timezone if USG is #defined while it is
256 #ifdef XOS_NEEDS_TIME_H
262 #else /* not XOS_NEEDS_TIME_H */
264 #endif /* not XOS_NEEDS_TIME_H */
266 #endif /* HAVE_X_WINDOWS */
270 #define abs(X) ((X) < 0 ? -(X) : (X))
272 /* Number of pt per inch (from the TeXbook). */
274 #define PT_PER_INCH 72.27
276 /* Non-zero if face attribute ATTR is unspecified. */
278 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
280 /* Value is the number of elements of VECTOR. */
282 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
284 /* Make a copy of string S on the stack using alloca. Value is a pointer
287 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
289 /* Make a copy of the contents of Lisp string S on the stack using
290 alloca. Value is a pointer to the copy. */
292 #define LSTRDUPA(S) STRDUPA (SDATA ((S)))
294 /* Size of hash table of realized faces in face caches (should be a
297 #define FACE_CACHE_BUCKETS_SIZE 1001
299 /* Keyword symbols used for face attribute names. */
301 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
302 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
303 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
304 Lisp_Object QCreverse_video
;
305 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
307 /* Symbols used for attribute values. */
309 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
310 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
311 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
312 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
313 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
314 Lisp_Object Qultra_expanded
;
315 Lisp_Object Qreleased_button
, Qpressed_button
;
316 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
317 Lisp_Object Qunspecified
;
319 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
321 /* The name of the function to call when the background of the frame
322 has changed, frame_update_face_colors. */
324 Lisp_Object Qframe_update_face_colors
;
326 /* Names of basic faces. */
328 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
329 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
330 Lisp_Object Qmode_line_inactive
;
331 extern Lisp_Object Qmode_line
;
333 /* The symbol `face-alias'. A symbols having that property is an
334 alias for another face. Value of the property is the name of
337 Lisp_Object Qface_alias
;
339 /* Default stipple pattern used on monochrome displays. This stipple
340 pattern is used on monochrome displays instead of shades of gray
341 for a face background color. See `set-face-stipple' for possible
342 values for this variable. */
344 Lisp_Object Vface_default_stipple
;
346 /* Alist of alternative font families. Each element is of the form
347 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
348 try FAMILY1, then FAMILY2, ... */
350 Lisp_Object Vface_alternative_font_family_alist
;
352 /* Alist of alternative font registries. Each element is of the form
353 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
354 loaded, try REGISTRY1, then REGISTRY2, ... */
356 Lisp_Object Vface_alternative_font_registry_alist
;
358 /* Allowed scalable fonts. A value of nil means don't allow any
359 scalable fonts. A value of t means allow the use of any scalable
360 font. Otherwise, value must be a list of regular expressions. A
361 font may be scaled if its name matches a regular expression in the
364 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
366 /* List of regular expressions that matches names of fonts to ignore. */
368 Lisp_Object Vface_ignored_fonts
;
370 /* Alist of font name patterns vs the rescaling factor. */
372 Lisp_Object Vface_font_rescale_alist
;
374 /* Maximum number of fonts to consider in font_list. If not an
375 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
377 Lisp_Object Vfont_list_limit
;
378 #define DEFAULT_FONT_LIST_LIMIT 100
380 /* The symbols `foreground-color' and `background-color' which can be
381 used as part of a `face' property. This is for compatibility with
384 Lisp_Object Qforeground_color
, Qbackground_color
;
386 /* The symbols `face' and `mouse-face' used as text properties. */
389 extern Lisp_Object Qmouse_face
;
391 /* Error symbol for wrong_type_argument in load_pixmap. */
393 Lisp_Object Qbitmap_spec_p
;
395 /* Alist of global face definitions. Each element is of the form
396 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
397 is a Lisp vector of face attributes. These faces are used
398 to initialize faces for new frames. */
400 Lisp_Object Vface_new_frame_defaults
;
402 /* The next ID to assign to Lisp faces. */
404 static int next_lface_id
;
406 /* A vector mapping Lisp face Id's to face names. */
408 static Lisp_Object
*lface_id_to_name
;
409 static int lface_id_to_name_size
;
411 /* TTY color-related functions (defined in tty-colors.el). */
413 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
, Qtty_color_standard_values
;
415 /* The name of the function used to compute colors on TTYs. */
417 Lisp_Object Qtty_color_alist
;
419 /* An alist of defined terminal colors and their RGB values. */
421 Lisp_Object Vtty_defined_color_alist
;
423 /* Counter for calls to clear_face_cache. If this counter reaches
424 CLEAR_FONT_TABLE_COUNT, and a frame has more than
425 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
427 static int clear_font_table_count
;
428 #define CLEAR_FONT_TABLE_COUNT 100
429 #define CLEAR_FONT_TABLE_NFONTS 10
431 /* Non-zero means face attributes have been changed since the last
432 redisplay. Used in redisplay_internal. */
434 int face_change_count
;
436 /* Non-zero means don't display bold text if a face's foreground
437 and background colors are the inverse of the default colors of the
438 display. This is a kluge to suppress `bold black' foreground text
439 which is hard to read on an LCD monitor. */
441 int tty_suppress_bold_inverse_default_colors_p
;
443 /* A list of the form `((x . y))' used to avoid consing in
444 Finternal_set_lisp_face_attribute. */
446 static Lisp_Object Vparam_value_alist
;
448 /* The total number of colors currently allocated. */
451 static int ncolors_allocated
;
452 static int npixmaps_allocated
;
456 /* Non-zero means the definition of the `menu' face for new frames has
459 int menu_face_changed_default
;
462 /* Function prototypes. */
467 static void map_tty_color
P_ ((struct frame
*, struct face
*,
468 enum lface_attribute_index
, int *));
469 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
470 static int may_use_scalable_font_p
P_ ((const char *));
471 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
472 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
474 static int x_face_list_fonts
P_ ((struct frame
*, char *,
475 struct font_name
**, int, int));
476 static int font_scalable_p
P_ ((struct font_name
*));
477 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
478 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
479 static unsigned char *xstrlwr
P_ ((unsigned char *));
480 static void signal_error
P_ ((char *, Lisp_Object
));
481 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
482 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
483 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
484 static void free_face_colors
P_ ((struct frame
*, struct face
*));
485 static int face_color_gray_p
P_ ((struct frame
*, char *));
486 static char *build_font_name
P_ ((struct font_name
*));
487 static void free_font_names
P_ ((struct font_name
*, int));
488 static int sorted_font_list
P_ ((struct frame
*, char *,
489 int (*cmpfn
) P_ ((const void *, const void *)),
490 struct font_name
**));
491 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
492 Lisp_Object
, struct font_name
**));
493 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
494 Lisp_Object
, struct font_name
**));
495 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
496 Lisp_Object
, Lisp_Object
, struct font_name
**,
498 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
499 Lisp_Object
, struct font_name
**));
500 static int cmp_font_names
P_ ((const void *, const void *));
501 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
502 struct face
*, int));
503 static struct face
*realize_x_face
P_ ((struct face_cache
*,
504 Lisp_Object
*, int, struct face
*));
505 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
506 Lisp_Object
*, int));
507 static int realize_basic_faces
P_ ((struct frame
*));
508 static int realize_default_face
P_ ((struct frame
*));
509 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
510 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
511 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
512 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
513 static unsigned lface_hash
P_ ((Lisp_Object
*));
514 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
515 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
516 static void free_realized_face
P_ ((struct frame
*, struct face
*));
517 static void clear_face_gcs
P_ ((struct face_cache
*));
518 static void free_face_cache
P_ ((struct face_cache
*));
519 static int face_numeric_weight
P_ ((Lisp_Object
));
520 static int face_numeric_slant
P_ ((Lisp_Object
));
521 static int face_numeric_swidth
P_ ((Lisp_Object
));
522 static int face_fontset
P_ ((Lisp_Object
*));
523 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int, int*));
524 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
525 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
526 Lisp_Object
*, Lisp_Object
));
527 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
529 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
530 Lisp_Object
, int, int));
531 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
532 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
533 static void free_realized_faces
P_ ((struct face_cache
*));
534 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
535 struct font_name
*, int, int, int *));
536 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
537 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
538 static int xlfd_numeric_slant
P_ ((struct font_name
*));
539 static int xlfd_numeric_weight
P_ ((struct font_name
*));
540 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
541 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
542 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
543 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
544 static int xlfd_fixed_p
P_ ((struct font_name
*));
545 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
547 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
548 struct font_name
*, int,
550 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
551 struct font_name
*, int));
553 #ifdef HAVE_WINDOW_SYSTEM
555 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
556 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
557 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
558 int (*cmpfn
) P_ ((const void *, const void *))));
559 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
560 static void x_free_gc
P_ ((struct frame
*, GC
));
561 static void clear_font_table
P_ ((struct x_display_info
*));
564 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
565 #endif /* WINDOWSNT */
568 static void x_update_menu_appearance
P_ ((struct frame
*));
570 extern void free_frame_menubar
P_ ((struct frame
*));
571 #endif /* USE_X_TOOLKIT */
573 #endif /* HAVE_WINDOW_SYSTEM */
576 /***********************************************************************
578 ***********************************************************************/
580 #ifdef HAVE_X_WINDOWS
582 #ifdef DEBUG_X_COLORS
584 /* The following is a poor mans infrastructure for debugging X color
585 allocation problems on displays with PseudoColor-8. Some X servers
586 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
587 color reference counts completely so that they don't signal an
588 error when a color is freed whose reference count is already 0.
589 Other X servers do. To help me debug this, the following code
590 implements a simple reference counting schema of its own, for a
591 single display/screen. --gerd. */
593 /* Reference counts for pixel colors. */
595 int color_count
[256];
597 /* Register color PIXEL as allocated. */
600 register_color (pixel
)
603 xassert (pixel
< 256);
604 ++color_count
[pixel
];
608 /* Register color PIXEL as deallocated. */
611 unregister_color (pixel
)
614 xassert (pixel
< 256);
615 if (color_count
[pixel
] > 0)
616 --color_count
[pixel
];
622 /* Register N colors from PIXELS as deallocated. */
625 unregister_colors (pixels
, n
)
626 unsigned long *pixels
;
630 for (i
= 0; i
< n
; ++i
)
631 unregister_color (pixels
[i
]);
635 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
636 doc
: /* Dump currently allocated colors to stderr. */)
641 fputc ('\n', stderr
);
643 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
646 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
649 fputc ('\n', stderr
);
651 fputc ('\t', stderr
);
655 fputc ('\n', stderr
);
659 #endif /* DEBUG_X_COLORS */
662 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
663 color values. Interrupt input must be blocked when this function
667 x_free_colors (f
, pixels
, npixels
)
669 unsigned long *pixels
;
672 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
674 /* If display has an immutable color map, freeing colors is not
675 necessary and some servers don't allow it. So don't do it. */
676 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
678 #ifdef DEBUG_X_COLORS
679 unregister_colors (pixels
, npixels
);
681 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
687 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
688 color values. Interrupt input must be blocked when this function
692 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
696 unsigned long *pixels
;
699 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
700 int class = dpyinfo
->visual
->class;
702 /* If display has an immutable color map, freeing colors is not
703 necessary and some servers don't allow it. So don't do it. */
704 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
706 #ifdef DEBUG_X_COLORS
707 unregister_colors (pixels
, npixels
);
709 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
714 /* Create and return a GC for use on frame F. GC values and mask
715 are given by XGCV and MASK. */
718 x_create_gc (f
, mask
, xgcv
)
725 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
732 /* Free GC which was used on frame F. */
740 xassert (--ngcs
>= 0);
741 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
745 #endif /* HAVE_X_WINDOWS */
748 /* W32 emulation of GCs */
751 x_create_gc (f
, mask
, xgcv
)
758 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
765 /* Free GC which was used on frame F. */
773 xassert (--ngcs
>= 0);
778 #endif /* WINDOWSNT */
781 /* Mac OS emulation of GCs */
783 extern XGCValues
*XCreateGC (void *, Window
, unsigned long, XGCValues
*);
786 x_create_gc (f
, mask
, xgcv
)
792 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
801 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
806 /* Like stricmp. Used to compare parts of font names which are in
811 const unsigned char *s1
, *s2
;
815 unsigned char c1
= tolower (*s1
);
816 unsigned char c2
= tolower (*s2
);
818 return c1
< c2
? -1 : 1;
823 return *s2
== 0 ? 0 : -1;
828 /* Like strlwr, which might not always be available. */
830 static unsigned char *
834 unsigned char *p
= s
;
843 /* Signal `error' with message S, and additional argument ARG. */
846 signal_error (s
, arg
)
850 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
854 /* If FRAME is nil, return a pointer to the selected frame.
855 Otherwise, check that FRAME is a live frame, and return a pointer
856 to it. NPARAM is the parameter number of FRAME, for
857 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
858 Lisp function definitions. */
860 static INLINE
struct frame
*
861 frame_or_selected_frame (frame
, nparam
)
866 frame
= selected_frame
;
868 CHECK_LIVE_FRAME (frame
);
869 return XFRAME (frame
);
873 /***********************************************************************
875 ***********************************************************************/
877 /* Initialize face cache and basic faces for frame F. */
883 /* Make a face cache, if F doesn't have one. */
884 if (FRAME_FACE_CACHE (f
) == NULL
)
885 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
887 #ifdef HAVE_WINDOW_SYSTEM
888 /* Make the image cache. */
889 if (FRAME_WINDOW_P (f
))
891 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
892 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
893 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
895 #endif /* HAVE_WINDOW_SYSTEM */
897 /* Realize basic faces. Must have enough information in frame
898 parameters to realize basic faces at this point. */
899 #ifdef HAVE_X_WINDOWS
900 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
903 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
906 if (!FRAME_MAC_P (f
) || FRAME_MAC_WINDOW (f
))
908 if (!realize_basic_faces (f
))
913 /* Free face cache of frame F. Called from Fdelete_frame. */
919 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
923 free_face_cache (face_cache
);
924 FRAME_FACE_CACHE (f
) = NULL
;
927 #ifdef HAVE_WINDOW_SYSTEM
928 if (FRAME_WINDOW_P (f
))
930 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
933 --image_cache
->refcount
;
934 if (image_cache
->refcount
== 0)
935 free_image_cache (f
);
938 #endif /* HAVE_WINDOW_SYSTEM */
942 /* Clear face caches, and recompute basic faces for frame F. Call
943 this after changing frame parameters on which those faces depend,
944 or when realized faces have been freed due to changing attributes
948 recompute_basic_faces (f
)
951 if (FRAME_FACE_CACHE (f
))
953 clear_face_cache (0);
954 if (!realize_basic_faces (f
))
960 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
961 try to free unused fonts, too. */
964 clear_face_cache (clear_fonts_p
)
967 #ifdef HAVE_WINDOW_SYSTEM
968 Lisp_Object tail
, frame
;
972 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
974 struct x_display_info
*dpyinfo
;
976 /* Fonts are common for frames on one display, i.e. on
978 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
979 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
980 clear_font_table (dpyinfo
);
982 /* From time to time see if we can unload some fonts. This also
983 frees all realized faces on all frames. Fonts needed by
984 faces will be loaded again when faces are realized again. */
985 clear_font_table_count
= 0;
987 FOR_EACH_FRAME (tail
, frame
)
989 struct frame
*f
= XFRAME (frame
);
990 if (FRAME_WINDOW_P (f
)
991 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
992 free_all_realized_faces (frame
);
997 /* Clear GCs of realized faces. */
998 FOR_EACH_FRAME (tail
, frame
)
1001 if (FRAME_WINDOW_P (f
))
1003 clear_face_gcs (FRAME_FACE_CACHE (f
));
1004 clear_image_cache (f
, 0);
1008 #endif /* HAVE_WINDOW_SYSTEM */
1012 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1013 doc
: /* Clear face caches on all frames.
1014 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1016 Lisp_Object thoroughly
;
1018 clear_face_cache (!NILP (thoroughly
));
1019 ++face_change_count
;
1020 ++windows_or_buffers_changed
;
1026 #ifdef HAVE_WINDOW_SYSTEM
1029 /* Remove fonts from the font table of DPYINFO except for the default
1030 ASCII fonts of frames on that display. Called from clear_face_cache
1031 from time to time. */
1034 clear_font_table (dpyinfo
)
1035 struct x_display_info
*dpyinfo
;
1039 /* Free those fonts that are not used by frames on DPYINFO. */
1040 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1042 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1043 Lisp_Object tail
, frame
;
1045 /* Check if slot is already free. */
1046 if (font_info
->name
== NULL
)
1049 /* Don't free a default font of some frame. */
1050 FOR_EACH_FRAME (tail
, frame
)
1052 struct frame
*f
= XFRAME (frame
);
1053 if (FRAME_WINDOW_P (f
)
1054 && font_info
->font
== FRAME_FONT (f
))
1062 if (font_info
->full_name
!= font_info
->name
)
1063 xfree (font_info
->full_name
);
1064 xfree (font_info
->name
);
1066 /* Free the font. */
1068 #ifdef HAVE_X_WINDOWS
1069 XFreeFont (dpyinfo
->display
, font_info
->font
);
1072 w32_unload_font (dpyinfo
, font_info
->font
);
1076 /* Mark font table slot free. */
1077 font_info
->font
= NULL
;
1078 font_info
->name
= font_info
->full_name
= NULL
;
1082 #endif /* HAVE_WINDOW_SYSTEM */
1086 /***********************************************************************
1088 ***********************************************************************/
1090 #ifdef HAVE_WINDOW_SYSTEM
1092 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1093 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1094 A bitmap specification is either a string, a file name, or a list
1095 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1096 HEIGHT is its height, and DATA is a string containing the bits of
1097 the pixmap. Bits are stored row by row, each row occupies
1098 \(WIDTH + 7)/8 bytes. */)
1104 if (STRINGP (object
))
1105 /* If OBJECT is a string, it's a file name. */
1107 else if (CONSP (object
))
1109 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1110 HEIGHT must be integers > 0, and DATA must be string large
1111 enough to hold a bitmap of the specified size. */
1112 Lisp_Object width
, height
, data
;
1114 height
= width
= data
= Qnil
;
1118 width
= XCAR (object
);
1119 object
= XCDR (object
);
1122 height
= XCAR (object
);
1123 object
= XCDR (object
);
1125 data
= XCAR (object
);
1129 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1131 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1133 if (SBYTES (data
) >= bytes_per_row
* XINT (height
))
1138 return pixmap_p
? Qt
: Qnil
;
1142 /* Load a bitmap according to NAME (which is either a file name or a
1143 pixmap spec) for use on frame F. Value is the bitmap_id (see
1144 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1145 bitmap cannot be loaded, display a message saying so, and return
1146 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1147 if these pointers are not null. */
1150 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1153 unsigned int *w_ptr
, *h_ptr
;
1161 tem
= Fbitmap_spec_p (name
);
1163 wrong_type_argument (Qbitmap_spec_p
, name
);
1168 /* Decode a bitmap spec into a bitmap. */
1173 w
= XINT (Fcar (name
));
1174 h
= XINT (Fcar (Fcdr (name
)));
1175 bits
= Fcar (Fcdr (Fcdr (name
)));
1177 bitmap_id
= x_create_bitmap_from_data (f
, SDATA (bits
),
1182 /* It must be a string -- a file name. */
1183 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1189 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1200 ++npixmaps_allocated
;
1203 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1206 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1212 #endif /* HAVE_WINDOW_SYSTEM */
1216 /***********************************************************************
1218 ***********************************************************************/
1220 #ifdef HAVE_WINDOW_SYSTEM
1222 /* Load font of face FACE which is used on frame F to display
1223 character C. The name of the font to load is determined by lface
1224 and fontset of FACE. */
1227 load_face_font (f
, face
, c
)
1232 struct font_info
*font_info
= NULL
;
1234 int needs_overstrike
;
1236 face
->font_info_id
= -1;
1239 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
,
1245 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1250 face
->font_info_id
= font_info
->font_idx
;
1251 face
->font
= font_info
->font
;
1252 face
->font_name
= font_info
->full_name
;
1253 face
->overstrike
= needs_overstrike
;
1256 x_free_gc (f
, face
->gc
);
1261 add_to_log ("Unable to load font %s",
1262 build_string (font_name
), Qnil
);
1266 #endif /* HAVE_WINDOW_SYSTEM */
1270 /***********************************************************************
1272 ***********************************************************************/
1274 /* Parse RGB_LIST, and fill in the RGB fields of COLOR.
1275 RGB_LIST should contain (at least) 3 lisp integers.
1276 Return 0 if there's a problem with RGB_LIST, otherwise return 1. */
1279 parse_rgb_list (rgb_list
, color
)
1280 Lisp_Object rgb_list
;
1283 #define PARSE_RGB_LIST_FIELD(field) \
1284 if (CONSP (rgb_list) && INTEGERP (XCAR (rgb_list))) \
1286 color->field = XINT (XCAR (rgb_list)); \
1287 rgb_list = XCDR (rgb_list); \
1292 PARSE_RGB_LIST_FIELD (red
);
1293 PARSE_RGB_LIST_FIELD (green
);
1294 PARSE_RGB_LIST_FIELD (blue
);
1300 /* Lookup on frame F the color described by the lisp string COLOR.
1301 The resulting tty color is returned in TTY_COLOR; if STD_COLOR is
1302 non-zero, then the `standard' definition of the same color is
1306 tty_lookup_color (f
, color
, tty_color
, std_color
)
1309 XColor
*tty_color
, *std_color
;
1311 Lisp_Object frame
, color_desc
;
1313 if (!STRINGP (color
) || NILP (Ffboundp (Qtty_color_desc
)))
1316 XSETFRAME (frame
, f
);
1318 color_desc
= call2 (Qtty_color_desc
, color
, frame
);
1319 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1323 if (! INTEGERP (XCAR (XCDR (color_desc
))))
1326 tty_color
->pixel
= XINT (XCAR (XCDR (color_desc
)));
1328 rgb
= XCDR (XCDR (color_desc
));
1329 if (! parse_rgb_list (rgb
, tty_color
))
1332 /* Should we fill in STD_COLOR too? */
1335 /* Default STD_COLOR to the same as TTY_COLOR. */
1336 *std_color
= *tty_color
;
1338 /* Do a quick check to see if the returned descriptor is
1339 actually _exactly_ equal to COLOR, otherwise we have to
1340 lookup STD_COLOR separately. If it's impossible to lookup
1341 a standard color, we just give up and use TTY_COLOR. */
1342 if ((!STRINGP (XCAR (color_desc
))
1343 || NILP (Fstring_equal (color
, XCAR (color_desc
))))
1344 && !NILP (Ffboundp (Qtty_color_standard_values
)))
1346 /* Look up STD_COLOR separately. */
1347 rgb
= call1 (Qtty_color_standard_values
, color
);
1348 if (! parse_rgb_list (rgb
, std_color
))
1355 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1356 /* We were called early during startup, and the colors are not
1357 yet set up in tty-defined-color-alist. Don't return a failure
1358 indication, since this produces the annoying "Unable to
1359 load color" messages in the *Messages* buffer. */
1362 /* tty-color-desc seems to have returned a bad value. */
1366 /* A version of defined_color for non-X frames. */
1369 tty_defined_color (f
, color_name
, color_def
, alloc
)
1378 color_def
->pixel
= FACE_TTY_DEFAULT_COLOR
;
1380 color_def
->blue
= 0;
1381 color_def
->green
= 0;
1384 status
= tty_lookup_color (f
, build_string (color_name
), color_def
, 0);
1386 if (color_def
->pixel
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1388 if (strcmp (color_name
, "unspecified-fg") == 0)
1389 color_def
->pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
1390 else if (strcmp (color_name
, "unspecified-bg") == 0)
1391 color_def
->pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
1394 if (color_def
->pixel
!= FACE_TTY_DEFAULT_COLOR
)
1401 /* Decide if color named COLOR_NAME is valid for the display
1402 associated with the frame F; if so, return the rgb values in
1403 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1405 This does the right thing for any type of frame. */
1408 defined_color (f
, color_name
, color_def
, alloc
)
1414 if (!FRAME_WINDOW_P (f
))
1415 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1416 #ifdef HAVE_X_WINDOWS
1417 else if (FRAME_X_P (f
))
1418 return x_defined_color (f
, color_name
, color_def
, alloc
);
1421 else if (FRAME_W32_P (f
))
1422 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1425 else if (FRAME_MAC_P (f
))
1426 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1433 /* Given the index IDX of a tty color on frame F, return its name, a
1437 tty_color_name (f
, idx
)
1441 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1444 Lisp_Object coldesc
;
1446 XSETFRAME (frame
, f
);
1447 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1449 if (!NILP (coldesc
))
1450 return XCAR (coldesc
);
1453 /* We can have an MSDOG frame under -nw for a short window of
1454 opportunity before internal_terminal_init is called. DTRT. */
1455 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1456 return msdos_stdcolor_name (idx
);
1459 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1460 return build_string (unspecified_fg
);
1461 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1462 return build_string (unspecified_bg
);
1465 return vga_stdcolor_name (idx
);
1468 return Qunspecified
;
1472 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1473 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1476 face_color_gray_p (f
, color_name
)
1483 if (defined_color (f
, color_name
, &color
, 0))
1484 gray_p
= ((abs (color
.red
- color
.green
)
1485 < max (color
.red
, color
.green
) / 20)
1486 && (abs (color
.green
- color
.blue
)
1487 < max (color
.green
, color
.blue
) / 20)
1488 && (abs (color
.blue
- color
.red
)
1489 < max (color
.blue
, color
.red
) / 20));
1497 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1498 BACKGROUND_P non-zero means the color will be used as background
1502 face_color_supported_p (f
, color_name
, background_p
)
1510 XSETFRAME (frame
, f
);
1511 return (FRAME_WINDOW_P (f
)
1512 ? (!NILP (Fxw_display_color_p (frame
))
1513 || xstricmp (color_name
, "black") == 0
1514 || xstricmp (color_name
, "white") == 0
1516 && face_color_gray_p (f
, color_name
))
1517 || (!NILP (Fx_display_grayscale_p (frame
))
1518 && face_color_gray_p (f
, color_name
)))
1519 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1523 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1524 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1525 FRAME specifies the frame and thus the display for interpreting COLOR.
1526 If FRAME is nil or omitted, use the selected frame. */)
1528 Lisp_Object color
, frame
;
1532 CHECK_STRING (color
);
1534 frame
= selected_frame
;
1536 CHECK_FRAME (frame
);
1538 return face_color_gray_p (f
, SDATA (color
)) ? Qt
: Qnil
;
1542 DEFUN ("color-supported-p", Fcolor_supported_p
,
1543 Scolor_supported_p
, 1, 3, 0,
1544 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1545 BACKGROUND-P non-nil means COLOR is used as a background.
1546 If FRAME is nil or omitted, use the selected frame.
1547 COLOR must be a valid color name. */)
1548 (color
, frame
, background_p
)
1549 Lisp_Object frame
, color
, background_p
;
1553 CHECK_STRING (color
);
1555 frame
= selected_frame
;
1557 CHECK_FRAME (frame
);
1559 if (face_color_supported_p (f
, SDATA (color
), !NILP (background_p
)))
1565 /* Load color with name NAME for use by face FACE on frame F.
1566 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1567 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1568 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1569 pixel color. If color cannot be loaded, display a message, and
1570 return the foreground, background or underline color of F, but
1571 record that fact in flags of the face so that we don't try to free
1575 load_color (f
, face
, name
, target_index
)
1579 enum lface_attribute_index target_index
;
1583 xassert (STRINGP (name
));
1584 xassert (target_index
== LFACE_FOREGROUND_INDEX
1585 || target_index
== LFACE_BACKGROUND_INDEX
1586 || target_index
== LFACE_UNDERLINE_INDEX
1587 || target_index
== LFACE_OVERLINE_INDEX
1588 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1589 || target_index
== LFACE_BOX_INDEX
);
1591 /* if the color map is full, defined_color will return a best match
1592 to the values in an existing cell. */
1593 if (!defined_color (f
, SDATA (name
), &color
, 1))
1595 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1597 switch (target_index
)
1599 case LFACE_FOREGROUND_INDEX
:
1600 face
->foreground_defaulted_p
= 1;
1601 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1604 case LFACE_BACKGROUND_INDEX
:
1605 face
->background_defaulted_p
= 1;
1606 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1609 case LFACE_UNDERLINE_INDEX
:
1610 face
->underline_defaulted_p
= 1;
1611 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1614 case LFACE_OVERLINE_INDEX
:
1615 face
->overline_color_defaulted_p
= 1;
1616 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1619 case LFACE_STRIKE_THROUGH_INDEX
:
1620 face
->strike_through_color_defaulted_p
= 1;
1621 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1624 case LFACE_BOX_INDEX
:
1625 face
->box_color_defaulted_p
= 1;
1626 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1635 ++ncolors_allocated
;
1642 #ifdef HAVE_WINDOW_SYSTEM
1644 /* Load colors for face FACE which is used on frame F. Colors are
1645 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1646 of ATTRS. If the background color specified is not supported on F,
1647 try to emulate gray colors with a stipple from Vface_default_stipple. */
1650 load_face_colors (f
, face
, attrs
)
1657 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1658 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1660 /* Swap colors if face is inverse-video. */
1661 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1669 /* Check for support for foreground, not for background because
1670 face_color_supported_p is smart enough to know that grays are
1671 "supported" as background because we are supposed to use stipple
1673 if (!face_color_supported_p (f
, SDATA (bg
), 0)
1674 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1676 x_destroy_bitmap (f
, face
->stipple
);
1677 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1678 &face
->pixmap_w
, &face
->pixmap_h
);
1681 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1682 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1686 /* Free color PIXEL on frame F. */
1689 unload_color (f
, pixel
)
1691 unsigned long pixel
;
1693 #ifdef HAVE_X_WINDOWS
1697 x_free_colors (f
, &pixel
, 1);
1704 /* Free colors allocated for FACE. */
1707 free_face_colors (f
, face
)
1711 #ifdef HAVE_X_WINDOWS
1712 if (face
->colors_copied_bitwise_p
)
1717 if (!face
->foreground_defaulted_p
)
1719 x_free_colors (f
, &face
->foreground
, 1);
1720 IF_DEBUG (--ncolors_allocated
);
1723 if (!face
->background_defaulted_p
)
1725 x_free_colors (f
, &face
->background
, 1);
1726 IF_DEBUG (--ncolors_allocated
);
1729 if (face
->underline_p
1730 && !face
->underline_defaulted_p
)
1732 x_free_colors (f
, &face
->underline_color
, 1);
1733 IF_DEBUG (--ncolors_allocated
);
1736 if (face
->overline_p
1737 && !face
->overline_color_defaulted_p
)
1739 x_free_colors (f
, &face
->overline_color
, 1);
1740 IF_DEBUG (--ncolors_allocated
);
1743 if (face
->strike_through_p
1744 && !face
->strike_through_color_defaulted_p
)
1746 x_free_colors (f
, &face
->strike_through_color
, 1);
1747 IF_DEBUG (--ncolors_allocated
);
1750 if (face
->box
!= FACE_NO_BOX
1751 && !face
->box_color_defaulted_p
)
1753 x_free_colors (f
, &face
->box_color
, 1);
1754 IF_DEBUG (--ncolors_allocated
);
1758 #endif /* HAVE_X_WINDOWS */
1761 #endif /* HAVE_WINDOW_SYSTEM */
1765 /***********************************************************************
1767 ***********************************************************************/
1769 /* An enumerator for each field of an XLFD font name. */
1790 /* An enumerator for each possible slant value of a font. Taken from
1791 the XLFD specification. */
1799 XLFD_SLANT_REVERSE_ITALIC
,
1800 XLFD_SLANT_REVERSE_OBLIQUE
,
1804 /* Relative font weight according to XLFD documentation. */
1808 XLFD_WEIGHT_UNKNOWN
,
1809 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1810 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1811 XLFD_WEIGHT_LIGHT
, /* 30 */
1812 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1813 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1814 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1815 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1816 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1817 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1820 /* Relative proportionate width. */
1824 XLFD_SWIDTH_UNKNOWN
,
1825 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1826 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1827 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1828 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1829 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1830 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1831 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1832 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1833 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1836 /* Structure used for tables mapping XLFD weight, slant, and width
1837 names to numeric and symbolic values. */
1843 Lisp_Object
*symbol
;
1846 /* Table of XLFD slant names and their numeric and symbolic
1847 representations. This table must be sorted by slant names in
1850 static struct table_entry slant_table
[] =
1852 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1853 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1854 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1855 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1856 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1857 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1860 /* Table of XLFD weight names. This table must be sorted by weight
1861 names in ascending order. */
1863 static struct table_entry weight_table
[] =
1865 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1866 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1867 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1868 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1869 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1870 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1871 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1872 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1873 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1874 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1875 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1876 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1877 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1878 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1879 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1880 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1883 /* Table of XLFD width names. This table must be sorted by width
1884 names in ascending order. */
1886 static struct table_entry swidth_table
[] =
1888 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1889 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1890 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1891 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1892 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1893 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1894 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1895 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1896 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1897 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1898 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1899 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1900 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1901 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1902 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1905 /* Structure used to hold the result of splitting font names in XLFD
1906 format into their fields. */
1910 /* The original name which is modified destructively by
1911 split_font_name. The pointer is kept here to be able to free it
1912 if it was allocated from the heap. */
1915 /* Font name fields. Each vector element points into `name' above.
1916 Fields are NUL-terminated. */
1917 char *fields
[XLFD_LAST
];
1919 /* Numeric values for those fields that interest us. See
1920 split_font_name for which these are. */
1921 int numeric
[XLFD_LAST
];
1923 /* If the original name matches one of Vface_font_rescale_alist,
1924 the value is the corresponding rescale ratio. Otherwise, the
1926 double rescale_ratio
;
1928 /* Lower value mean higher priority. */
1929 int registry_priority
;
1932 /* The frame in effect when sorting font names. Set temporarily in
1933 sort_fonts so that it is available in font comparison functions. */
1935 static struct frame
*font_frame
;
1937 /* Order by which font selection chooses fonts. The default values
1938 mean `first, find a best match for the font width, then for the
1939 font height, then for weight, then for slant.' This variable can be
1940 set via set-face-font-sort-order. */
1943 static int font_sort_order
[4] = {
1944 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1947 static int font_sort_order
[4];
1950 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1951 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1952 is a pointer to the matching table entry or null if no table entry
1955 static struct table_entry
*
1956 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1957 struct table_entry
*table
;
1959 struct font_name
*font
;
1962 /* Function split_font_name converts fields to lower-case, so there
1963 is no need to use xstrlwr or xstricmp here. */
1964 char *s
= font
->fields
[field_index
];
1965 int low
, mid
, high
, cmp
;
1972 mid
= (low
+ high
) / 2;
1973 cmp
= strcmp (table
[mid
].name
, s
);
1987 /* Return a numeric representation for font name field
1988 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1989 has DIM entries. Value is the numeric value found or DFLT if no
1990 table entry matches. This function is used to translate weight,
1991 slant, and swidth names of XLFD font names to numeric values. */
1994 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1995 struct table_entry
*table
;
1997 struct font_name
*font
;
2001 struct table_entry
*p
;
2002 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2003 return p
? p
->numeric
: dflt
;
2007 /* Return a symbolic representation for font name field
2008 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
2009 has DIM entries. Value is the symbolic value found or DFLT if no
2010 table entry matches. This function is used to translate weight,
2011 slant, and swidth names of XLFD font names to symbols. */
2013 static INLINE Lisp_Object
2014 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
2015 struct table_entry
*table
;
2017 struct font_name
*font
;
2021 struct table_entry
*p
;
2022 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
2023 return p
? *p
->symbol
: dflt
;
2027 /* Return a numeric value for the slant of the font given by FONT. */
2030 xlfd_numeric_slant (font
)
2031 struct font_name
*font
;
2033 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
2034 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2038 /* Return a symbol representing the weight of the font given by FONT. */
2040 static INLINE Lisp_Object
2041 xlfd_symbolic_slant (font
)
2042 struct font_name
*font
;
2044 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2045 font
, XLFD_SLANT
, Qnormal
);
2049 /* Return a numeric value for the weight of the font given by FONT. */
2052 xlfd_numeric_weight (font
)
2053 struct font_name
*font
;
2055 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2056 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2060 /* Return a symbol representing the slant of the font given by FONT. */
2062 static INLINE Lisp_Object
2063 xlfd_symbolic_weight (font
)
2064 struct font_name
*font
;
2066 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2067 font
, XLFD_WEIGHT
, Qnormal
);
2071 /* Return a numeric value for the swidth of the font whose XLFD font
2072 name fields are found in FONT. */
2075 xlfd_numeric_swidth (font
)
2076 struct font_name
*font
;
2078 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2079 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2083 /* Return a symbolic value for the swidth of FONT. */
2085 static INLINE Lisp_Object
2086 xlfd_symbolic_swidth (font
)
2087 struct font_name
*font
;
2089 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2090 font
, XLFD_SWIDTH
, Qnormal
);
2094 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2095 entries. Value is a pointer to the matching table entry or null if
2096 no element of TABLE contains SYMBOL. */
2098 static struct table_entry
*
2099 face_value (table
, dim
, symbol
)
2100 struct table_entry
*table
;
2106 xassert (SYMBOLP (symbol
));
2108 for (i
= 0; i
< dim
; ++i
)
2109 if (EQ (*table
[i
].symbol
, symbol
))
2112 return i
< dim
? table
+ i
: NULL
;
2116 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2117 entries. Value is -1 if SYMBOL is not found in TABLE. */
2120 face_numeric_value (table
, dim
, symbol
)
2121 struct table_entry
*table
;
2125 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2126 return p
? p
->numeric
: -1;
2130 /* Return a numeric value representing the weight specified by Lisp
2131 symbol WEIGHT. Value is one of the enumerators of enum
2135 face_numeric_weight (weight
)
2138 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2142 /* Return a numeric value representing the slant specified by Lisp
2143 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2146 face_numeric_slant (slant
)
2149 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2153 /* Return a numeric value representing the swidth specified by Lisp
2154 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2157 face_numeric_swidth (width
)
2160 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2164 #ifdef HAVE_WINDOW_SYSTEM
2166 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2170 struct font_name
*font
;
2172 /* Function split_font_name converts fields to lower-case, so there
2173 is no need to use tolower here. */
2174 return *font
->fields
[XLFD_SPACING
] != 'p';
2178 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2180 The actual height of the font when displayed on F depends on the
2181 resolution of both the font and frame. For example, a 10pt font
2182 designed for a 100dpi display will display larger than 10pt on a
2183 75dpi display. (It's not unusual to use fonts not designed for the
2184 display one is using. For example, some intlfonts are available in
2185 72dpi versions, only.)
2187 Value is the real point size of FONT on frame F, or 0 if it cannot
2191 xlfd_point_size (f
, font
)
2193 struct font_name
*font
;
2195 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2196 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2200 if (*pixel_field
== '[')
2202 /* The pixel size field is `[A B C D]' which specifies
2203 a transformation matrix.
2209 by which all glyphs of the font are transformed. The spec
2210 says that s scalar value N for the pixel size is equivalent
2211 to A = N * resx/resy, B = C = 0, D = N. */
2212 char *start
= pixel_field
+ 1, *end
;
2216 for (i
= 0; i
< 4; ++i
)
2218 matrix
[i
] = strtod (start
, &end
);
2225 pixel
= atoi (pixel_field
);
2230 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2236 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2237 of frame F. This function is used to guess a point size of font
2238 when only the pixel height of the font is available. */
2241 pixel_point_size (f
, pixel
)
2245 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2249 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2250 point size of one dot. */
2251 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2252 int_pt
= real_pt
+ 0.5;
2258 /* Return a rescaling ratio of a font of NAME. */
2261 font_rescale_ratio (name
)
2264 Lisp_Object tail
, elt
;
2266 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2269 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2270 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2271 return XFLOAT_DATA (XCDR (elt
));
2277 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2278 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2279 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2280 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2281 zero if the font name doesn't have the format we expect. The
2282 expected format is a font name that starts with a `-' and has
2283 XLFD_LAST fields separated by `-'. */
2286 split_font_name (f
, font
, numeric_p
)
2288 struct font_name
*font
;
2293 double rescale_ratio
;
2296 /* This must be done before splitting the font name. */
2297 rescale_ratio
= font_rescale_ratio (font
->name
);
2299 if (*font
->name
== '-')
2301 char *p
= xstrlwr (font
->name
) + 1;
2303 while (i
< XLFD_LAST
)
2305 font
->fields
[i
] = p
;
2308 /* Pixel and point size may be of the form `[....]'. For
2309 BNF, see XLFD spec, chapter 4. Negative values are
2310 indicated by tilde characters which we replace with
2311 `-' characters, here. */
2313 && (i
- 1 == XLFD_PIXEL_SIZE
2314 || i
- 1 == XLFD_POINT_SIZE
))
2319 for (++p
; *p
&& *p
!= ']'; ++p
)
2323 /* Check that the matrix contains 4 floating point
2325 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2328 if (strtod (start
, &end
) == 0 && start
== end
)
2335 while (*p
&& *p
!= '-')
2345 success_p
= i
== XLFD_LAST
;
2347 /* If requested, and font name was in the expected format,
2348 compute numeric values for some fields. */
2349 if (numeric_p
&& success_p
)
2351 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2352 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2353 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2354 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2355 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2356 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2357 font
->rescale_ratio
= rescale_ratio
;
2360 /* Initialize it to zero. It will be overridden by font_list while
2361 trying alternate registries. */
2362 font
->registry_priority
= 0;
2368 /* Build an XLFD font name from font name fields in FONT. Value is a
2369 pointer to the font name, which is allocated via xmalloc. */
2372 build_font_name (font
)
2373 struct font_name
*font
;
2377 char *font_name
= (char *) xmalloc (size
);
2378 int total_length
= 0;
2380 for (i
= 0; i
< XLFD_LAST
; ++i
)
2382 /* Add 1 because of the leading `-'. */
2383 int len
= strlen (font
->fields
[i
]) + 1;
2385 /* Reallocate font_name if necessary. Add 1 for the final
2387 if (total_length
+ len
+ 1 >= size
)
2389 int new_size
= max (2 * size
, size
+ len
+ 1);
2390 int sz
= new_size
* sizeof *font_name
;
2391 font_name
= (char *) xrealloc (font_name
, sz
);
2395 font_name
[total_length
] = '-';
2396 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2397 total_length
+= len
;
2400 font_name
[total_length
] = 0;
2405 /* Free an array FONTS of N font_name structures. This frees FONTS
2406 itself and all `name' fields in its elements. */
2409 free_font_names (fonts
, n
)
2410 struct font_name
*fonts
;
2414 xfree (fonts
[--n
].name
);
2419 /* Sort vector FONTS of font_name structures which contains NFONTS
2420 elements using qsort and comparison function CMPFN. F is the frame
2421 on which the fonts will be used. The global variable font_frame
2422 is temporarily set to F to make it available in CMPFN. */
2425 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2427 struct font_name
*fonts
;
2429 int (*cmpfn
) P_ ((const void *, const void *));
2432 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2437 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2438 display in x_display_list. FONTS is a pointer to a vector of
2439 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2440 alternative patterns from Valternate_fontname_alist if no fonts are
2441 found matching PATTERN.
2443 For all fonts found, set FONTS[i].name to the name of the font,
2444 allocated via xmalloc, and split font names into fields. Ignore
2445 fonts that we can't parse. Value is the number of fonts found. */
2448 x_face_list_fonts (f
, pattern
, pfonts
, nfonts
, try_alternatives_p
)
2451 struct font_name
**pfonts
;
2452 int nfonts
, try_alternatives_p
;
2456 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2457 better to do it the other way around. */
2459 Lisp_Object lpattern
, tem
;
2460 struct font_name
*fonts
= 0;
2461 int num_fonts
= nfonts
;
2464 lpattern
= build_string (pattern
);
2466 /* Get the list of fonts matching PATTERN. */
2469 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2472 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2475 if (nfonts
< 0 && CONSP (lfonts
))
2476 num_fonts
= XFASTINT (Flength (lfonts
));
2478 /* Make a copy of the font names we got from X, and
2479 split them into fields. */
2481 for (tem
= lfonts
; CONSP (tem
) && n
< num_fonts
; tem
= XCDR (tem
))
2483 Lisp_Object elt
, tail
;
2484 const char *name
= SDATA (XCAR (tem
));
2486 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2487 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2491 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2502 *pfonts
= (struct font_name
*) xmalloc (num_fonts
* sizeof **pfonts
);
2506 /* Make a copy of the font name. */
2507 fonts
[n
].name
= xstrdup (name
);
2509 if (split_font_name (f
, fonts
+ n
, 1))
2511 if (font_scalable_p (fonts
+ n
)
2512 && !may_use_scalable_font_p (name
))
2515 xfree (fonts
[n
].name
);
2521 xfree (fonts
[n
].name
);
2524 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2525 if (n
== 0 && try_alternatives_p
)
2527 Lisp_Object list
= Valternate_fontname_alist
;
2535 while (CONSP (list
))
2537 Lisp_Object entry
= XCAR (list
);
2539 && STRINGP (XCAR (entry
))
2540 && strcmp (SDATA (XCAR (entry
)), pattern
) == 0)
2547 Lisp_Object patterns
= XCAR (list
);
2550 while (CONSP (patterns
)
2551 /* If list is screwed up, give up. */
2552 && (name
= XCAR (patterns
),
2554 /* Ignore patterns equal to PATTERN because we tried that
2555 already with no success. */
2556 && (strcmp (SDATA (name
), pattern
) == 0
2557 || (n
= x_face_list_fonts (f
, SDATA (name
),
2560 patterns
= XCDR (patterns
);
2568 /* Check if a font matching pattern_offset_t on frame F is available
2569 or not. PATTERN may be a cons (FAMILY . REGISTRY), in which case,
2570 a font name pattern is generated from FAMILY and REGISTRY. */
2573 face_font_available_p (f
, pattern
)
2575 Lisp_Object pattern
;
2579 if (! STRINGP (pattern
))
2581 Lisp_Object family
, registry
;
2582 char *family_str
, *registry_str
, *pattern_str
;
2584 CHECK_CONS (pattern
);
2585 family
= XCAR (pattern
);
2590 CHECK_STRING (family
);
2591 family_str
= (char *) SDATA (family
);
2593 registry
= XCDR (pattern
);
2594 if (NILP (registry
))
2598 CHECK_STRING (registry
);
2599 registry_str
= (char *) SDATA (registry
);
2602 pattern_str
= (char *) alloca (strlen (family_str
)
2603 + strlen (registry_str
)
2605 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2606 strcat (pattern_str
, family_str
);
2607 strcat (pattern_str
, "-*-");
2608 strcat (pattern_str
, registry_str
);
2609 if (!index (registry_str
, '-'))
2611 if (registry_str
[strlen (registry_str
) - 1] == '*')
2612 strcat (pattern_str
, "-*");
2614 strcat (pattern_str
, "*-*");
2616 pattern
= build_string (pattern_str
);
2619 /* Get the list of fonts matching PATTERN. */
2622 fonts
= w32_list_fonts (f
, pattern
, 0, 1);
2625 fonts
= x_list_fonts (f
, pattern
, -1, 1);
2627 return XINT (Flength (fonts
));
2631 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2632 using comparison function CMPFN. Value is the number of fonts
2633 found. If value is non-zero, *FONTS is set to a vector of
2634 font_name structures allocated from the heap containing matching
2635 fonts. Each element of *FONTS contains a name member that is also
2636 allocated from the heap. Font names in these structures are split
2637 into fields. Use free_font_names to free such an array. */
2640 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2643 int (*cmpfn
) P_ ((const void *, const void *));
2644 struct font_name
**fonts
;
2648 /* Get the list of fonts matching pattern. 100 should suffice. */
2649 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2650 if (INTEGERP (Vfont_list_limit
))
2651 nfonts
= XINT (Vfont_list_limit
);
2654 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1);
2656 /* Sort the resulting array and return it in *FONTS. If no
2657 fonts were found, make sure to set *FONTS to null. */
2659 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2670 /* Compare two font_name structures *A and *B. Value is analogous to
2671 strcmp. Sort order is given by the global variable
2672 font_sort_order. Font names are sorted so that, everything else
2673 being equal, fonts with a resolution closer to that of the frame on
2674 which they are used are listed first. The global variable
2675 font_frame is the frame on which we operate. */
2678 cmp_font_names (a
, b
)
2681 struct font_name
*x
= (struct font_name
*) a
;
2682 struct font_name
*y
= (struct font_name
*) b
;
2685 /* All strings have been converted to lower-case by split_font_name,
2686 so we can use strcmp here. */
2687 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2692 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2694 int j
= font_sort_order
[i
];
2695 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2700 /* Everything else being equal, we prefer fonts with an
2701 y-resolution closer to that of the frame. */
2702 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2703 int x_resy
= x
->numeric
[XLFD_RESY
];
2704 int y_resy
= y
->numeric
[XLFD_RESY
];
2705 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2713 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2714 is non-nil list fonts matching that pattern. Otherwise, if
2715 REGISTRY is non-nil return only fonts with that registry, otherwise
2716 return fonts of any registry. Set *FONTS to a vector of font_name
2717 structures allocated from the heap containing the fonts found.
2718 Value is the number of fonts found. */
2721 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2723 Lisp_Object pattern
, family
, registry
;
2724 struct font_name
**fonts
;
2726 char *pattern_str
, *family_str
, *registry_str
;
2730 family_str
= (NILP (family
) ? "*" : (char *) SDATA (family
));
2731 registry_str
= (NILP (registry
) ? "*" : (char *) SDATA (registry
));
2733 pattern_str
= (char *) alloca (strlen (family_str
)
2734 + strlen (registry_str
)
2736 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2737 strcat (pattern_str
, family_str
);
2738 strcat (pattern_str
, "-*-");
2739 strcat (pattern_str
, registry_str
);
2740 if (!index (registry_str
, '-'))
2742 if (registry_str
[strlen (registry_str
) - 1] == '*')
2743 strcat (pattern_str
, "-*");
2745 strcat (pattern_str
, "*-*");
2749 pattern_str
= (char *) SDATA (pattern
);
2751 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2755 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2756 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2757 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2760 static struct font_name
*
2761 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2762 struct font_name
*fonts1
, *fonts2
;
2763 int nfonts1
, nfonts2
;
2765 int new_nfonts
= nfonts1
+ nfonts2
;
2766 struct font_name
*new_fonts
;
2768 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2769 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2770 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2777 /* Get a sorted list of fonts of family FAMILY on frame F.
2779 If PATTERN is non-nil list fonts matching that pattern.
2781 If REGISTRY is non-nil, return fonts with that registry and the
2782 alternative registries from Vface_alternative_font_registry_alist.
2784 If REGISTRY is nil return fonts of any registry.
2786 Set *FONTS to a vector of font_name structures allocated from the
2787 heap containing the fonts found. Value is the number of fonts
2791 font_list (f
, pattern
, family
, registry
, fonts
)
2793 Lisp_Object pattern
, family
, registry
;
2794 struct font_name
**fonts
;
2796 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2798 if (!NILP (registry
)
2799 && CONSP (Vface_alternative_font_registry_alist
))
2803 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2808 for (alter
= XCDR (alter
), reg_prio
= 1;
2810 alter
= XCDR (alter
), reg_prio
++)
2811 if (STRINGP (XCAR (alter
)))
2814 struct font_name
*fonts2
;
2816 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2818 for (i
= 0; i
< nfonts2
; i
++)
2819 fonts2
[i
].registry_priority
= reg_prio
;
2820 *fonts
= (nfonts
> 0
2821 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2832 /* Remove elements from LIST whose cars are `equal'. Called from
2833 x-family-fonts and x-font-family-list to remove duplicate font
2837 remove_duplicates (list
)
2840 Lisp_Object tail
= list
;
2842 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2844 Lisp_Object next
= XCDR (tail
);
2845 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2846 XSETCDR (tail
, XCDR (next
));
2853 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2854 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2855 If FAMILY is omitted or nil, list all families.
2856 Otherwise, FAMILY must be a string, possibly containing wildcards
2858 If FRAME is omitted or nil, use the selected frame.
2859 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2860 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2861 FAMILY is the font family name. POINT-SIZE is the size of the
2862 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2863 width, weight and slant of the font. These symbols are the same as for
2864 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2865 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2866 giving the registry and encoding of the font.
2867 The result list is sorted according to the current setting of
2868 the face font sort order. */)
2870 Lisp_Object family
, frame
;
2872 struct frame
*f
= check_x_frame (frame
);
2873 struct font_name
*fonts
;
2876 struct gcpro gcpro1
;
2879 CHECK_STRING (family
);
2883 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2884 for (i
= nfonts
- 1; i
>= 0; --i
)
2886 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2889 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2890 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2891 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2892 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2893 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2894 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2895 tem
= build_font_name (fonts
+ i
);
2896 ASET (v
, 6, build_string (tem
));
2897 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2898 fonts
[i
].fields
[XLFD_ENCODING
]);
2899 ASET (v
, 7, build_string (tem
));
2902 result
= Fcons (v
, result
);
2905 remove_duplicates (result
);
2906 free_font_names (fonts
, nfonts
);
2912 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2914 doc
: /* Return a list of available font families on FRAME.
2915 If FRAME is omitted or nil, use the selected frame.
2916 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2917 is a font family, and FIXED-P is non-nil if fonts of that family
2918 are fixed-pitch. */)
2922 struct frame
*f
= check_x_frame (frame
);
2924 struct font_name
*fonts
;
2926 struct gcpro gcpro1
;
2927 int count
= SPECPDL_INDEX ();
2929 /* Let's consider all fonts. */
2930 specbind (intern ("font-list-limit"), make_number (-1));
2931 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2935 for (i
= nfonts
- 1; i
>= 0; --i
)
2936 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2937 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2940 remove_duplicates (result
);
2941 free_font_names (fonts
, nfonts
);
2943 return unbind_to (count
, result
);
2947 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2948 doc
: /* Return a list of the names of available fonts matching PATTERN.
2949 If optional arguments FACE and FRAME are specified, return only fonts
2950 the same size as FACE on FRAME.
2951 PATTERN is a string, perhaps with wildcard characters;
2952 the * character matches any substring, and
2953 the ? character matches any single character.
2954 PATTERN is case-insensitive.
2955 FACE is a face name--a symbol.
2957 The return value is a list of strings, suitable as arguments to
2960 Fonts Emacs can't use may or may not be excluded
2961 even if they match PATTERN and FACE.
2962 The optional fourth argument MAXIMUM sets a limit on how many
2963 fonts to match. The first MAXIMUM fonts are reported.
2964 The optional fifth argument WIDTH, if specified, is a number of columns
2965 occupied by a character of a font. In that case, return only fonts
2966 the WIDTH times as wide as FACE on FRAME. */)
2967 (pattern
, face
, frame
, maximum
, width
)
2968 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2975 CHECK_STRING (pattern
);
2981 CHECK_NATNUM (maximum
);
2982 maxnames
= XINT (maximum
);
2986 CHECK_NUMBER (width
);
2988 /* We can't simply call check_x_frame because this function may be
2989 called before any frame is created. */
2990 f
= frame_or_selected_frame (frame
, 2);
2991 if (!FRAME_WINDOW_P (f
))
2993 /* Perhaps we have not yet created any frame. */
2998 /* Determine the width standard for comparison with the fonts we find. */
3004 /* This is of limited utility since it works with character
3005 widths. Keep it for compatibility. --gerd. */
3006 int face_id
= lookup_named_face (f
, face
, 0);
3007 struct face
*face
= (face_id
< 0
3009 : FACE_FROM_ID (f
, face_id
));
3012 /* For historic reasons, FONT_WIDTH refers to average width on W32,
3013 not maximum as on X. Redefine here. */
3015 #define FONT_WIDTH FONT_MAX_WIDTH
3018 if (face
&& face
->font
)
3019 size
= FONT_WIDTH (face
->font
);
3021 size
= FONT_WIDTH (FRAME_FONT (f
)); /* FRAME_COLUMN_WIDTH (f) */
3024 size
*= XINT (width
);
3028 Lisp_Object args
[2];
3030 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
3032 /* We don't have to check fontsets. */
3034 args
[1] = list_fontsets (f
, pattern
, size
);
3035 return Fnconc (2, args
);
3039 #endif /* HAVE_WINDOW_SYSTEM */
3043 /***********************************************************************
3045 ***********************************************************************/
3047 /* Access face attributes of face LFACE, a Lisp vector. */
3049 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3050 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3051 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3052 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3053 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3054 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3055 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3056 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3057 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3058 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3059 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3060 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3061 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3062 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3063 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3064 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3066 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3067 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3069 #define LFACEP(LFACE) \
3071 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3072 && EQ (AREF (LFACE, 0), Qface))
3077 /* Check consistency of Lisp face attribute vector ATTRS. */
3080 check_lface_attrs (attrs
)
3083 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3084 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3085 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3086 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3087 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3088 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3089 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3090 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3091 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3092 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3093 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3094 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3095 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3096 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3097 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3098 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3099 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3100 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3101 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3102 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3103 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3104 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3105 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3106 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3107 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3108 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3109 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3110 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3111 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3112 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3113 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3114 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3115 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3116 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3117 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3118 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3119 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3120 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3121 #ifdef HAVE_WINDOW_SYSTEM
3122 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3123 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3124 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3125 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3126 || NILP (attrs
[LFACE_FONT_INDEX
])
3127 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3132 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3140 xassert (LFACEP (lface
));
3141 check_lface_attrs (XVECTOR (lface
)->contents
);
3145 #else /* GLYPH_DEBUG == 0 */
3147 #define check_lface_attrs(attrs) (void) 0
3148 #define check_lface(lface) (void) 0
3150 #endif /* GLYPH_DEBUG == 0 */
3153 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3154 to make it a symvol. If FACE_NAME is an alias for another face,
3155 return that face's name. */
3158 resolve_face_name (face_name
)
3159 Lisp_Object face_name
;
3161 Lisp_Object aliased
;
3163 if (STRINGP (face_name
))
3164 face_name
= intern (SDATA (face_name
));
3166 while (SYMBOLP (face_name
))
3168 aliased
= Fget (face_name
, Qface_alias
);
3172 face_name
= aliased
;
3179 /* Return the face definition of FACE_NAME on frame F. F null means
3180 return the definition for new frames. FACE_NAME may be a string or
3181 a symbol (apparently Emacs 20.2 allowed strings as face names in
3182 face text properties; Ediff uses that). If FACE_NAME is an alias
3183 for another face, return that face's definition. If SIGNAL_P is
3184 non-zero, signal an error if FACE_NAME is not a valid face name.
3185 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3188 static INLINE Lisp_Object
3189 lface_from_face_name (f
, face_name
, signal_p
)
3191 Lisp_Object face_name
;
3196 face_name
= resolve_face_name (face_name
);
3199 lface
= assq_no_quit (face_name
, f
->face_alist
);
3201 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3204 lface
= XCDR (lface
);
3206 signal_error ("Invalid face", face_name
);
3208 check_lface (lface
);
3213 /* Get face attributes of face FACE_NAME from frame-local faces on
3214 frame F. Store the resulting attributes in ATTRS which must point
3215 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3216 is non-zero, signal an error if FACE_NAME does not name a face.
3217 Otherwise, value is zero if FACE_NAME is not a face. */
3220 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3222 Lisp_Object face_name
;
3229 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3232 bcopy (XVECTOR (lface
)->contents
, attrs
,
3233 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3243 /* Non-zero if all attributes in face attribute vector ATTRS are
3244 specified, i.e. are non-nil. */
3247 lface_fully_specified_p (attrs
)
3252 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3253 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3254 && i
!= LFACE_AVGWIDTH_INDEX
)
3255 if (UNSPECIFIEDP (attrs
[i
])
3257 /* MAC_TODO: No stipple support on Mac OS yet, this index is
3258 always unspecified. */
3259 && i
!= LFACE_STIPPLE_INDEX
3264 return i
== LFACE_VECTOR_SIZE
;
3267 #ifdef HAVE_WINDOW_SYSTEM
3269 /* Set font-related attributes of Lisp face LFACE from the fullname of
3270 the font opened by FONTNAME. If FORCE_P is zero, set only
3271 unspecified attributes of LFACE. The exception is `font'
3272 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3274 If FONTNAME is not available on frame F,
3275 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3276 If the fullname is not in a valid XLFD format,
3277 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3278 in LFACE and return 1.
3279 Otherwise, return 1. */
3282 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3285 Lisp_Object fontname
;
3286 int force_p
, may_fail_p
;
3288 struct font_name font
;
3293 char *font_name
= SDATA (fontname
);
3294 struct font_info
*font_info
;
3296 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3297 fontset
= fs_query_fontset (fontname
, 0);
3299 font_name
= SDATA (fontset_ascii (fontset
));
3301 /* Check if FONT_NAME is surely available on the system. Usually
3302 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3303 returns quickly. But, even if FONT_NAME is not yet cached,
3304 caching it now is not futail because we anyway load the font
3307 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3317 font
.name
= STRDUPA (font_info
->full_name
);
3318 have_xlfd_p
= split_font_name (f
, &font
, 1);
3320 /* Set attributes only if unspecified, otherwise face defaults for
3321 new frames would never take effect. If we couldn't get a font
3322 name conforming to XLFD, set normal values. */
3324 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3329 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3330 + strlen (font
.fields
[XLFD_FOUNDRY
])
3332 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3333 font
.fields
[XLFD_FAMILY
]);
3334 val
= build_string (buffer
);
3337 val
= build_string ("*");
3338 LFACE_FAMILY (lface
) = val
;
3341 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3344 pt
= xlfd_point_size (f
, &font
);
3346 pt
= pixel_point_size (f
, font_info
->height
* 10);
3348 LFACE_HEIGHT (lface
) = make_number (pt
);
3351 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3352 LFACE_SWIDTH (lface
)
3353 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3355 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3356 LFACE_AVGWIDTH (lface
)
3358 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3361 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3362 LFACE_WEIGHT (lface
)
3363 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3365 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3367 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3369 LFACE_FONT (lface
) = fontname
;
3374 #endif /* HAVE_WINDOW_SYSTEM */
3377 /* Merges the face height FROM with the face height TO, and returns the
3378 merged height. If FROM is an invalid height, then INVALID is
3379 returned instead. FROM and TO may be either absolute face heights or
3380 `relative' heights; the returned value is always an absolute height
3381 unless both FROM and TO are relative. GCPRO is a lisp value that
3382 will be protected from garbage-collection if this function makes a
3386 merge_face_heights (from
, to
, invalid
, gcpro
)
3387 Lisp_Object from
, to
, invalid
, gcpro
;
3389 Lisp_Object result
= invalid
;
3391 if (INTEGERP (from
))
3392 /* FROM is absolute, just use it as is. */
3394 else if (FLOATP (from
))
3395 /* FROM is a scale, use it to adjust TO. */
3398 /* relative X absolute => absolute */
3399 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3400 else if (FLOATP (to
))
3401 /* relative X relative => relative */
3402 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3404 else if (FUNCTIONP (from
))
3405 /* FROM is a function, which use to adjust TO. */
3407 /* Call function with current height as argument.
3408 From is the new height. */
3409 Lisp_Object args
[2];
3410 struct gcpro gcpro1
;
3416 result
= safe_call (2, args
);
3420 /* Ensure that if TO was absolute, so is the result. */
3421 if (INTEGERP (to
) && !INTEGERP (result
))
3429 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3430 store the resulting attributes in TO, which must be already be
3431 completely specified and contain only absolute attributes. Every
3432 specified attribute of FROM overrides the corresponding attribute of
3433 TO; relative attributes in FROM are merged with the absolute value in
3434 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3435 face inheritance; it should be Qnil when called from other places. */
3438 merge_face_vectors (f
, from
, to
, cycle_check
)
3440 Lisp_Object
*from
, *to
;
3441 Lisp_Object cycle_check
;
3445 /* If FROM inherits from some other faces, merge their attributes into
3446 TO before merging FROM's direct attributes. Note that an :inherit
3447 attribute of `unspecified' is the same as one of nil; we never
3448 merge :inherit attributes, so nil is more correct, but lots of
3449 other code uses `unspecified' as a generic value for face attributes. */
3450 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3451 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3452 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3454 /* If TO specifies a :font attribute, and FROM specifies some
3455 font-related attribute, we need to clear TO's :font attribute
3456 (because it will be inconsistent with whatever FROM specifies, and
3457 FROM takes precedence). */
3458 if (!NILP (to
[LFACE_FONT_INDEX
])
3459 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3460 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3461 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3462 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3463 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3464 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3465 to
[LFACE_FONT_INDEX
] = Qnil
;
3467 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3468 if (!UNSPECIFIEDP (from
[i
]))
3470 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3471 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3476 /* TO is always an absolute face, which should inherit from nothing.
3477 We blindly copy the :inherit attribute above and fix it up here. */
3478 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3482 /* Checks the `cycle check' variable CHECK to see if it indicates that
3483 EL is part of a cycle; CHECK must be either Qnil or a value returned
3484 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3485 elements after which a cycle might be suspected; after that many
3486 elements, this macro begins consing in order to keep more precise
3489 Returns nil if a cycle was detected, otherwise a new value for CHECK
3492 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3493 the caller should make sure that's ok. */
3495 #define CYCLE_CHECK(check, el, suspicious) \
3498 : (INTEGERP (check) \
3499 ? (XFASTINT (check) < (suspicious) \
3500 ? make_number (XFASTINT (check) + 1) \
3501 : Fcons (el, Qnil)) \
3502 : (!NILP (Fmemq ((el), (check))) \
3504 : Fcons ((el), (check)))))
3507 /* Merge face attributes from the face on frame F whose name is
3508 INHERITS, into the vector of face attributes TO; INHERITS may also be
3509 a list of face names, in which case they are applied in order.
3510 CYCLE_CHECK is used to detect loops in face inheritance.
3511 Returns true if any of the inherited attributes are `font-related'. */
3514 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3516 Lisp_Object inherit
;
3518 Lisp_Object cycle_check
;
3520 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3521 /* Inherit from the named face INHERIT. */
3525 /* Make sure we're not in an inheritance loop. */
3526 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3527 if (NILP (cycle_check
))
3528 /* Cycle detected, ignore any further inheritance. */
3531 lface
= lface_from_face_name (f
, inherit
, 0);
3533 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3535 else if (CONSP (inherit
))
3536 /* Handle a list of inherited faces by calling ourselves recursively
3537 on each element. Note that we only do so for symbol elements, so
3538 it's not possible to infinitely recurse. */
3540 while (CONSP (inherit
))
3542 if (SYMBOLP (XCAR (inherit
)))
3543 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3545 /* Check for a circular inheritance list. */
3546 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3547 if (NILP (cycle_check
))
3548 /* Cycle detected. */
3551 inherit
= XCDR (inherit
);
3557 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3558 is a face property, determine the resulting face attributes on
3559 frame F, and store them in TO. PROP may be a single face
3560 specification or a list of such specifications. Each face
3561 specification can be
3563 1. A symbol or string naming a Lisp face.
3565 2. A property list of the form (KEYWORD VALUE ...) where each
3566 KEYWORD is a face attribute name, and value is an appropriate value
3569 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3570 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3571 for compatibility with 20.2.
3573 Face specifications earlier in lists take precedence over later
3577 merge_face_vector_with_property (f
, to
, prop
)
3584 Lisp_Object first
= XCAR (prop
);
3586 if (EQ (first
, Qforeground_color
)
3587 || EQ (first
, Qbackground_color
))
3589 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3590 . COLOR). COLOR must be a string. */
3591 Lisp_Object color_name
= XCDR (prop
);
3592 Lisp_Object color
= first
;
3594 if (STRINGP (color_name
))
3596 if (EQ (color
, Qforeground_color
))
3597 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3599 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3602 add_to_log ("Invalid face color", color_name
, Qnil
);
3604 else if (SYMBOLP (first
)
3605 && *SDATA (SYMBOL_NAME (first
)) == ':')
3607 /* Assume this is the property list form. */
3608 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3610 Lisp_Object keyword
= XCAR (prop
);
3611 Lisp_Object value
= XCAR (XCDR (prop
));
3613 if (EQ (keyword
, QCfamily
))
3615 if (STRINGP (value
))
3616 to
[LFACE_FAMILY_INDEX
] = value
;
3618 add_to_log ("Invalid face font family", value
, Qnil
);
3620 else if (EQ (keyword
, QCheight
))
3622 Lisp_Object new_height
=
3623 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3626 if (NILP (new_height
))
3627 add_to_log ("Invalid face font height", value
, Qnil
);
3629 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3631 else if (EQ (keyword
, QCweight
))
3634 && face_numeric_weight (value
) >= 0)
3635 to
[LFACE_WEIGHT_INDEX
] = value
;
3637 add_to_log ("Invalid face weight", value
, Qnil
);
3639 else if (EQ (keyword
, QCslant
))
3642 && face_numeric_slant (value
) >= 0)
3643 to
[LFACE_SLANT_INDEX
] = value
;
3645 add_to_log ("Invalid face slant", value
, Qnil
);
3647 else if (EQ (keyword
, QCunderline
))
3652 to
[LFACE_UNDERLINE_INDEX
] = value
;
3654 add_to_log ("Invalid face underline", value
, Qnil
);
3656 else if (EQ (keyword
, QCoverline
))
3661 to
[LFACE_OVERLINE_INDEX
] = value
;
3663 add_to_log ("Invalid face overline", value
, Qnil
);
3665 else if (EQ (keyword
, QCstrike_through
))
3670 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3672 add_to_log ("Invalid face strike-through", value
, Qnil
);
3674 else if (EQ (keyword
, QCbox
))
3677 value
= make_number (1);
3678 if (INTEGERP (value
)
3682 to
[LFACE_BOX_INDEX
] = value
;
3684 add_to_log ("Invalid face box", value
, Qnil
);
3686 else if (EQ (keyword
, QCinverse_video
)
3687 || EQ (keyword
, QCreverse_video
))
3689 if (EQ (value
, Qt
) || NILP (value
))
3690 to
[LFACE_INVERSE_INDEX
] = value
;
3692 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3694 else if (EQ (keyword
, QCforeground
))
3696 if (STRINGP (value
))
3697 to
[LFACE_FOREGROUND_INDEX
] = value
;
3699 add_to_log ("Invalid face foreground", value
, Qnil
);
3701 else if (EQ (keyword
, QCbackground
))
3703 if (STRINGP (value
))
3704 to
[LFACE_BACKGROUND_INDEX
] = value
;
3706 add_to_log ("Invalid face background", value
, Qnil
);
3708 else if (EQ (keyword
, QCstipple
))
3710 #ifdef HAVE_X_WINDOWS
3711 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3712 if (!NILP (pixmap_p
))
3713 to
[LFACE_STIPPLE_INDEX
] = value
;
3715 add_to_log ("Invalid face stipple", value
, Qnil
);
3718 else if (EQ (keyword
, QCwidth
))
3721 && face_numeric_swidth (value
) >= 0)
3722 to
[LFACE_SWIDTH_INDEX
] = value
;
3724 add_to_log ("Invalid face width", value
, Qnil
);
3726 else if (EQ (keyword
, QCinherit
))
3728 if (SYMBOLP (value
))
3729 to
[LFACE_INHERIT_INDEX
] = value
;
3733 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3734 if (!SYMBOLP (XCAR (tail
)))
3737 to
[LFACE_INHERIT_INDEX
] = value
;
3739 add_to_log ("Invalid face inherit", value
, Qnil
);
3743 add_to_log ("Invalid attribute %s in face property",
3746 prop
= XCDR (XCDR (prop
));
3751 /* This is a list of face specs. Specifications at the
3752 beginning of the list take precedence over later
3753 specifications, so we have to merge starting with the
3754 last specification. */
3755 Lisp_Object next
= XCDR (prop
);
3757 merge_face_vector_with_property (f
, to
, next
);
3758 merge_face_vector_with_property (f
, to
, first
);
3763 /* PROP ought to be a face name. */
3764 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3766 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3768 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3773 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3774 Sinternal_make_lisp_face
, 1, 2, 0,
3775 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3776 If FACE was not known as a face before, create a new one.
3777 If optional argument FRAME is specified, make a frame-local face
3778 for that frame. Otherwise operate on the global face definition.
3779 Value is a vector of face attributes. */)
3781 Lisp_Object face
, frame
;
3783 Lisp_Object global_lface
, lface
;
3787 CHECK_SYMBOL (face
);
3788 global_lface
= lface_from_face_name (NULL
, face
, 0);
3792 CHECK_LIVE_FRAME (frame
);
3794 lface
= lface_from_face_name (f
, face
, 0);
3797 f
= NULL
, lface
= Qnil
;
3799 /* Add a global definition if there is none. */
3800 if (NILP (global_lface
))
3802 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3804 AREF (global_lface
, 0) = Qface
;
3805 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3806 Vface_new_frame_defaults
);
3808 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3809 face id to Lisp face is given by the vector lface_id_to_name.
3810 The mapping from Lisp face to Lisp face id is given by the
3811 property `face' of the Lisp face name. */
3812 if (next_lface_id
== lface_id_to_name_size
)
3814 int new_size
= max (50, 2 * lface_id_to_name_size
);
3815 int sz
= new_size
* sizeof *lface_id_to_name
;
3816 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3817 lface_id_to_name_size
= new_size
;
3820 lface_id_to_name
[next_lface_id
] = face
;
3821 Fput (face
, Qface
, make_number (next_lface_id
));
3825 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3826 AREF (global_lface
, i
) = Qunspecified
;
3828 /* Add a frame-local definition. */
3833 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3835 AREF (lface
, 0) = Qface
;
3836 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3839 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3840 AREF (lface
, i
) = Qunspecified
;
3843 lface
= global_lface
;
3845 /* Changing a named face means that all realized faces depending on
3846 that face are invalid. Since we cannot tell which realized faces
3847 depend on the face, make sure they are all removed. This is done
3848 by incrementing face_change_count. The next call to
3849 init_iterator will then free realized faces. */
3850 ++face_change_count
;
3851 ++windows_or_buffers_changed
;
3853 xassert (LFACEP (lface
));
3854 check_lface (lface
);
3859 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3860 Sinternal_lisp_face_p
, 1, 2, 0,
3861 doc
: /* Return non-nil if FACE names a face.
3862 If optional second parameter FRAME is non-nil, check for the
3863 existence of a frame-local face with name FACE on that frame.
3864 Otherwise check for the existence of a global face. */)
3866 Lisp_Object face
, frame
;
3872 CHECK_LIVE_FRAME (frame
);
3873 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3876 lface
= lface_from_face_name (NULL
, face
, 0);
3882 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3883 Sinternal_copy_lisp_face
, 4, 4, 0,
3884 doc
: /* Copy face FROM to TO.
3885 If FRAME it t, copy the global face definition of FROM to the
3886 global face definition of TO. Otherwise, copy the frame-local
3887 definition of FROM on FRAME to the frame-local definition of TO
3888 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3891 (from
, to
, frame
, new_frame
)
3892 Lisp_Object from
, to
, frame
, new_frame
;
3894 Lisp_Object lface
, copy
;
3896 CHECK_SYMBOL (from
);
3898 if (NILP (new_frame
))
3903 /* Copy global definition of FROM. We don't make copies of
3904 strings etc. because 20.2 didn't do it either. */
3905 lface
= lface_from_face_name (NULL
, from
, 1);
3906 copy
= Finternal_make_lisp_face (to
, Qnil
);
3910 /* Copy frame-local definition of FROM. */
3911 CHECK_LIVE_FRAME (frame
);
3912 CHECK_LIVE_FRAME (new_frame
);
3913 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3914 copy
= Finternal_make_lisp_face (to
, new_frame
);
3917 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3918 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3920 /* Changing a named face means that all realized faces depending on
3921 that face are invalid. Since we cannot tell which realized faces
3922 depend on the face, make sure they are all removed. This is done
3923 by incrementing face_change_count. The next call to
3924 init_iterator will then free realized faces. */
3925 ++face_change_count
;
3926 ++windows_or_buffers_changed
;
3932 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3933 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3934 doc
: /* Set attribute ATTR of FACE to VALUE.
3935 FRAME being a frame means change the face on that frame.
3936 FRAME nil means change the face of the selected frame.
3937 FRAME t means change the default for new frames.
3938 FRAME 0 means change the face on all frames, and change the default
3940 (face
, attr
, value
, frame
)
3941 Lisp_Object face
, attr
, value
, frame
;
3944 Lisp_Object old_value
= Qnil
;
3945 /* Set 1 if ATTR is QCfont. */
3946 int font_attr_p
= 0;
3947 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3948 int font_related_attr_p
= 0;
3950 CHECK_SYMBOL (face
);
3951 CHECK_SYMBOL (attr
);
3953 face
= resolve_face_name (face
);
3955 /* If FRAME is 0, change face on all frames, and change the
3956 default for new frames. */
3957 if (INTEGERP (frame
) && XINT (frame
) == 0)
3960 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3961 FOR_EACH_FRAME (tail
, frame
)
3962 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3966 /* Set lface to the Lisp attribute vector of FACE. */
3968 lface
= lface_from_face_name (NULL
, face
, 1);
3972 frame
= selected_frame
;
3974 CHECK_LIVE_FRAME (frame
);
3975 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3977 /* If a frame-local face doesn't exist yet, create one. */
3979 lface
= Finternal_make_lisp_face (face
, frame
);
3982 if (EQ (attr
, QCfamily
))
3984 if (!UNSPECIFIEDP (value
))
3986 CHECK_STRING (value
);
3987 if (SCHARS (value
) == 0)
3988 signal_error ("Invalid face family", value
);
3990 old_value
= LFACE_FAMILY (lface
);
3991 LFACE_FAMILY (lface
) = value
;
3992 font_related_attr_p
= 1;
3994 else if (EQ (attr
, QCheight
))
3996 if (!UNSPECIFIEDP (value
))
4000 test
= (EQ (face
, Qdefault
)
4002 /* The default face must have an absolute size,
4003 otherwise, we do a test merge with a random
4004 height to see if VALUE's ok. */
4005 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
4007 if (!INTEGERP (test
) || XINT (test
) <= 0)
4008 signal_error ("Invalid face height", value
);
4011 old_value
= LFACE_HEIGHT (lface
);
4012 LFACE_HEIGHT (lface
) = value
;
4013 font_related_attr_p
= 1;
4015 else if (EQ (attr
, QCweight
))
4017 if (!UNSPECIFIEDP (value
))
4019 CHECK_SYMBOL (value
);
4020 if (face_numeric_weight (value
) < 0)
4021 signal_error ("Invalid face weight", value
);
4023 old_value
= LFACE_WEIGHT (lface
);
4024 LFACE_WEIGHT (lface
) = value
;
4025 font_related_attr_p
= 1;
4027 else if (EQ (attr
, QCslant
))
4029 if (!UNSPECIFIEDP (value
))
4031 CHECK_SYMBOL (value
);
4032 if (face_numeric_slant (value
) < 0)
4033 signal_error ("Invalid face slant", value
);
4035 old_value
= LFACE_SLANT (lface
);
4036 LFACE_SLANT (lface
) = value
;
4037 font_related_attr_p
= 1;
4039 else if (EQ (attr
, QCunderline
))
4041 if (!UNSPECIFIEDP (value
))
4042 if ((SYMBOLP (value
)
4044 && !EQ (value
, Qnil
))
4045 /* Underline color. */
4047 && SCHARS (value
) == 0))
4048 signal_error ("Invalid face underline", value
);
4050 old_value
= LFACE_UNDERLINE (lface
);
4051 LFACE_UNDERLINE (lface
) = value
;
4053 else if (EQ (attr
, QCoverline
))
4055 if (!UNSPECIFIEDP (value
))
4056 if ((SYMBOLP (value
)
4058 && !EQ (value
, Qnil
))
4059 /* Overline color. */
4061 && SCHARS (value
) == 0))
4062 signal_error ("Invalid face overline", value
);
4064 old_value
= LFACE_OVERLINE (lface
);
4065 LFACE_OVERLINE (lface
) = value
;
4067 else if (EQ (attr
, QCstrike_through
))
4069 if (!UNSPECIFIEDP (value
))
4070 if ((SYMBOLP (value
)
4072 && !EQ (value
, Qnil
))
4073 /* Strike-through color. */
4075 && SCHARS (value
) == 0))
4076 signal_error ("Invalid face strike-through", value
);
4078 old_value
= LFACE_STRIKE_THROUGH (lface
);
4079 LFACE_STRIKE_THROUGH (lface
) = value
;
4081 else if (EQ (attr
, QCbox
))
4085 /* Allow t meaning a simple box of width 1 in foreground color
4088 value
= make_number (1);
4090 if (UNSPECIFIEDP (value
))
4092 else if (NILP (value
))
4094 else if (INTEGERP (value
))
4095 valid_p
= XINT (value
) != 0;
4096 else if (STRINGP (value
))
4097 valid_p
= SCHARS (value
) > 0;
4098 else if (CONSP (value
))
4114 if (EQ (k
, QCline_width
))
4116 if (!INTEGERP (v
) || XINT (v
) == 0)
4119 else if (EQ (k
, QCcolor
))
4121 if (!STRINGP (v
) || SCHARS (v
) == 0)
4124 else if (EQ (k
, QCstyle
))
4126 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4133 valid_p
= NILP (tem
);
4139 signal_error ("Invalid face box", value
);
4141 old_value
= LFACE_BOX (lface
);
4142 LFACE_BOX (lface
) = value
;
4144 else if (EQ (attr
, QCinverse_video
)
4145 || EQ (attr
, QCreverse_video
))
4147 if (!UNSPECIFIEDP (value
))
4149 CHECK_SYMBOL (value
);
4150 if (!EQ (value
, Qt
) && !NILP (value
))
4151 signal_error ("Invalid inverse-video face attribute value", value
);
4153 old_value
= LFACE_INVERSE (lface
);
4154 LFACE_INVERSE (lface
) = value
;
4156 else if (EQ (attr
, QCforeground
))
4158 if (!UNSPECIFIEDP (value
))
4160 /* Don't check for valid color names here because it depends
4161 on the frame (display) whether the color will be valid
4162 when the face is realized. */
4163 CHECK_STRING (value
);
4164 if (SCHARS (value
) == 0)
4165 signal_error ("Empty foreground color value", value
);
4167 old_value
= LFACE_FOREGROUND (lface
);
4168 LFACE_FOREGROUND (lface
) = value
;
4170 else if (EQ (attr
, QCbackground
))
4172 if (!UNSPECIFIEDP (value
))
4174 /* Don't check for valid color names here because it depends
4175 on the frame (display) whether the color will be valid
4176 when the face is realized. */
4177 CHECK_STRING (value
);
4178 if (SCHARS (value
) == 0)
4179 signal_error ("Empty background color value", value
);
4181 old_value
= LFACE_BACKGROUND (lface
);
4182 LFACE_BACKGROUND (lface
) = value
;
4184 else if (EQ (attr
, QCstipple
))
4186 #ifdef HAVE_X_WINDOWS
4187 if (!UNSPECIFIEDP (value
)
4189 && NILP (Fbitmap_spec_p (value
)))
4190 signal_error ("Invalid stipple attribute", value
);
4191 old_value
= LFACE_STIPPLE (lface
);
4192 LFACE_STIPPLE (lface
) = value
;
4193 #endif /* HAVE_X_WINDOWS */
4195 else if (EQ (attr
, QCwidth
))
4197 if (!UNSPECIFIEDP (value
))
4199 CHECK_SYMBOL (value
);
4200 if (face_numeric_swidth (value
) < 0)
4201 signal_error ("Invalid face width", value
);
4203 old_value
= LFACE_SWIDTH (lface
);
4204 LFACE_SWIDTH (lface
) = value
;
4205 font_related_attr_p
= 1;
4207 else if (EQ (attr
, QCfont
))
4209 #ifdef HAVE_WINDOW_SYSTEM
4210 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4212 /* Set font-related attributes of the Lisp face from an XLFD
4218 f
= SELECTED_FRAME ();
4220 f
= check_x_frame (frame
);
4222 if (!UNSPECIFIEDP (value
))
4224 CHECK_STRING (value
);
4226 /* VALUE may be a fontset name or an alias of fontset. In
4227 such a case, use the base fontset name. */
4228 tmp
= Fquery_fontset (value
, Qnil
);
4232 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4233 signal_error ("Invalid font or fontset name", value
);
4238 #endif /* HAVE_WINDOW_SYSTEM */
4240 else if (EQ (attr
, QCinherit
))
4243 if (SYMBOLP (value
))
4246 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4247 if (!SYMBOLP (XCAR (tail
)))
4250 LFACE_INHERIT (lface
) = value
;
4252 signal_error ("Invalid face inheritance", value
);
4254 else if (EQ (attr
, QCbold
))
4256 old_value
= LFACE_WEIGHT (lface
);
4257 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4258 font_related_attr_p
= 1;
4260 else if (EQ (attr
, QCitalic
))
4262 old_value
= LFACE_SLANT (lface
);
4263 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4264 font_related_attr_p
= 1;
4267 signal_error ("Invalid face attribute name", attr
);
4269 if (font_related_attr_p
4270 && !UNSPECIFIEDP (value
))
4271 /* If a font-related attribute other than QCfont is specified, the
4272 original `font' attribute nor that of default face is useless
4273 to determine a new font. Thus, we set it to nil so that font
4274 selection mechanism doesn't use it. */
4275 LFACE_FONT (lface
) = Qnil
;
4277 /* Changing a named face means that all realized faces depending on
4278 that face are invalid. Since we cannot tell which realized faces
4279 depend on the face, make sure they are all removed. This is done
4280 by incrementing face_change_count. The next call to
4281 init_iterator will then free realized faces. */
4283 && (EQ (attr
, QCfont
)
4284 || NILP (Fequal (old_value
, value
))))
4286 ++face_change_count
;
4287 ++windows_or_buffers_changed
;
4290 if (!UNSPECIFIEDP (value
)
4291 && NILP (Fequal (old_value
, value
)))
4297 if (EQ (face
, Qdefault
))
4299 #ifdef HAVE_WINDOW_SYSTEM
4300 /* Changed font-related attributes of the `default' face are
4301 reflected in changed `font' frame parameters. */
4303 && (font_related_attr_p
|| font_attr_p
)
4304 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4305 set_font_frame_param (frame
, lface
);
4307 #endif /* HAVE_WINDOW_SYSTEM */
4309 if (EQ (attr
, QCforeground
))
4310 param
= Qforeground_color
;
4311 else if (EQ (attr
, QCbackground
))
4312 param
= Qbackground_color
;
4314 #ifdef HAVE_WINDOW_SYSTEM
4316 else if (EQ (face
, Qscroll_bar
))
4318 /* Changing the colors of `scroll-bar' sets frame parameters
4319 `scroll-bar-foreground' and `scroll-bar-background'. */
4320 if (EQ (attr
, QCforeground
))
4321 param
= Qscroll_bar_foreground
;
4322 else if (EQ (attr
, QCbackground
))
4323 param
= Qscroll_bar_background
;
4325 #endif /* not WINDOWSNT */
4326 else if (EQ (face
, Qborder
))
4328 /* Changing background color of `border' sets frame parameter
4330 if (EQ (attr
, QCbackground
))
4331 param
= Qborder_color
;
4333 else if (EQ (face
, Qcursor
))
4335 /* Changing background color of `cursor' sets frame parameter
4337 if (EQ (attr
, QCbackground
))
4338 param
= Qcursor_color
;
4340 else if (EQ (face
, Qmouse
))
4342 /* Changing background color of `mouse' sets frame parameter
4344 if (EQ (attr
, QCbackground
))
4345 param
= Qmouse_color
;
4347 #endif /* HAVE_WINDOW_SYSTEM */
4348 else if (EQ (face
, Qmenu
))
4350 /* Indicate that we have to update the menu bar when
4351 realizing faces on FRAME. FRAME t change the
4352 default for new frames. We do this by setting
4353 setting the flag in new face caches */
4356 struct frame
*f
= XFRAME (frame
);
4357 if (FRAME_FACE_CACHE (f
) == NULL
)
4358 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4359 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4362 menu_face_changed_default
= 1;
4368 /* Update `default-frame-alist', which is used for new frames. */
4370 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4373 /* Update the current frame's parameters. */
4376 cons
= XCAR (Vparam_value_alist
);
4377 XSETCAR (cons
, param
);
4378 XSETCDR (cons
, value
);
4379 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4388 #ifdef HAVE_WINDOW_SYSTEM
4390 /* Set the `font' frame parameter of FRAME determined from `default'
4391 face attributes LFACE. If a face or fontset name is explicitely
4392 specfied in LFACE, use it as is. Otherwise, determine a font name
4393 from the other font-related atrributes of LFACE. In that case, if
4394 there's no matching font, signals an error. */
4397 set_font_frame_param (frame
, lface
)
4398 Lisp_Object frame
, lface
;
4400 struct frame
*f
= XFRAME (frame
);
4402 if (FRAME_WINDOW_P (f
))
4404 Lisp_Object font_name
;
4407 if (STRINGP (LFACE_FONT (lface
)))
4408 font_name
= LFACE_FONT (lface
);
4411 /* Choose a font name that reflects LFACE's attributes and has
4412 the registry and encoding pattern specified in the default
4413 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4414 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0, 0);
4416 error ("No font matches the specified attribute");
4417 font_name
= build_string (font
);
4421 f
->default_face_done_p
= 0;
4422 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4427 /* Update the corresponding face when frame parameter PARAM on frame F
4428 has been assigned the value NEW_VALUE. */
4431 update_face_from_frame_parameter (f
, param
, new_value
)
4433 Lisp_Object param
, new_value
;
4437 /* If there are no faces yet, give up. This is the case when called
4438 from Fx_create_frame, and we do the necessary things later in
4439 face-set-after-frame-defaults. */
4440 if (NILP (f
->face_alist
))
4443 /* Changing a named face means that all realized faces depending on
4444 that face are invalid. Since we cannot tell which realized faces
4445 depend on the face, make sure they are all removed. This is done
4446 by incrementing face_change_count. The next call to
4447 init_iterator will then free realized faces. */
4448 ++face_change_count
;
4449 ++windows_or_buffers_changed
;
4451 if (EQ (param
, Qforeground_color
))
4453 lface
= lface_from_face_name (f
, Qdefault
, 1);
4454 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4455 ? new_value
: Qunspecified
);
4456 realize_basic_faces (f
);
4458 else if (EQ (param
, Qbackground_color
))
4462 /* Changing the background color might change the background
4463 mode, so that we have to load new defface specs. Call
4464 frame-update-face-colors to do that. */
4465 XSETFRAME (frame
, f
);
4466 call1 (Qframe_update_face_colors
, frame
);
4468 lface
= lface_from_face_name (f
, Qdefault
, 1);
4469 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4470 ? new_value
: Qunspecified
);
4471 realize_basic_faces (f
);
4473 if (EQ (param
, Qborder_color
))
4475 lface
= lface_from_face_name (f
, Qborder
, 1);
4476 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4477 ? new_value
: Qunspecified
);
4479 else if (EQ (param
, Qcursor_color
))
4481 lface
= lface_from_face_name (f
, Qcursor
, 1);
4482 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4483 ? new_value
: Qunspecified
);
4485 else if (EQ (param
, Qmouse_color
))
4487 lface
= lface_from_face_name (f
, Qmouse
, 1);
4488 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4489 ? new_value
: Qunspecified
);
4494 /* Get the value of X resource RESOURCE, class CLASS for the display
4495 of frame FRAME. This is here because ordinary `x-get-resource'
4496 doesn't take a frame argument. */
4498 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4499 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4500 (resource
, class, frame
)
4501 Lisp_Object resource
, class, frame
;
4503 Lisp_Object value
= Qnil
;
4504 CHECK_STRING (resource
);
4505 CHECK_STRING (class);
4506 CHECK_LIVE_FRAME (frame
);
4508 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4509 resource
, class, Qnil
, Qnil
);
4515 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4516 If VALUE is "on" or "true", return t. If VALUE is "off" or
4517 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4518 error; if SIGNAL_P is zero, return 0. */
4521 face_boolean_x_resource_value (value
, signal_p
)
4525 Lisp_Object result
= make_number (0);
4527 xassert (STRINGP (value
));
4529 if (xstricmp (SDATA (value
), "on") == 0
4530 || xstricmp (SDATA (value
), "true") == 0)
4532 else if (xstricmp (SDATA (value
), "off") == 0
4533 || xstricmp (SDATA (value
), "false") == 0)
4535 else if (xstricmp (SDATA (value
), "unspecified") == 0)
4536 result
= Qunspecified
;
4538 signal_error ("Invalid face attribute value from X resource", value
);
4544 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4545 Finternal_set_lisp_face_attribute_from_resource
,
4546 Sinternal_set_lisp_face_attribute_from_resource
,
4547 3, 4, 0, doc
: /* */)
4548 (face
, attr
, value
, frame
)
4549 Lisp_Object face
, attr
, value
, frame
;
4551 CHECK_SYMBOL (face
);
4552 CHECK_SYMBOL (attr
);
4553 CHECK_STRING (value
);
4555 if (xstricmp (SDATA (value
), "unspecified") == 0)
4556 value
= Qunspecified
;
4557 else if (EQ (attr
, QCheight
))
4559 value
= Fstring_to_number (value
, make_number (10));
4560 if (XINT (value
) <= 0)
4561 signal_error ("Invalid face height from X resource", value
);
4563 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4564 value
= face_boolean_x_resource_value (value
, 1);
4565 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4566 value
= intern (SDATA (value
));
4567 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4568 value
= face_boolean_x_resource_value (value
, 1);
4569 else if (EQ (attr
, QCunderline
)
4570 || EQ (attr
, QCoverline
)
4571 || EQ (attr
, QCstrike_through
))
4573 Lisp_Object boolean_value
;
4575 /* If the result of face_boolean_x_resource_value is t or nil,
4576 VALUE does NOT specify a color. */
4577 boolean_value
= face_boolean_x_resource_value (value
, 0);
4578 if (SYMBOLP (boolean_value
))
4579 value
= boolean_value
;
4581 else if (EQ (attr
, QCbox
))
4582 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4584 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4587 #endif /* HAVE_WINDOW_SYSTEM */
4590 /***********************************************************************
4592 ***********************************************************************/
4594 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4596 /* Make menus on frame F appear as specified by the `menu' face. */
4599 x_update_menu_appearance (f
)
4602 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4606 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4610 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4611 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4612 const char *myname
= SDATA (Vx_resource_name
);
4615 const char *popup_path
= "popup_menu";
4617 const char *popup_path
= "menu.popup";
4620 if (STRINGP (LFACE_FOREGROUND (lface
)))
4622 sprintf (line
, "%s.%s*foreground: %s",
4624 SDATA (LFACE_FOREGROUND (lface
)));
4625 XrmPutLineResource (&rdb
, line
);
4626 sprintf (line
, "%s.pane.menubar*foreground: %s",
4627 myname
, SDATA (LFACE_FOREGROUND (lface
)));
4628 XrmPutLineResource (&rdb
, line
);
4632 if (STRINGP (LFACE_BACKGROUND (lface
)))
4634 sprintf (line
, "%s.%s*background: %s",
4636 SDATA (LFACE_BACKGROUND (lface
)));
4637 XrmPutLineResource (&rdb
, line
);
4638 sprintf (line
, "%s.pane.menubar*background: %s",
4639 myname
, SDATA (LFACE_BACKGROUND (lface
)));
4640 XrmPutLineResource (&rdb
, line
);
4645 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4646 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4647 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4648 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4649 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4650 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4653 const char *suffix
= "List";
4655 const char *suffix
= "";
4657 sprintf (line
, "%s.pane.menubar*font%s: %s",
4658 myname
, suffix
, face
->font_name
);
4659 XrmPutLineResource (&rdb
, line
);
4660 sprintf (line
, "%s.%s*font%s: %s",
4661 myname
, popup_path
, suffix
, face
->font_name
);
4662 XrmPutLineResource (&rdb
, line
);
4666 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4667 free_frame_menubar (f
);
4671 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4674 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4675 Sface_attribute_relative_p
,
4677 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4679 Lisp_Object attribute
, value
;
4681 if (EQ (value
, Qunspecified
))
4683 else if (EQ (attribute
, QCheight
))
4684 return INTEGERP (value
) ? Qnil
: Qt
;
4689 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4691 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4692 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4693 the result will be absolute, otherwise it will be relative. */)
4694 (attribute
, value1
, value2
)
4695 Lisp_Object attribute
, value1
, value2
;
4697 if (EQ (value1
, Qunspecified
))
4699 else if (EQ (attribute
, QCheight
))
4700 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4706 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4707 Sinternal_get_lisp_face_attribute
,
4709 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4710 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4711 face attribute name, signal an error.
4712 If the optional argument FRAME is given, report on face FACE in that
4713 frame. If FRAME is t, report on the defaults for face FACE (for new
4714 frames). If FRAME is omitted or nil, use the selected frame. */)
4715 (symbol
, keyword
, frame
)
4716 Lisp_Object symbol
, keyword
, frame
;
4718 Lisp_Object lface
, value
= Qnil
;
4720 CHECK_SYMBOL (symbol
);
4721 CHECK_SYMBOL (keyword
);
4724 lface
= lface_from_face_name (NULL
, symbol
, 1);
4728 frame
= selected_frame
;
4729 CHECK_LIVE_FRAME (frame
);
4730 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4733 if (EQ (keyword
, QCfamily
))
4734 value
= LFACE_FAMILY (lface
);
4735 else if (EQ (keyword
, QCheight
))
4736 value
= LFACE_HEIGHT (lface
);
4737 else if (EQ (keyword
, QCweight
))
4738 value
= LFACE_WEIGHT (lface
);
4739 else if (EQ (keyword
, QCslant
))
4740 value
= LFACE_SLANT (lface
);
4741 else if (EQ (keyword
, QCunderline
))
4742 value
= LFACE_UNDERLINE (lface
);
4743 else if (EQ (keyword
, QCoverline
))
4744 value
= LFACE_OVERLINE (lface
);
4745 else if (EQ (keyword
, QCstrike_through
))
4746 value
= LFACE_STRIKE_THROUGH (lface
);
4747 else if (EQ (keyword
, QCbox
))
4748 value
= LFACE_BOX (lface
);
4749 else if (EQ (keyword
, QCinverse_video
)
4750 || EQ (keyword
, QCreverse_video
))
4751 value
= LFACE_INVERSE (lface
);
4752 else if (EQ (keyword
, QCforeground
))
4753 value
= LFACE_FOREGROUND (lface
);
4754 else if (EQ (keyword
, QCbackground
))
4755 value
= LFACE_BACKGROUND (lface
);
4756 else if (EQ (keyword
, QCstipple
))
4757 value
= LFACE_STIPPLE (lface
);
4758 else if (EQ (keyword
, QCwidth
))
4759 value
= LFACE_SWIDTH (lface
);
4760 else if (EQ (keyword
, QCinherit
))
4761 value
= LFACE_INHERIT (lface
);
4762 else if (EQ (keyword
, QCfont
))
4763 value
= LFACE_FONT (lface
);
4765 signal_error ("Invalid face attribute name", keyword
);
4771 DEFUN ("internal-lisp-face-attribute-values",
4772 Finternal_lisp_face_attribute_values
,
4773 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4774 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4775 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4779 Lisp_Object result
= Qnil
;
4781 CHECK_SYMBOL (attr
);
4783 if (EQ (attr
, QCweight
)
4784 || EQ (attr
, QCslant
)
4785 || EQ (attr
, QCwidth
))
4787 /* Extract permissible symbols from tables. */
4788 struct table_entry
*table
;
4791 if (EQ (attr
, QCweight
))
4792 table
= weight_table
, dim
= DIM (weight_table
);
4793 else if (EQ (attr
, QCslant
))
4794 table
= slant_table
, dim
= DIM (slant_table
);
4796 table
= swidth_table
, dim
= DIM (swidth_table
);
4798 for (i
= 0; i
< dim
; ++i
)
4800 Lisp_Object symbol
= *table
[i
].symbol
;
4801 Lisp_Object tail
= result
;
4804 && !EQ (XCAR (tail
), symbol
))
4808 result
= Fcons (symbol
, result
);
4811 else if (EQ (attr
, QCunderline
))
4812 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4813 else if (EQ (attr
, QCoverline
))
4814 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4815 else if (EQ (attr
, QCstrike_through
))
4816 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4817 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4818 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4824 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4825 Sinternal_merge_in_global_face
, 2, 2, 0,
4826 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4827 Default face attributes override any local face attributes. */)
4829 Lisp_Object face
, frame
;
4832 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4834 CHECK_LIVE_FRAME (frame
);
4835 global_lface
= lface_from_face_name (NULL
, face
, 1);
4836 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4837 if (NILP (local_lface
))
4838 local_lface
= Finternal_make_lisp_face (face
, frame
);
4840 /* Make every specified global attribute override the local one.
4841 BEWARE!! This is only used from `face-set-after-frame-default' where
4842 the local frame is defined from default specs in `face-defface-spec'
4843 and those should be overridden by global settings. Hence the strange
4844 "global before local" priority. */
4845 lvec
= XVECTOR (local_lface
)->contents
;
4846 gvec
= XVECTOR (global_lface
)->contents
;
4847 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4848 if (! UNSPECIFIEDP (gvec
[i
]))
4855 /* The following function is implemented for compatibility with 20.2.
4856 The function is used in x-resolve-fonts when it is asked to
4857 return fonts with the same size as the font of a face. This is
4858 done in fontset.el. */
4860 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4861 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4862 If the optional argument FRAME is given, report on face FACE in that frame.
4863 If FRAME is t, report on the defaults for face FACE (for new frames).
4864 The font default for a face is either nil, or a list
4865 of the form (bold), (italic) or (bold italic).
4866 If FRAME is omitted or nil, use the selected frame. */)
4868 Lisp_Object face
, frame
;
4872 Lisp_Object result
= Qnil
;
4873 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4875 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4876 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4877 result
= Fcons (Qbold
, result
);
4879 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4880 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4881 result
= Fcons (Qitalic
, result
);
4887 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4888 int face_id
= lookup_named_face (f
, face
, 0);
4889 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4890 return face
? build_string (face
->font_name
) : Qnil
;
4895 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4896 all attributes are `equal'. Tries to be fast because this function
4897 is called quite often. */
4900 lface_equal_p (v1
, v2
)
4901 Lisp_Object
*v1
, *v2
;
4905 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4907 Lisp_Object a
= v1
[i
];
4908 Lisp_Object b
= v2
[i
];
4910 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4911 and the other is specified. */
4912 equal_p
= XTYPE (a
) == XTYPE (b
);
4921 equal_p
= ((SBYTES (a
)
4923 && bcmp (SDATA (a
), SDATA (b
),
4933 equal_p
= !NILP (Fequal (a
, b
));
4943 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4944 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4945 doc
: /* True if FACE1 and FACE2 are equal.
4946 If the optional argument FRAME is given, report on face FACE in that frame.
4947 If FRAME is t, report on the defaults for face FACE (for new frames).
4948 If FRAME is omitted or nil, use the selected frame. */)
4949 (face1
, face2
, frame
)
4950 Lisp_Object face1
, face2
, frame
;
4954 Lisp_Object lface1
, lface2
;
4959 /* Don't use check_x_frame here because this function is called
4960 before X frames exist. At that time, if FRAME is nil,
4961 selected_frame will be used which is the frame dumped with
4962 Emacs. That frame is not an X frame. */
4963 f
= frame_or_selected_frame (frame
, 2);
4965 lface1
= lface_from_face_name (NULL
, face1
, 1);
4966 lface2
= lface_from_face_name (NULL
, face2
, 1);
4967 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4968 XVECTOR (lface2
)->contents
);
4969 return equal_p
? Qt
: Qnil
;
4973 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4974 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4975 doc
: /* True if FACE has no attribute specified.
4976 If the optional argument FRAME is given, report on face FACE in that frame.
4977 If FRAME is t, report on the defaults for face FACE (for new frames).
4978 If FRAME is omitted or nil, use the selected frame. */)
4980 Lisp_Object face
, frame
;
4987 frame
= selected_frame
;
4988 CHECK_LIVE_FRAME (frame
);
4992 lface
= lface_from_face_name (NULL
, face
, 1);
4994 lface
= lface_from_face_name (f
, face
, 1);
4996 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4997 if (!UNSPECIFIEDP (AREF (lface
, i
)))
5000 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
5004 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
5006 doc
: /* Return an alist of frame-local faces defined on FRAME.
5007 For internal use only. */)
5011 struct frame
*f
= frame_or_selected_frame (frame
, 0);
5012 return f
->face_alist
;
5016 /* Return a hash code for Lisp string STRING with case ignored. Used
5017 below in computing a hash value for a Lisp face. */
5019 static INLINE
unsigned
5020 hash_string_case_insensitive (string
)
5023 const unsigned char *s
;
5025 xassert (STRINGP (string
));
5026 for (s
= SDATA (string
); *s
; ++s
)
5027 hash
= (hash
<< 1) ^ tolower (*s
);
5032 /* Return a hash code for face attribute vector V. */
5034 static INLINE
unsigned
5038 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5039 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5040 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5041 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5042 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5043 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5044 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5048 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5049 considering charsets/registries). They do if they specify the same
5050 family, point size, weight, width, slant, and fontset. Both LFACE1
5051 and LFACE2 must be fully-specified. */
5054 lface_same_font_attributes_p (lface1
, lface2
)
5055 Lisp_Object
*lface1
, *lface2
;
5057 xassert (lface_fully_specified_p (lface1
)
5058 && lface_fully_specified_p (lface2
));
5059 return (xstricmp (SDATA (lface1
[LFACE_FAMILY_INDEX
]),
5060 SDATA (lface2
[LFACE_FAMILY_INDEX
])) == 0
5061 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5062 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5063 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5064 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5065 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5066 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5067 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5068 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5069 && xstricmp (SDATA (lface1
[LFACE_FONT_INDEX
]),
5070 SDATA (lface2
[LFACE_FONT_INDEX
])))));
5075 /***********************************************************************
5077 ***********************************************************************/
5079 /* Allocate and return a new realized face for Lisp face attribute
5082 static struct face
*
5083 make_realized_face (attr
)
5086 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5087 bzero (face
, sizeof *face
);
5088 face
->ascii_face
= face
;
5089 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5094 /* Free realized face FACE, including its X resources. FACE may
5098 free_realized_face (f
, face
)
5104 #ifdef HAVE_WINDOW_SYSTEM
5105 if (FRAME_WINDOW_P (f
))
5107 /* Free fontset of FACE if it is ASCII face. */
5108 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5109 free_face_fontset (f
, face
);
5112 x_free_gc (f
, face
->gc
);
5116 free_face_colors (f
, face
);
5117 x_destroy_bitmap (f
, face
->stipple
);
5119 #endif /* HAVE_WINDOW_SYSTEM */
5126 /* Prepare face FACE for subsequent display on frame F. This
5127 allocated GCs if they haven't been allocated yet or have been freed
5128 by clearing the face cache. */
5131 prepare_face_for_display (f
, face
)
5135 #ifdef HAVE_WINDOW_SYSTEM
5136 xassert (FRAME_WINDOW_P (f
));
5141 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5143 xgcv
.foreground
= face
->foreground
;
5144 xgcv
.background
= face
->background
;
5145 #ifdef HAVE_X_WINDOWS
5146 xgcv
.graphics_exposures
= False
;
5148 /* The font of FACE may be null if we couldn't load it. */
5151 #ifdef HAVE_X_WINDOWS
5152 xgcv
.font
= face
->font
->fid
;
5155 xgcv
.font
= face
->font
;
5158 xgcv
.font
= face
->font
;
5164 #ifdef HAVE_X_WINDOWS
5167 xgcv
.fill_style
= FillOpaqueStippled
;
5168 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5169 mask
|= GCFillStyle
| GCStipple
;
5172 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5175 #endif /* HAVE_WINDOW_SYSTEM */
5179 /* Returns the `distance' between the colors X and Y. */
5182 color_distance (x
, y
)
5185 /* This formula is from a paper title `Colour metric' by Thiadmer Riemersma.
5186 Quoting from that paper:
5188 This formula has results that are very close to L*u*v* (with the
5189 modified lightness curve) and, more importantly, it is a more even
5190 algorithm: it does not have a range of colours where it suddenly
5191 gives far from optimal results.
5193 See <http://www.compuphase.com/cmetric.htm> for more info. */
5195 long r
= (x
->red
- y
->red
) >> 8;
5196 long g
= (x
->green
- y
->green
) >> 8;
5197 long b
= (x
->blue
- y
->blue
) >> 8;
5198 long r_mean
= (x
->red
+ y
->red
) >> 9;
5201 (((512 + r_mean
) * r
* r
) >> 8)
5203 + (((767 - r_mean
) * b
* b
) >> 8);
5207 DEFUN ("color-distance", Fcolor_distance
, Scolor_distance
, 2, 3, 0,
5208 doc
: /* Return an integer distance between COLOR1 and COLOR2 on FRAME.
5209 COLOR1 and COLOR2 may be either strings containing the color name,
5210 or lists of the form (RED GREEN BLUE).
5211 If FRAME is unspecified or nil, the current frame is used. */)
5212 (color1
, color2
, frame
)
5213 Lisp_Object color1
, color2
, frame
;
5216 XColor cdef1
, cdef2
;
5219 frame
= selected_frame
;
5220 CHECK_LIVE_FRAME (frame
);
5223 if ((CONSP (color1
) && !parse_rgb_list (color1
, &cdef1
))
5224 || !STRINGP (color1
)
5225 || !defined_color (f
, SDATA (color1
), &cdef1
, 0))
5226 signal_error ("Invalid color", color1
);
5227 if ((CONSP (color2
) && !parse_rgb_list (color2
, &cdef2
))
5228 || !STRINGP (color2
)
5229 || !defined_color (f
, SDATA (color2
), &cdef2
, 0))
5230 signal_error ("Invalid color", color2
);
5232 return make_number (color_distance (&cdef1
, &cdef2
));
5236 /***********************************************************************
5237 Face capability testing for ttys
5238 ***********************************************************************/
5241 /* If the distance (as returned by color_distance) between two colors is
5242 less than this, then they are considered the same, for determining
5243 whether a color is supported or not. The range of values is 0-65535. */
5245 #define TTY_SAME_COLOR_THRESHOLD 10000
5248 DEFUN ("tty-supports-face-attributes-p",
5249 Ftty_supports_face_attributes_p
, Stty_supports_face_attributes_p
,
5251 doc
: /* Return non-nil if all the face attributes in ATTRIBUTES are supported.
5252 The optional argument FRAME is the frame on which to test; if it is nil
5253 or unspecified, then the current frame is used. If FRAME is not a tty
5254 frame, then nil is returned.
5256 The definition of `supported' is somewhat heuristic, but basically means
5257 that a face containing all the attributes in ATTRIBUTES, when merged
5258 with the default face for display, can be represented in a way that's
5260 \(1) different in appearance than the default face, and
5261 \(2) `close in spirit' to what the attributes specify, if not exact.
5263 Point (2) implies that a `:weight black' attribute will be satisified
5264 by any terminal that can display bold, and a `:foreground "yellow"' as
5265 long as the terminal can display a yellowish color, but `:slant italic'
5266 will _not_ be satisified by the tty display code's automatic
5267 substitution of a `dim' face for italic. */)
5269 Lisp_Object attributes
, frame
;
5273 Lisp_Object val
, fg
, bg
;
5274 XColor fg_tty_color
, fg_std_color
;
5275 XColor bg_tty_color
, bg_std_color
;
5276 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5277 unsigned test_caps
= 0;
5280 frame
= selected_frame
;
5281 CHECK_LIVE_FRAME (frame
);
5284 for (i
= 0; i
< LFACE_VECTOR_SIZE
; i
++)
5285 attrs
[i
] = Qunspecified
;
5286 merge_face_vector_with_property (f
, attrs
, attributes
);
5288 /* This function only works on ttys. */
5289 if (!FRAME_TERMCAP_P (f
) && !FRAME_MSDOS_P (f
))
5292 /* First check some easy-to-check stuff; ttys support none of the
5293 following attributes, so we can just return nil if any are requested. */
5296 val
= attrs
[LFACE_STIPPLE_INDEX
];
5297 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5301 val
= attrs
[LFACE_HEIGHT_INDEX
];
5302 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5306 val
= attrs
[LFACE_SWIDTH_INDEX
];
5307 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5308 && face_numeric_swidth (val
) != XLFD_SWIDTH_MEDIUM
)
5312 val
= attrs
[LFACE_OVERLINE_INDEX
];
5313 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5316 /* strike-through */
5317 val
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
5318 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5322 val
= attrs
[LFACE_BOX_INDEX
];
5323 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5326 /* slant (italics/oblique); We consider any non-default value
5327 unsupportable on ttys, even though the face code actually `fakes'
5328 them using a dim attribute if possible. This is because the faked
5329 result is too different from what the face specifies. */
5330 val
= attrs
[LFACE_SLANT_INDEX
];
5331 if (!UNSPECIFIEDP (val
) && !NILP (val
)
5332 && face_numeric_slant (val
) != XLFD_SLANT_ROMAN
)
5336 /* Test for terminal `capabilities' (non-color character attributes). */
5338 /* font weight (bold/dim) */
5339 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5342 if (weight
> XLFD_WEIGHT_MEDIUM
)
5343 test_caps
= TTY_CAP_BOLD
;
5344 else if (weight
< XLFD_WEIGHT_MEDIUM
)
5345 test_caps
= TTY_CAP_DIM
;
5349 val
= attrs
[LFACE_UNDERLINE_INDEX
];
5350 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5353 return Qnil
; /* ttys don't support colored underlines */
5355 test_caps
|= TTY_CAP_UNDERLINE
;
5359 val
= attrs
[LFACE_INVERSE_INDEX
];
5360 if (!UNSPECIFIEDP (val
) && !NILP (val
))
5361 test_caps
|= TTY_CAP_INVERSE
;
5364 /* Color testing. */
5366 /* Default the color indices in FG_TTY_COLOR and BG_TTY_COLOR, since
5367 we use them when calling `tty_capable_p' below, even if the face
5368 specifies no colors. */
5369 fg_tty_color
.pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
5370 bg_tty_color
.pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
5372 /* Check if foreground color is close enough. */
5373 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
5376 if (! tty_lookup_color (f
, fg
, &fg_tty_color
, &fg_std_color
))
5378 else if (color_distance (&fg_tty_color
, &fg_std_color
)
5379 > TTY_SAME_COLOR_THRESHOLD
)
5383 /* Check if background color is close enough. */
5384 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
5387 if (! tty_lookup_color (f
, bg
, &bg_tty_color
, &bg_std_color
))
5389 else if (color_distance (&bg_tty_color
, &bg_std_color
)
5390 > TTY_SAME_COLOR_THRESHOLD
)
5394 /* If both foreground and background are requested, see if the
5395 distance between them is OK. We just check to see if the distance
5396 between the tty's foreground and background is close enough to the
5397 distance between the standard foreground and background. */
5398 if (STRINGP (fg
) && STRINGP (bg
))
5401 = (color_distance (&fg_std_color
, &bg_std_color
)
5402 - color_distance (&fg_tty_color
, &bg_tty_color
));
5403 if (delta_delta
> TTY_SAME_COLOR_THRESHOLD
5404 || delta_delta
< -TTY_SAME_COLOR_THRESHOLD
)
5409 /* See if the capabilities we selected above are supported, with the
5411 if (test_caps
!= 0 &&
5412 ! tty_capable_p (FRAME_TTY (f
), test_caps
, fg_tty_color
.pixel
, bg_tty_color
.pixel
))
5416 /* Hmmm, everything checks out, this terminal must support this face. */
5422 /***********************************************************************
5424 ***********************************************************************/
5426 /* Return a new face cache for frame F. */
5428 static struct face_cache
*
5432 struct face_cache
*c
;
5435 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5436 bzero (c
, sizeof *c
);
5437 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5438 c
->buckets
= (struct face
**) xmalloc (size
);
5439 bzero (c
->buckets
, size
);
5441 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5443 c
->menu_face_changed_p
= menu_face_changed_default
;
5448 /* Clear out all graphics contexts for all realized faces, except for
5449 the basic faces. This should be done from time to time just to avoid
5450 keeping too many graphics contexts that are no longer needed. */
5454 struct face_cache
*c
;
5456 if (c
&& FRAME_WINDOW_P (c
->f
))
5458 #ifdef HAVE_WINDOW_SYSTEM
5460 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5462 struct face
*face
= c
->faces_by_id
[i
];
5463 if (face
&& face
->gc
)
5465 x_free_gc (c
->f
, face
->gc
);
5469 #endif /* HAVE_WINDOW_SYSTEM */
5474 /* Free all realized faces in face cache C, including basic faces. C
5475 may be null. If faces are freed, make sure the frame's current
5476 matrix is marked invalid, so that a display caused by an expose
5477 event doesn't try to use faces we destroyed. */
5480 free_realized_faces (c
)
5481 struct face_cache
*c
;
5486 struct frame
*f
= c
->f
;
5488 /* We must block input here because we can't process X events
5489 safely while only some faces are freed, or when the frame's
5490 current matrix still references freed faces. */
5493 for (i
= 0; i
< c
->used
; ++i
)
5495 free_realized_face (f
, c
->faces_by_id
[i
]);
5496 c
->faces_by_id
[i
] = NULL
;
5500 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5501 bzero (c
->buckets
, size
);
5503 /* Must do a thorough redisplay the next time. Mark current
5504 matrices as invalid because they will reference faces freed
5505 above. This function is also called when a frame is
5506 destroyed. In this case, the root window of F is nil. */
5507 if (WINDOWP (f
->root_window
))
5509 clear_current_matrices (f
);
5510 ++windows_or_buffers_changed
;
5518 /* Free all faces realized for multibyte characters on frame F that
5522 free_realized_multibyte_face (f
, fontset
)
5526 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5530 /* We must block input here because we can't process X events safely
5531 while only some faces are freed, or when the frame's current
5532 matrix still references freed faces. */
5535 for (i
= 0; i
< cache
->used
; i
++)
5537 face
= cache
->faces_by_id
[i
];
5539 && face
!= face
->ascii_face
5540 && face
->fontset
== fontset
)
5542 uncache_face (cache
, face
);
5543 free_realized_face (f
, face
);
5547 /* Must do a thorough redisplay the next time. Mark current
5548 matrices as invalid because they will reference faces freed
5549 above. This function is also called when a frame is destroyed.
5550 In this case, the root window of F is nil. */
5551 if (WINDOWP (f
->root_window
))
5553 clear_current_matrices (f
);
5554 ++windows_or_buffers_changed
;
5561 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5562 This is done after attributes of a named face have been changed,
5563 because we can't tell which realized faces depend on that face. */
5566 free_all_realized_faces (frame
)
5572 FOR_EACH_FRAME (rest
, frame
)
5573 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5576 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5580 /* Free face cache C and faces in it, including their X resources. */
5584 struct face_cache
*c
;
5588 free_realized_faces (c
);
5590 xfree (c
->faces_by_id
);
5596 /* Cache realized face FACE in face cache C. HASH is the hash value
5597 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5598 collision list of the face hash table of C. This is done because
5599 otherwise lookup_face would find FACE for every character, even if
5600 faces with the same attributes but for specific characters exist. */
5603 cache_face (c
, face
, hash
)
5604 struct face_cache
*c
;
5608 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5612 if (face
->fontset
>= 0)
5614 struct face
*last
= c
->buckets
[i
];
5625 c
->buckets
[i
] = face
;
5626 face
->prev
= face
->next
= NULL
;
5632 face
->next
= c
->buckets
[i
];
5634 face
->next
->prev
= face
;
5635 c
->buckets
[i
] = face
;
5638 /* Find a free slot in C->faces_by_id and use the index of the free
5639 slot as FACE->id. */
5640 for (i
= 0; i
< c
->used
; ++i
)
5641 if (c
->faces_by_id
[i
] == NULL
)
5645 /* Maybe enlarge C->faces_by_id. */
5648 if (c
->used
== c
->size
)
5651 new_size
= min (2 * c
->size
, MAX_FACE_ID
);
5652 if (new_size
== c
->size
)
5653 abort (); /* Alternatives? ++kfs */
5654 sz
= new_size
* sizeof *c
->faces_by_id
;
5655 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5662 /* Check that FACE got a unique id. */
5667 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5668 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5674 #endif /* GLYPH_DEBUG */
5676 c
->faces_by_id
[i
] = face
;
5680 /* Remove face FACE from cache C. */
5683 uncache_face (c
, face
)
5684 struct face_cache
*c
;
5687 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5690 face
->prev
->next
= face
->next
;
5692 c
->buckets
[i
] = face
->next
;
5695 face
->next
->prev
= face
->prev
;
5697 c
->faces_by_id
[face
->id
] = NULL
;
5698 if (face
->id
== c
->used
)
5703 /* Look up a realized face with face attributes ATTR in the face cache
5704 of frame F. The face will be used to display character C. Value
5705 is the ID of the face found. If no suitable face is found, realize
5706 a new one. In that case, if C is a multibyte character, BASE_FACE
5707 is a face that has the same attributes. */
5710 lookup_face (f
, attr
, c
, base_face
)
5714 struct face
*base_face
;
5716 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5721 xassert (cache
!= NULL
);
5722 check_lface_attrs (attr
);
5724 /* Look up ATTR in the face cache. */
5725 hash
= lface_hash (attr
);
5726 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5728 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5729 if (face
->hash
== hash
5730 && (!FRAME_WINDOW_P (f
)
5731 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5732 && lface_equal_p (face
->lface
, attr
))
5735 /* If not found, realize a new face. */
5737 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5740 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5742 /* When this function is called from face_for_char (in this case, C is
5743 a multibyte character), a fontset of a face returned by
5744 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5745 C) is not sutisfied. The fontset is set for this face by
5746 face_for_char later. */
5748 if (FRAME_WINDOW_P (f
))
5749 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5751 #endif /* GLYPH_DEBUG */
5757 /* Return the face id of the realized face for named face SYMBOL on
5758 frame F suitable for displaying character C. Value is -1 if the
5759 face couldn't be determined, which might happen if the default face
5760 isn't realized and cannot be realized. */
5763 lookup_named_face (f
, symbol
, c
)
5768 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5769 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5770 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5772 if (default_face
== NULL
)
5774 if (!realize_basic_faces (f
))
5776 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5779 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5780 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5781 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5782 return lookup_face (f
, attrs
, c
, NULL
);
5786 /* Return the ID of the realized ASCII face of Lisp face with ID
5787 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5790 ascii_face_of_lisp_face (f
, lface_id
)
5796 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5798 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5799 face_id
= lookup_named_face (f
, face_name
, 0);
5808 /* Return a face for charset ASCII that is like the face with id
5809 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5810 STEPS < 0 means larger. Value is the id of the face. */
5813 smaller_face (f
, face_id
, steps
)
5817 #ifdef HAVE_WINDOW_SYSTEM
5819 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5820 int pt
, last_pt
, last_height
;
5823 struct face
*new_face
;
5825 /* If not called for an X frame, just return the original face. */
5826 if (FRAME_TERMCAP_P (f
))
5829 /* Try in increments of 1/2 pt. */
5830 delta
= steps
< 0 ? 5 : -5;
5831 steps
= abs (steps
);
5833 face
= FACE_FROM_ID (f
, face_id
);
5834 bcopy (face
->lface
, attrs
, sizeof attrs
);
5835 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5836 new_face_id
= face_id
;
5837 last_height
= FONT_HEIGHT (face
->font
);
5841 /* Give up if we cannot find a font within 10pt. */
5842 && abs (last_pt
- pt
) < 100)
5844 /* Look up a face for a slightly smaller/larger font. */
5846 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5847 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5848 new_face
= FACE_FROM_ID (f
, new_face_id
);
5850 /* If height changes, count that as one step. */
5851 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5852 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5855 last_height
= FONT_HEIGHT (new_face
->font
);
5862 #else /* not HAVE_WINDOW_SYSTEM */
5866 #endif /* not HAVE_WINDOW_SYSTEM */
5870 /* Return a face for charset ASCII that is like the face with id
5871 FACE_ID on frame F, but has height HEIGHT. */
5874 face_with_height (f
, face_id
, height
)
5879 #ifdef HAVE_WINDOW_SYSTEM
5881 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5883 if (FRAME_TERMCAP_P (f
)
5887 face
= FACE_FROM_ID (f
, face_id
);
5888 bcopy (face
->lface
, attrs
, sizeof attrs
);
5889 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5890 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5891 #endif /* HAVE_WINDOW_SYSTEM */
5897 /* Return the face id of the realized face for named face SYMBOL on
5898 frame F suitable for displaying character C, and use attributes of
5899 the face FACE_ID for attributes that aren't completely specified by
5900 SYMBOL. This is like lookup_named_face, except that the default
5901 attributes come from FACE_ID, not from the default face. FACE_ID
5902 is assumed to be already realized. */
5905 lookup_derived_face (f
, symbol
, c
, face_id
)
5911 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5912 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5913 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5918 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5919 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5920 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5921 return lookup_face (f
, attrs
, c
, default_face
);
5924 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5925 Sface_attributes_as_vector
, 1, 1, 0,
5926 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5931 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5933 merge_face_vector_with_property (XFRAME (selected_frame
),
5934 XVECTOR (lface
)->contents
,
5941 /***********************************************************************
5943 ***********************************************************************/
5945 DEFUN ("internal-set-font-selection-order",
5946 Finternal_set_font_selection_order
,
5947 Sinternal_set_font_selection_order
, 1, 1, 0,
5948 doc
: /* Set font selection order for face font selection to ORDER.
5949 ORDER must be a list of length 4 containing the symbols `:width',
5950 `:height', `:weight', and `:slant'. Face attributes appearing
5951 first in ORDER are matched first, e.g. if `:height' appears before
5952 `:weight' in ORDER, font selection first tries to find a font with
5953 a suitable height, and then tries to match the font weight.
5960 int indices
[DIM (font_sort_order
)];
5963 bzero (indices
, sizeof indices
);
5967 CONSP (list
) && i
< DIM (indices
);
5968 list
= XCDR (list
), ++i
)
5970 Lisp_Object attr
= XCAR (list
);
5973 if (EQ (attr
, QCwidth
))
5975 else if (EQ (attr
, QCheight
))
5976 xlfd
= XLFD_POINT_SIZE
;
5977 else if (EQ (attr
, QCweight
))
5979 else if (EQ (attr
, QCslant
))
5984 if (indices
[i
] != 0)
5989 if (!NILP (list
) || i
!= DIM (indices
))
5990 signal_error ("Invalid font sort order", order
);
5991 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5992 if (indices
[i
] == 0)
5993 signal_error ("Invalid font sort order", order
);
5995 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5997 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5998 free_all_realized_faces (Qnil
);
6005 DEFUN ("internal-set-alternative-font-family-alist",
6006 Finternal_set_alternative_font_family_alist
,
6007 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
6008 doc
: /* Define alternative font families to try in face font selection.
6009 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6010 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
6011 be found. Value is ALIST. */)
6016 Vface_alternative_font_family_alist
= alist
;
6017 free_all_realized_faces (Qnil
);
6022 DEFUN ("internal-set-alternative-font-registry-alist",
6023 Finternal_set_alternative_font_registry_alist
,
6024 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
6025 doc
: /* Define alternative font registries to try in face font selection.
6026 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
6027 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
6028 be found. Value is ALIST. */)
6033 Vface_alternative_font_registry_alist
= alist
;
6034 free_all_realized_faces (Qnil
);
6039 #ifdef HAVE_WINDOW_SYSTEM
6041 /* Value is non-zero if FONT is the name of a scalable font. The
6042 X11R6 XLFD spec says that point size, pixel size, and average width
6043 are zero for scalable fonts. Intlfonts contain at least one
6044 scalable font ("*-muleindian-1") for which this isn't true, so we
6045 just test average width. */
6048 font_scalable_p (font
)
6049 struct font_name
*font
;
6051 char *s
= font
->fields
[XLFD_AVGWIDTH
];
6052 return (*s
== '0' && *(s
+ 1) == '\0')
6054 /* Windows implementation of XLFD is slightly broken for backward
6055 compatibility with previous broken versions, so test for
6056 wildcards as well as 0. */
6063 /* Ignore the difference of font point size less than this value. */
6065 #define FONT_POINT_SIZE_QUANTUM 5
6067 /* Value is non-zero if FONT1 is a better match for font attributes
6068 VALUES than FONT2. VALUES is an array of face attribute values in
6069 font sort order. COMPARE_PT_P zero means don't compare point
6070 sizes. AVGWIDTH, if not zero, is a specified font average width
6074 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
6076 struct font_name
*font1
, *font2
;
6077 int compare_pt_p
, avgwidth
;
6081 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6083 int xlfd_idx
= font_sort_order
[i
];
6085 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
6089 if (xlfd_idx
== XLFD_POINT_SIZE
)
6091 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
6092 / font1
->rescale_ratio
));
6093 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
6094 / font2
->rescale_ratio
));
6095 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
6100 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
6101 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
6104 if (delta1
> delta2
)
6106 else if (delta1
< delta2
)
6110 /* The difference may be equal because, e.g., the face
6111 specifies `italic' but we have only `regular' and
6112 `oblique'. Prefer `oblique' in this case. */
6113 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
6114 && font1
->numeric
[xlfd_idx
] > values
[i
]
6115 && font2
->numeric
[xlfd_idx
] < values
[i
])
6123 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
6124 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
6125 if (delta1
> delta2
)
6127 else if (delta1
< delta2
)
6133 /* We prefer a real scalable font; i.e. not what autoscaled. */
6134 int auto_scaled_1
= (font1
->numeric
[XLFD_POINT_SIZE
] == 0
6135 && font1
->numeric
[XLFD_RESY
] > 0);
6136 int auto_scaled_2
= (font2
->numeric
[XLFD_POINT_SIZE
] == 0
6137 && font2
->numeric
[XLFD_RESY
] > 0);
6139 if (auto_scaled_1
!= auto_scaled_2
)
6140 return auto_scaled_2
;
6143 return font1
->registry_priority
< font2
->registry_priority
;
6147 /* Value is non-zero if FONT is an exact match for face attributes in
6148 SPECIFIED. SPECIFIED is an array of face attribute values in font
6149 sort order. AVGWIDTH, if non-zero, is an average width to compare
6153 exact_face_match_p (specified
, font
, avgwidth
)
6155 struct font_name
*font
;
6160 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6161 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
6164 return (i
== DIM (font_sort_order
)
6166 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
6170 /* Value is the name of a scaled font, generated from scalable font
6171 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
6172 Value is allocated from heap. */
6175 build_scalable_font_name (f
, font
, specified_pt
)
6177 struct font_name
*font
;
6180 char pixel_size
[20];
6182 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
6185 /* If scalable font is for a specific resolution, compute
6186 the point size we must specify from the resolution of
6187 the display and the specified resolution of the font. */
6188 if (font
->numeric
[XLFD_RESY
] != 0)
6190 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
6191 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
6196 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
6198 /* We may need a font of the different size. */
6199 pixel_value
*= font
->rescale_ratio
;
6201 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
6202 font of the specified PIXEL_SIZE. */
6204 { /* Set point size of the font. */
6205 char point_size
[20];
6206 sprintf (point_size
, "%d", (int) pt
);
6207 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
6208 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
6212 /* Set pixel size. */
6213 sprintf (pixel_size
, "%d", pixel_value
);
6214 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
6215 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
6217 /* If font doesn't specify its resolution, use the
6218 resolution of the display. */
6219 if (font
->numeric
[XLFD_RESY
] == 0)
6222 sprintf (buffer
, "%d", (int) resy
);
6223 font
->fields
[XLFD_RESY
] = buffer
;
6224 font
->numeric
[XLFD_RESY
] = resy
;
6227 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
6230 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
6231 sprintf (buffer
, "%d", resx
);
6232 font
->fields
[XLFD_RESX
] = buffer
;
6233 font
->numeric
[XLFD_RESX
] = resx
;
6236 return build_font_name (font
);
6240 /* Value is non-zero if we are allowed to use scalable font FONT. We
6241 can't run a Lisp function here since this function may be called
6242 with input blocked. */
6245 may_use_scalable_font_p (font
)
6248 if (EQ (Vscalable_fonts_allowed
, Qt
))
6250 else if (CONSP (Vscalable_fonts_allowed
))
6252 Lisp_Object tail
, regexp
;
6254 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6256 regexp
= XCAR (tail
);
6257 if (STRINGP (regexp
)
6258 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6268 /* Return the name of the best matching font for face attributes ATTRS
6269 in the array of font_name structures FONTS which contains NFONTS
6270 elements. WIDTH_RATIO is a factor with which to multiply average
6271 widths if ATTRS specifies such a width.
6273 Value is a font name which is allocated from the heap. FONTS is
6274 freed by this function.
6276 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6277 indicate whether the resulting font should be drawn using overstrike
6278 to simulate bold-face. */
6281 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
, needs_overstrike
)
6284 struct font_name
*fonts
;
6287 int *needs_overstrike
;
6290 struct font_name
*best
;
6293 int exact_p
, avgwidth
;
6298 /* Make specified font attributes available in `specified',
6299 indexed by sort order. */
6300 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6302 int xlfd_idx
= font_sort_order
[i
];
6304 if (xlfd_idx
== XLFD_SWIDTH
)
6305 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6306 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6307 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6308 else if (xlfd_idx
== XLFD_WEIGHT
)
6309 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6310 else if (xlfd_idx
== XLFD_SLANT
)
6311 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6316 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6318 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6322 if (needs_overstrike
)
6323 *needs_overstrike
= 0;
6325 /* Start with the first non-scalable font in the list. */
6326 for (i
= 0; i
< nfonts
; ++i
)
6327 if (!font_scalable_p (fonts
+ i
))
6330 /* Find the best match among the non-scalable fonts. */
6335 for (i
= 1; i
< nfonts
; ++i
)
6336 if (!font_scalable_p (fonts
+ i
)
6337 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6341 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6349 /* Unless we found an exact match among non-scalable fonts, see if
6350 we can find a better match among scalable fonts. */
6353 /* A scalable font is better if
6355 1. its weight, slant, swidth attributes are better, or.
6357 2. the best non-scalable font doesn't have the required
6358 point size, and the scalable fonts weight, slant, swidth
6361 int non_scalable_has_exact_height_p
;
6363 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6364 non_scalable_has_exact_height_p
= 1;
6366 non_scalable_has_exact_height_p
= 0;
6368 for (i
= 0; i
< nfonts
; ++i
)
6369 if (font_scalable_p (fonts
+ i
))
6372 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6373 || (!non_scalable_has_exact_height_p
6374 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6376 non_scalable_has_exact_height_p
= 1;
6381 if (needs_overstrike
)
6383 enum xlfd_weight want_weight
= specified
[XLFD_WEIGHT
];
6384 enum xlfd_weight got_weight
= best
->numeric
[XLFD_WEIGHT
];
6386 if (want_weight
> XLFD_WEIGHT_MEDIUM
&& want_weight
> got_weight
)
6388 /* We want a bold font, but didn't get one; try to use
6389 overstriking instead to simulate bold-face. However,
6390 don't overstrike an already-bold fontn unless the
6391 desired weight grossly exceeds the available weight. */
6392 if (got_weight
> XLFD_WEIGHT_MEDIUM
)
6393 *needs_overstrike
= (got_weight
- want_weight
) > 2;
6395 *needs_overstrike
= 1;
6400 if (font_scalable_p (best
))
6401 font_name
= build_scalable_font_name (f
, best
, pt
);
6403 font_name
= build_font_name (best
);
6405 /* Free font_name structures. */
6406 free_font_names (fonts
, nfonts
);
6412 /* Get a list of matching fonts on frame F, considering FAMILY
6413 and alternative font families from Vface_alternative_font_registry_alist.
6415 FAMILY is the font family whose alternatives are considered.
6417 REGISTRY, if a string, specifies a font registry and encoding to
6418 match. A value of nil means include fonts of any registry and
6421 Return in *FONTS a pointer to a vector of font_name structures for
6422 the fonts matched. Value is the number of fonts found. */
6425 try_alternative_families (f
, family
, registry
, fonts
)
6427 Lisp_Object family
, registry
;
6428 struct font_name
**fonts
;
6433 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6436 /* Try alternative font families. */
6437 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6440 for (alter
= XCDR (alter
);
6441 CONSP (alter
) && nfonts
== 0;
6442 alter
= XCDR (alter
))
6444 if (STRINGP (XCAR (alter
)))
6445 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6449 /* Try all scalable fonts before giving up. */
6450 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6452 int count
= SPECPDL_INDEX ();
6453 specbind (Qscalable_fonts_allowed
, Qt
);
6454 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6455 unbind_to (count
, Qnil
);
6462 /* Get a list of matching fonts on frame F.
6464 FAMILY, if a string, specifies a font family derived from the fontset.
6465 It is only used if the face does not specify any family in ATTRS or
6466 if we cannot find any font of the face's family.
6468 REGISTRY, if a string, specifies a font registry and encoding to
6469 match. A value of nil means include fonts of any registry and
6472 If PREFER_FACE_FAMILY is nonzero, perfer face's family to FAMILY.
6473 Otherwise, prefer FAMILY.
6475 Return in *FONTS a pointer to a vector of font_name structures for
6476 the fonts matched. Value is the number of fonts found. */
6479 try_font_list (f
, attrs
, family
, registry
, fonts
, prefer_face_family
)
6482 Lisp_Object family
, registry
;
6483 struct font_name
**fonts
;
6484 int prefer_face_family
;
6487 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6488 Lisp_Object try_family
;
6490 try_family
= (prefer_face_family
|| NILP (family
)) ? face_family
: family
;
6492 if (STRINGP (try_family
))
6493 nfonts
= try_alternative_families (f
, try_family
, registry
, fonts
);
6496 /* When realizing the default face and a font spec does not matched
6497 exactly, Emacs looks for ones with the same registry as the
6498 default font. On the Mac, this is mac-roman, which does not work
6499 if the family is -etl-fixed, e.g. The following widens the
6500 choices and fixes that problem. */
6501 if (nfonts
== 0 && STRINGP (try_family
) && STRINGP (registry
)
6502 && xstricmp (SDATA (registry
), "mac-roman") == 0)
6503 nfonts
= try_alternative_families (f
, try_family
, Qnil
, fonts
);
6506 if (EQ (try_family
, family
))
6507 family
= face_family
;
6509 if (nfonts
== 0 && STRINGP (family
))
6510 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6512 /* Try font family of the default face or "fixed". */
6515 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6517 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6519 family
= build_string ("fixed");
6520 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6523 /* Try any family with the given registry. */
6525 nfonts
= try_alternative_families (f
, Qnil
, registry
, fonts
);
6531 /* Return the fontset id of the base fontset name or alias name given
6532 by the fontset attribute of ATTRS. Value is -1 if the fontset
6533 attribute of ATTRS doesn't name a fontset. */
6536 face_fontset (attrs
)
6541 name
= attrs
[LFACE_FONT_INDEX
];
6542 if (!STRINGP (name
))
6544 return fs_query_fontset (name
, 0);
6548 /* Choose a name of font to use on frame F to display character C with
6549 Lisp face attributes specified by ATTRS. The font name is
6550 determined by the font-related attributes in ATTRS and the name
6551 pattern for C in FONTSET. Value is the font name which is
6552 allocated from the heap and must be freed by the caller, or NULL if
6553 we can get no information about the font name of C. It is assured
6554 that we always get some information for a single byte
6557 If NEEDS_OVERSTRIKE is non-zero, a boolean is returned in it to
6558 indicate whether the resulting font should be drawn using overstrike
6559 to simulate bold-face. */
6562 choose_face_font (f
, attrs
, fontset
, c
, needs_overstrike
)
6566 int *needs_overstrike
;
6568 Lisp_Object pattern
;
6569 char *font_name
= NULL
;
6570 struct font_name
*fonts
;
6571 int nfonts
, width_ratio
;
6573 if (needs_overstrike
)
6574 *needs_overstrike
= 0;
6576 /* Get (foundry and) family name and registry (and encoding) name of
6578 pattern
= fontset_font_pattern (f
, fontset
, c
);
6581 xassert (!SINGLE_BYTE_CHAR_P (c
));
6585 /* If what we got is a name pattern, return it. */
6586 if (STRINGP (pattern
))
6587 return xstrdup (SDATA (pattern
));
6589 /* Get a list of fonts matching that pattern and choose the
6590 best match for the specified face attributes from it. */
6591 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
,
6592 (SINGLE_BYTE_CHAR_P (c
)
6593 || CHAR_CHARSET (c
) == charset_latin_iso8859_1
));
6594 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6596 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6597 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
,
6602 #endif /* HAVE_WINDOW_SYSTEM */
6606 /***********************************************************************
6608 ***********************************************************************/
6610 /* Realize basic faces on frame F. Value is zero if frame parameters
6611 of F don't contain enough information needed to realize the default
6615 realize_basic_faces (f
)
6619 int count
= SPECPDL_INDEX ();
6621 /* Block input here so that we won't be surprised by an X expose
6622 event, for instance, without having the faces set up. */
6624 specbind (Qscalable_fonts_allowed
, Qt
);
6626 if (realize_default_face (f
))
6628 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6629 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6630 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6631 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6632 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6633 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6634 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6635 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6636 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6637 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6639 /* Reflect changes in the `menu' face in menu bars. */
6640 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6642 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6643 #ifdef USE_X_TOOLKIT
6644 if (FRAME_WINDOW_P (f
))
6645 x_update_menu_appearance (f
);
6652 unbind_to (count
, Qnil
);
6658 /* Realize the default face on frame F. If the face is not fully
6659 specified, make it fully-specified. Attributes of the default face
6660 that are not explicitly specified are taken from frame parameters. */
6663 realize_default_face (f
)
6666 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6668 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6669 Lisp_Object frame_font
;
6672 /* If the `default' face is not yet known, create it. */
6673 lface
= lface_from_face_name (f
, Qdefault
, 0);
6677 XSETFRAME (frame
, f
);
6678 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6682 #ifdef HAVE_WINDOW_SYSTEM
6683 if (FRAME_WINDOW_P (f
))
6685 /* Set frame_font to the value of the `font' frame parameter. */
6686 frame_font
= Fassq (Qfont
, f
->param_alist
);
6687 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6688 frame_font
= XCDR (frame_font
);
6689 set_lface_from_font_name (f
, lface
, frame_font
,
6690 f
->default_face_done_p
, 1);
6691 f
->default_face_done_p
= 1;
6693 #endif /* HAVE_WINDOW_SYSTEM */
6695 if (!FRAME_WINDOW_P (f
))
6697 LFACE_FAMILY (lface
) = build_string ("default");
6698 LFACE_SWIDTH (lface
) = Qnormal
;
6699 LFACE_HEIGHT (lface
) = make_number (1);
6700 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6701 LFACE_WEIGHT (lface
) = Qnormal
;
6702 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6703 LFACE_SLANT (lface
) = Qnormal
;
6704 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6707 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6708 LFACE_UNDERLINE (lface
) = Qnil
;
6710 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6711 LFACE_OVERLINE (lface
) = Qnil
;
6713 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6714 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6716 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6717 LFACE_BOX (lface
) = Qnil
;
6719 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6720 LFACE_INVERSE (lface
) = Qnil
;
6722 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6724 /* This function is called so early that colors are not yet
6725 set in the frame parameter list. */
6726 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6728 if (CONSP (color
) && STRINGP (XCDR (color
)))
6729 LFACE_FOREGROUND (lface
) = XCDR (color
);
6730 else if (FRAME_WINDOW_P (f
))
6732 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6733 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6738 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6740 /* This function is called so early that colors are not yet
6741 set in the frame parameter list. */
6742 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6743 if (CONSP (color
) && STRINGP (XCDR (color
)))
6744 LFACE_BACKGROUND (lface
) = XCDR (color
);
6745 else if (FRAME_WINDOW_P (f
))
6747 else if (FRAME_INITIAL_P (f
) || FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6748 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6753 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6754 LFACE_STIPPLE (lface
) = Qnil
;
6756 /* Realize the face; it must be fully-specified now. */
6757 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6758 check_lface (lface
);
6759 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6760 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6765 /* Realize basic faces other than the default face in face cache C.
6766 SYMBOL is the face name, ID is the face id the realized face must
6767 have. The default face must have been realized already. */
6770 realize_named_face (f
, symbol
, id
)
6775 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6776 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6777 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6778 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6779 struct face
*new_face
;
6781 /* The default face must exist and be fully specified. */
6782 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6783 check_lface_attrs (attrs
);
6784 xassert (lface_fully_specified_p (attrs
));
6786 /* If SYMBOL isn't know as a face, create it. */
6790 XSETFRAME (frame
, f
);
6791 lface
= Finternal_make_lisp_face (symbol
, frame
);
6794 /* Merge SYMBOL's face with the default face. */
6795 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6796 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6798 /* Realize the face. */
6799 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6803 /* Realize the fully-specified face with attributes ATTRS in face
6804 cache CACHE for character C. If C is a multibyte character,
6805 BASE_FACE is a face that has the same attributes. Otherwise,
6806 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6807 ID of face to remove before caching the new face. Value is a
6808 pointer to the newly created realized face. */
6810 static struct face
*
6811 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6812 struct face_cache
*cache
;
6815 struct face
*base_face
;
6820 /* LFACE must be fully specified. */
6821 xassert (cache
!= NULL
);
6822 check_lface_attrs (attrs
);
6824 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6826 /* Remove the former face. */
6827 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6828 uncache_face (cache
, former_face
);
6829 free_realized_face (cache
->f
, former_face
);
6832 if (FRAME_WINDOW_P (cache
->f
))
6833 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6834 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6835 face
= realize_tty_face (cache
, attrs
, c
);
6836 else if (FRAME_INITIAL_P (cache
->f
))
6838 /* Create a dummy face. */
6839 face
= make_realized_face (attrs
);
6844 /* Insert the new face. */
6845 cache_face (cache
, face
, lface_hash (attrs
));
6846 #ifdef HAVE_WINDOW_SYSTEM
6847 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6848 load_face_font (cache
->f
, face
, c
);
6849 #endif /* HAVE_WINDOW_SYSTEM */
6854 /* Realize the fully-specified face with attributes ATTRS in face
6855 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6856 a multibyte character, BASE_FACE is a face that has the same
6857 attributes. Otherwise, BASE_FACE is ignored. If the new face
6858 doesn't share font with the default face, a fontname is allocated
6859 from the heap and set in `font_name' of the new face, but it is not
6860 yet loaded here. Value is a pointer to the newly created realized
6863 static struct face
*
6864 realize_x_face (cache
, attrs
, c
, base_face
)
6865 struct face_cache
*cache
;
6868 struct face
*base_face
;
6870 #ifdef HAVE_WINDOW_SYSTEM
6871 struct face
*face
, *default_face
;
6873 Lisp_Object stipple
, overline
, strike_through
, box
;
6875 xassert (FRAME_WINDOW_P (cache
->f
));
6876 xassert (SINGLE_BYTE_CHAR_P (c
)
6879 /* Allocate a new realized face. */
6880 face
= make_realized_face (attrs
);
6884 /* If C is a multibyte character, we share all face attirbutes with
6885 BASE_FACE including the realized fontset. But, we must load a
6887 if (!SINGLE_BYTE_CHAR_P (c
))
6889 bcopy (base_face
, face
, sizeof *face
);
6892 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6893 face
->colors_copied_bitwise_p
= 1;
6895 /* to force realize_face to load font */
6900 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6902 /* Determine the font to use. Most of the time, the font will be
6903 the same as the font of the default face, so try that first. */
6904 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6906 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6907 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6909 face
->font
= default_face
->font
;
6910 face
->fontset
= default_face
->fontset
;
6911 face
->font_info_id
= default_face
->font_info_id
;
6912 face
->font_name
= default_face
->font_name
;
6913 face
->ascii_face
= face
;
6915 /* But, as we can't share the fontset, make a new realized
6916 fontset that has the same base fontset as of the default
6919 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6923 /* If the face attribute ATTRS specifies a fontset, use it as
6924 the base of a new realized fontset. Otherwise, use the same
6925 base fontset as of the default face. The base determines
6926 registry and encoding of a font. It may also determine
6927 foundry and family. The other fields of font name pattern
6928 are constructed from ATTRS. */
6929 int fontset
= face_fontset (attrs
);
6931 if ((fontset
== -1) && default_face
)
6932 fontset
= default_face
->fontset
;
6933 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6934 face
->font
= NULL
; /* to force realize_face to load font */
6937 /* Load colors, and set remaining attributes. */
6939 load_face_colors (f
, face
, attrs
);
6942 box
= attrs
[LFACE_BOX_INDEX
];
6945 /* A simple box of line width 1 drawn in color given by
6947 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6949 face
->box
= FACE_SIMPLE_BOX
;
6950 face
->box_line_width
= 1;
6952 else if (INTEGERP (box
))
6954 /* Simple box of specified line width in foreground color of the
6956 xassert (XINT (box
) != 0);
6957 face
->box
= FACE_SIMPLE_BOX
;
6958 face
->box_line_width
= XINT (box
);
6959 face
->box_color
= face
->foreground
;
6960 face
->box_color_defaulted_p
= 1;
6962 else if (CONSP (box
))
6964 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6965 being one of `raised' or `sunken'. */
6966 face
->box
= FACE_SIMPLE_BOX
;
6967 face
->box_color
= face
->foreground
;
6968 face
->box_color_defaulted_p
= 1;
6969 face
->box_line_width
= 1;
6973 Lisp_Object keyword
, value
;
6975 keyword
= XCAR (box
);
6983 if (EQ (keyword
, QCline_width
))
6985 if (INTEGERP (value
) && XINT (value
) != 0)
6986 face
->box_line_width
= XINT (value
);
6988 else if (EQ (keyword
, QCcolor
))
6990 if (STRINGP (value
))
6992 face
->box_color
= load_color (f
, face
, value
,
6994 face
->use_box_color_for_shadows_p
= 1;
6997 else if (EQ (keyword
, QCstyle
))
6999 if (EQ (value
, Qreleased_button
))
7000 face
->box
= FACE_RAISED_BOX
;
7001 else if (EQ (value
, Qpressed_button
))
7002 face
->box
= FACE_SUNKEN_BOX
;
7007 /* Text underline, overline, strike-through. */
7009 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
7011 /* Use default color (same as foreground color). */
7012 face
->underline_p
= 1;
7013 face
->underline_defaulted_p
= 1;
7014 face
->underline_color
= 0;
7016 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
7018 /* Use specified color. */
7019 face
->underline_p
= 1;
7020 face
->underline_defaulted_p
= 0;
7021 face
->underline_color
7022 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
7023 LFACE_UNDERLINE_INDEX
);
7025 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7027 face
->underline_p
= 0;
7028 face
->underline_defaulted_p
= 0;
7029 face
->underline_color
= 0;
7032 overline
= attrs
[LFACE_OVERLINE_INDEX
];
7033 if (STRINGP (overline
))
7035 face
->overline_color
7036 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
7037 LFACE_OVERLINE_INDEX
);
7038 face
->overline_p
= 1;
7040 else if (EQ (overline
, Qt
))
7042 face
->overline_color
= face
->foreground
;
7043 face
->overline_color_defaulted_p
= 1;
7044 face
->overline_p
= 1;
7047 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
7048 if (STRINGP (strike_through
))
7050 face
->strike_through_color
7051 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
7052 LFACE_STRIKE_THROUGH_INDEX
);
7053 face
->strike_through_p
= 1;
7055 else if (EQ (strike_through
, Qt
))
7057 face
->strike_through_color
= face
->foreground
;
7058 face
->strike_through_color_defaulted_p
= 1;
7059 face
->strike_through_p
= 1;
7062 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
7063 if (!NILP (stipple
))
7064 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
7066 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
7068 #endif /* HAVE_WINDOW_SYSTEM */
7072 /* Map a specified color of face FACE on frame F to a tty color index.
7073 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
7074 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
7075 default foreground/background colors. */
7078 map_tty_color (f
, face
, idx
, defaulted
)
7081 enum lface_attribute_index idx
;
7084 Lisp_Object frame
, color
, def
;
7085 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
7086 unsigned long default_pixel
, default_other_pixel
, pixel
;
7088 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
7092 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7093 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7097 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
7098 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
7101 XSETFRAME (frame
, f
);
7102 color
= face
->lface
[idx
];
7106 && CONSP (Vtty_defined_color_alist
)
7107 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
7110 /* Associations in tty-defined-color-alist are of the form
7111 (NAME INDEX R G B). We need the INDEX part. */
7112 pixel
= XINT (XCAR (XCDR (def
)));
7115 if (pixel
== default_pixel
&& STRINGP (color
))
7117 pixel
= load_color (f
, face
, color
, idx
);
7119 #if defined (MSDOS) || defined (WINDOWSNT)
7120 /* If the foreground of the default face is the default color,
7121 use the foreground color defined by the frame. */
7123 if (FRAME_MSDOS_P (f
))
7126 if (pixel
== default_pixel
7127 || pixel
== FACE_TTY_DEFAULT_COLOR
)
7130 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7132 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7133 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7136 else if (pixel
== default_other_pixel
)
7139 pixel
= FRAME_BACKGROUND_PIXEL (f
);
7141 pixel
= FRAME_FOREGROUND_PIXEL (f
);
7142 face
->lface
[idx
] = tty_color_name (f
, pixel
);
7148 #endif /* MSDOS or WINDOWSNT */
7152 face
->foreground
= pixel
;
7154 face
->background
= pixel
;
7158 /* Realize the fully-specified face with attributes ATTRS in face
7159 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
7160 pointer to the newly created realized face. */
7162 static struct face
*
7163 realize_tty_face (cache
, attrs
, c
)
7164 struct face_cache
*cache
;
7170 int face_colors_defaulted
= 0;
7171 struct frame
*f
= cache
->f
;
7173 /* Frame must be a termcap frame. */
7174 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
7176 /* Allocate a new realized face. */
7177 face
= make_realized_face (attrs
);
7178 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
7180 /* Map face attributes to TTY appearances. We map slant to
7181 dimmed text because we want italic text to appear differently
7182 and because dimmed text is probably used infrequently. */
7183 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
7184 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
7186 if (weight
> XLFD_WEIGHT_MEDIUM
)
7187 face
->tty_bold_p
= 1;
7188 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
7189 face
->tty_dim_p
= 1;
7190 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
7191 face
->tty_underline_p
= 1;
7192 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
7193 face
->tty_reverse_p
= 1;
7195 /* Map color names to color indices. */
7196 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
7197 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
7199 /* Swap colors if face is inverse-video. If the colors are taken
7200 from the frame colors, they are already inverted, since the
7201 frame-creation function calls x-handle-reverse-video. */
7202 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
7204 unsigned long tem
= face
->foreground
;
7205 face
->foreground
= face
->background
;
7206 face
->background
= tem
;
7209 if (tty_suppress_bold_inverse_default_colors_p
7211 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
7212 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
7213 face
->tty_bold_p
= 0;
7219 DEFUN ("tty-suppress-bold-inverse-default-colors",
7220 Ftty_suppress_bold_inverse_default_colors
,
7221 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
7222 doc
: /* Suppress/allow boldness of faces with inverse default colors.
7223 SUPPRESS non-nil means suppress it.
7224 This affects bold faces on TTYs whose foreground is the default background
7225 color of the display and whose background is the default foreground color.
7226 For such faces, the bold face attribute is ignored if this variable
7229 Lisp_Object suppress
;
7231 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
7232 ++face_change_count
;
7238 /***********************************************************************
7240 ***********************************************************************/
7242 /* Return the ID of the face to use to display character CH with face
7243 property PROP on frame F in current_buffer. */
7246 compute_char_face (f
, ch
, prop
)
7253 if (NILP (current_buffer
->enable_multibyte_characters
))
7258 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7259 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7263 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7264 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7265 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7266 merge_face_vector_with_property (f
, attrs
, prop
);
7267 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
7273 /* Return the face ID associated with buffer position POS for
7274 displaying ASCII characters. Return in *ENDPTR the position at
7275 which a different face is needed, as far as text properties and
7276 overlays are concerned. W is a window displaying current_buffer.
7278 REGION_BEG, REGION_END delimit the region, so it can be
7281 LIMIT is a position not to scan beyond. That is to limit the time
7282 this function can take.
7284 If MOUSE is non-zero, use the character's mouse-face, not its face.
7286 The face returned is suitable for displaying ASCII characters. */
7289 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7290 endptr
, limit
, mouse
)
7293 int region_beg
, region_end
;
7298 struct frame
*f
= XFRAME (w
->frame
);
7299 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7300 Lisp_Object prop
, position
;
7302 Lisp_Object
*overlay_vec
;
7305 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7306 Lisp_Object limit1
, end
;
7307 struct face
*default_face
;
7309 /* W must display the current buffer. We could write this function
7310 to use the frame and buffer of W, but right now it doesn't. */
7311 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7313 XSETFRAME (frame
, f
);
7314 XSETFASTINT (position
, pos
);
7317 if (pos
< region_beg
&& region_beg
< endpos
)
7318 endpos
= region_beg
;
7320 /* Get the `face' or `mouse_face' text property at POS, and
7321 determine the next position at which the property changes. */
7322 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7323 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7324 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7326 endpos
= XINT (end
);
7328 /* Look at properties from overlays. */
7333 /* First try with room for 40 overlays. */
7335 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7336 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7337 &next_overlay
, NULL
, 0);
7339 /* If there are more than 40, make enough space for all, and try
7341 if (noverlays
> len
)
7344 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7345 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7346 &next_overlay
, NULL
, 0);
7349 if (next_overlay
< endpos
)
7350 endpos
= next_overlay
;
7355 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7357 /* Optimize common cases where we can use the default face. */
7360 && !(pos
>= region_beg
&& pos
< region_end
))
7361 return DEFAULT_FACE_ID
;
7363 /* Begin with attributes from the default face. */
7364 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7366 /* Merge in attributes specified via text properties. */
7368 merge_face_vector_with_property (f
, attrs
, prop
);
7370 /* Now merge the overlay data. */
7371 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7372 for (i
= 0; i
< noverlays
; i
++)
7377 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7379 merge_face_vector_with_property (f
, attrs
, prop
);
7381 oend
= OVERLAY_END (overlay_vec
[i
]);
7382 oendpos
= OVERLAY_POSITION (oend
);
7383 if (oendpos
< endpos
)
7387 /* If in the region, merge in the region face. */
7388 if (pos
>= region_beg
&& pos
< region_end
)
7390 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7391 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7393 if (region_end
< endpos
)
7394 endpos
= region_end
;
7399 /* Look up a realized face with the given face attributes,
7400 or realize a new one for ASCII characters. */
7401 return lookup_face (f
, attrs
, 0, NULL
);
7405 /* Compute the face at character position POS in Lisp string STRING on
7406 window W, for ASCII characters.
7408 If STRING is an overlay string, it comes from position BUFPOS in
7409 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7410 not an overlay string. W must display the current buffer.
7411 REGION_BEG and REGION_END give the start and end positions of the
7412 region; both are -1 if no region is visible.
7414 BASE_FACE_ID is the id of a face to merge with. For strings coming
7415 from overlays or the `display' property it is the face at BUFPOS.
7417 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7419 Set *ENDPTR to the next position where to check for faces in
7420 STRING; -1 if the face is constant from POS to the end of the
7423 Value is the id of the face to use. The face returned is suitable
7424 for displaying ASCII characters. */
7427 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7428 region_end
, endptr
, base_face_id
, mouse_p
)
7432 int region_beg
, region_end
;
7434 enum face_id base_face_id
;
7437 Lisp_Object prop
, position
, end
, limit
;
7438 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7439 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7440 struct face
*base_face
;
7441 int multibyte_p
= STRING_MULTIBYTE (string
);
7442 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7444 /* Get the value of the face property at the current position within
7445 STRING. Value is nil if there is no face property. */
7446 XSETFASTINT (position
, pos
);
7447 prop
= Fget_text_property (position
, prop_name
, string
);
7449 /* Get the next position at which to check for faces. Value of end
7450 is nil if face is constant all the way to the end of the string.
7451 Otherwise it is a string position where to check faces next.
7452 Limit is the maximum position up to which to check for property
7453 changes in Fnext_single_property_change. Strings are usually
7454 short, so set the limit to the end of the string. */
7455 XSETFASTINT (limit
, SCHARS (string
));
7456 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7458 *endptr
= XFASTINT (end
);
7462 base_face
= FACE_FROM_ID (f
, base_face_id
);
7463 xassert (base_face
);
7465 /* Optimize the default case that there is no face property and we
7466 are not in the region. */
7468 && (base_face_id
!= DEFAULT_FACE_ID
7469 /* BUFPOS <= 0 means STRING is not an overlay string, so
7470 that the region doesn't have to be taken into account. */
7472 || bufpos
< region_beg
7473 || bufpos
>= region_end
)
7475 /* We can't realize faces for different charsets differently
7476 if we don't have fonts, so we can stop here if not working
7477 on a window-system frame. */
7478 || !FRAME_WINDOW_P (f
)
7479 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7480 return base_face
->id
;
7482 /* Begin with attributes from the base face. */
7483 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7485 /* Merge in attributes specified via text properties. */
7487 merge_face_vector_with_property (f
, attrs
, prop
);
7489 /* If in the region, merge in the region face. */
7491 && bufpos
>= region_beg
7492 && bufpos
< region_end
)
7494 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7495 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7498 /* Look up a realized face with the given face attributes,
7499 or realize a new one for ASCII characters. */
7500 return lookup_face (f
, attrs
, 0, NULL
);
7505 /***********************************************************************
7507 ***********************************************************************/
7511 /* Print the contents of the realized face FACE to stderr. */
7514 dump_realized_face (face
)
7517 fprintf (stderr
, "ID: %d\n", face
->id
);
7518 #ifdef HAVE_X_WINDOWS
7519 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7521 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7523 SDATA (face
->lface
[LFACE_FOREGROUND_INDEX
]));
7524 fprintf (stderr
, "background: 0x%lx (%s)\n",
7526 SDATA (face
->lface
[LFACE_BACKGROUND_INDEX
]));
7527 fprintf (stderr
, "font_name: %s (%s)\n",
7529 SDATA (face
->lface
[LFACE_FAMILY_INDEX
]));
7530 #ifdef HAVE_X_WINDOWS
7531 fprintf (stderr
, "font = %p\n", face
->font
);
7533 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7534 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7535 fprintf (stderr
, "underline: %d (%s)\n",
7537 SDATA (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
])));
7538 fprintf (stderr
, "hash: %d\n", face
->hash
);
7539 fprintf (stderr
, "charset: %d\n", face
->charset
);
7543 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7551 fprintf (stderr
, "font selection order: ");
7552 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7553 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7554 fprintf (stderr
, "\n");
7556 fprintf (stderr
, "alternative fonts: ");
7557 debug_print (Vface_alternative_font_family_alist
);
7558 fprintf (stderr
, "\n");
7560 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7561 Fdump_face (make_number (i
));
7567 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7569 error ("Not a valid face");
7570 dump_realized_face (face
);
7577 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7578 0, 0, 0, doc
: /* */)
7581 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7582 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7583 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7587 #endif /* GLYPH_DEBUG != 0 */
7591 /***********************************************************************
7593 ***********************************************************************/
7598 Qface
= intern ("face");
7600 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7601 staticpro (&Qbitmap_spec_p
);
7602 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7603 staticpro (&Qframe_update_face_colors
);
7605 /* Lisp face attribute keywords. */
7606 QCfamily
= intern (":family");
7607 staticpro (&QCfamily
);
7608 QCheight
= intern (":height");
7609 staticpro (&QCheight
);
7610 QCweight
= intern (":weight");
7611 staticpro (&QCweight
);
7612 QCslant
= intern (":slant");
7613 staticpro (&QCslant
);
7614 QCunderline
= intern (":underline");
7615 staticpro (&QCunderline
);
7616 QCinverse_video
= intern (":inverse-video");
7617 staticpro (&QCinverse_video
);
7618 QCreverse_video
= intern (":reverse-video");
7619 staticpro (&QCreverse_video
);
7620 QCforeground
= intern (":foreground");
7621 staticpro (&QCforeground
);
7622 QCbackground
= intern (":background");
7623 staticpro (&QCbackground
);
7624 QCstipple
= intern (":stipple");;
7625 staticpro (&QCstipple
);
7626 QCwidth
= intern (":width");
7627 staticpro (&QCwidth
);
7628 QCfont
= intern (":font");
7629 staticpro (&QCfont
);
7630 QCbold
= intern (":bold");
7631 staticpro (&QCbold
);
7632 QCitalic
= intern (":italic");
7633 staticpro (&QCitalic
);
7634 QCoverline
= intern (":overline");
7635 staticpro (&QCoverline
);
7636 QCstrike_through
= intern (":strike-through");
7637 staticpro (&QCstrike_through
);
7638 QCbox
= intern (":box");
7640 QCinherit
= intern (":inherit");
7641 staticpro (&QCinherit
);
7643 /* Symbols used for Lisp face attribute values. */
7644 QCcolor
= intern (":color");
7645 staticpro (&QCcolor
);
7646 QCline_width
= intern (":line-width");
7647 staticpro (&QCline_width
);
7648 QCstyle
= intern (":style");
7649 staticpro (&QCstyle
);
7650 Qreleased_button
= intern ("released-button");
7651 staticpro (&Qreleased_button
);
7652 Qpressed_button
= intern ("pressed-button");
7653 staticpro (&Qpressed_button
);
7654 Qnormal
= intern ("normal");
7655 staticpro (&Qnormal
);
7656 Qultra_light
= intern ("ultra-light");
7657 staticpro (&Qultra_light
);
7658 Qextra_light
= intern ("extra-light");
7659 staticpro (&Qextra_light
);
7660 Qlight
= intern ("light");
7661 staticpro (&Qlight
);
7662 Qsemi_light
= intern ("semi-light");
7663 staticpro (&Qsemi_light
);
7664 Qsemi_bold
= intern ("semi-bold");
7665 staticpro (&Qsemi_bold
);
7666 Qbold
= intern ("bold");
7668 Qextra_bold
= intern ("extra-bold");
7669 staticpro (&Qextra_bold
);
7670 Qultra_bold
= intern ("ultra-bold");
7671 staticpro (&Qultra_bold
);
7672 Qoblique
= intern ("oblique");
7673 staticpro (&Qoblique
);
7674 Qitalic
= intern ("italic");
7675 staticpro (&Qitalic
);
7676 Qreverse_oblique
= intern ("reverse-oblique");
7677 staticpro (&Qreverse_oblique
);
7678 Qreverse_italic
= intern ("reverse-italic");
7679 staticpro (&Qreverse_italic
);
7680 Qultra_condensed
= intern ("ultra-condensed");
7681 staticpro (&Qultra_condensed
);
7682 Qextra_condensed
= intern ("extra-condensed");
7683 staticpro (&Qextra_condensed
);
7684 Qcondensed
= intern ("condensed");
7685 staticpro (&Qcondensed
);
7686 Qsemi_condensed
= intern ("semi-condensed");
7687 staticpro (&Qsemi_condensed
);
7688 Qsemi_expanded
= intern ("semi-expanded");
7689 staticpro (&Qsemi_expanded
);
7690 Qexpanded
= intern ("expanded");
7691 staticpro (&Qexpanded
);
7692 Qextra_expanded
= intern ("extra-expanded");
7693 staticpro (&Qextra_expanded
);
7694 Qultra_expanded
= intern ("ultra-expanded");
7695 staticpro (&Qultra_expanded
);
7696 Qbackground_color
= intern ("background-color");
7697 staticpro (&Qbackground_color
);
7698 Qforeground_color
= intern ("foreground-color");
7699 staticpro (&Qforeground_color
);
7700 Qunspecified
= intern ("unspecified");
7701 staticpro (&Qunspecified
);
7703 Qface_alias
= intern ("face-alias");
7704 staticpro (&Qface_alias
);
7705 Qdefault
= intern ("default");
7706 staticpro (&Qdefault
);
7707 Qtool_bar
= intern ("tool-bar");
7708 staticpro (&Qtool_bar
);
7709 Qregion
= intern ("region");
7710 staticpro (&Qregion
);
7711 Qfringe
= intern ("fringe");
7712 staticpro (&Qfringe
);
7713 Qheader_line
= intern ("header-line");
7714 staticpro (&Qheader_line
);
7715 Qscroll_bar
= intern ("scroll-bar");
7716 staticpro (&Qscroll_bar
);
7717 Qmenu
= intern ("menu");
7719 Qcursor
= intern ("cursor");
7720 staticpro (&Qcursor
);
7721 Qborder
= intern ("border");
7722 staticpro (&Qborder
);
7723 Qmouse
= intern ("mouse");
7724 staticpro (&Qmouse
);
7725 Qmode_line_inactive
= intern ("mode-line-inactive");
7726 staticpro (&Qmode_line_inactive
);
7727 Qtty_color_desc
= intern ("tty-color-desc");
7728 staticpro (&Qtty_color_desc
);
7729 Qtty_color_standard_values
= intern ("tty-color-standard-values");
7730 staticpro (&Qtty_color_standard_values
);
7731 Qtty_color_by_index
= intern ("tty-color-by-index");
7732 staticpro (&Qtty_color_by_index
);
7733 Qtty_color_alist
= intern ("tty-color-alist");
7734 staticpro (&Qtty_color_alist
);
7735 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7736 staticpro (&Qscalable_fonts_allowed
);
7738 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7739 staticpro (&Vparam_value_alist
);
7740 Vface_alternative_font_family_alist
= Qnil
;
7741 staticpro (&Vface_alternative_font_family_alist
);
7742 Vface_alternative_font_registry_alist
= Qnil
;
7743 staticpro (&Vface_alternative_font_registry_alist
);
7745 defsubr (&Sinternal_make_lisp_face
);
7746 defsubr (&Sinternal_lisp_face_p
);
7747 defsubr (&Sinternal_set_lisp_face_attribute
);
7748 #ifdef HAVE_WINDOW_SYSTEM
7749 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7751 defsubr (&Scolor_gray_p
);
7752 defsubr (&Scolor_supported_p
);
7753 defsubr (&Sface_attribute_relative_p
);
7754 defsubr (&Smerge_face_attribute
);
7755 defsubr (&Sinternal_get_lisp_face_attribute
);
7756 defsubr (&Sinternal_lisp_face_attribute_values
);
7757 defsubr (&Sinternal_lisp_face_equal_p
);
7758 defsubr (&Sinternal_lisp_face_empty_p
);
7759 defsubr (&Sinternal_copy_lisp_face
);
7760 defsubr (&Sinternal_merge_in_global_face
);
7761 defsubr (&Sface_font
);
7762 defsubr (&Sframe_face_alist
);
7763 defsubr (&Stty_supports_face_attributes_p
);
7764 defsubr (&Scolor_distance
);
7765 defsubr (&Sinternal_set_font_selection_order
);
7766 defsubr (&Sinternal_set_alternative_font_family_alist
);
7767 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7768 defsubr (&Sface_attributes_as_vector
);
7770 defsubr (&Sdump_face
);
7771 defsubr (&Sshow_face_resources
);
7772 #endif /* GLYPH_DEBUG */
7773 defsubr (&Sclear_face_cache
);
7774 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7776 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7777 defsubr (&Sdump_colors
);
7780 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7781 doc
: /* *Limit for font matching.
7782 If an integer > 0, font matching functions won't load more than
7783 that number of fonts when searching for a matching font. */);
7784 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7786 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7787 doc
: /* List of global face definitions (for internal use only.) */);
7788 Vface_new_frame_defaults
= Qnil
;
7790 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7791 doc
: /* *Default stipple pattern used on monochrome displays.
7792 This stipple pattern is used on monochrome displays
7793 instead of shades of gray for a face background color.
7794 See `set-face-stipple' for possible values for this variable. */);
7795 Vface_default_stipple
= build_string ("gray3");
7797 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7798 doc
: /* An alist of defined terminal colors and their RGB values. */);
7799 Vtty_defined_color_alist
= Qnil
;
7801 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7802 doc
: /* Allowed scalable fonts.
7803 A value of nil means don't allow any scalable fonts.
7804 A value of t means allow any scalable font.
7805 Otherwise, value must be a list of regular expressions. A font may be
7806 scaled if its name matches a regular expression in the list.
7807 Note that if value is nil, a scalable font might still be used, if no
7808 other font of the appropriate family and registry is available. */);
7809 Vscalable_fonts_allowed
= Qnil
;
7811 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7812 doc
: /* List of ignored fonts.
7813 Each element is a regular expression that matches names of fonts to
7815 Vface_ignored_fonts
= Qnil
;
7817 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7818 doc
: /* Alist of fonts vs the rescaling factors.
7819 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7820 FONT-NAME-PATTERN is a regular expression matching a font name, and
7821 RESCALE-RATIO is a floating point number to specify how much larger
7822 \(or smaller) font we should use. For instance, if a face requests
7823 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7824 Vface_font_rescale_alist
= Qnil
;
7826 #ifdef HAVE_WINDOW_SYSTEM
7827 defsubr (&Sbitmap_spec_p
);
7828 defsubr (&Sx_list_fonts
);
7829 defsubr (&Sinternal_face_x_get_resource
);
7830 defsubr (&Sx_family_fonts
);
7831 defsubr (&Sx_font_family_list
);
7832 #endif /* HAVE_WINDOW_SYSTEM */
7835 /* arch-tag: 8a0f7598-5517-408d-9ab3-1da6fcd4c749
7836 (do not change this comment) */