1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001
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 attribyte 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 realzied 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 compositition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
201 #ifdef HAVE_WINDOW_SYSTEM
203 #endif /* HAVE_WINDOW_SYSTEM */
205 #ifdef HAVE_X_WINDOWS
209 #include <Xm/XmStrDefs.h>
210 #endif /* USE_MOTIF */
211 #endif /* HAVE_X_WINDOWS */
220 /* Redefine X specifics to W32 equivalents to avoid cluttering the
221 code with #ifdef blocks. */
222 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
223 #define x_display_info w32_display_info
224 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
225 #define check_x check_w32
226 #define x_list_fonts w32_list_fonts
227 #define GCGraphicsExposures 0
228 /* For historic reasons, FONT_WIDTH refers to average width on W32,
229 not maximum as on X. Redefine here. */
230 #define FONT_WIDTH FONT_MAX_WIDTH
231 #endif /* WINDOWSNT */
235 #define x_display_info mac_display_info
236 #define check_x check_mac
238 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
241 x_create_gc (f
, mask
, xgcv
)
247 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
256 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
261 #include "dispextern.h"
262 #include "blockinput.h"
264 #include "intervals.h"
266 #ifdef HAVE_X_WINDOWS
268 /* Compensate for a bug in Xos.h on some systems, on which it requires
269 time.h. On some such systems, Xos.h tries to redefine struct
270 timeval and struct timezone if USG is #defined while it is
273 #ifdef XOS_NEEDS_TIME_H
279 #else /* not XOS_NEEDS_TIME_H */
281 #endif /* not XOS_NEEDS_TIME_H */
283 #endif /* HAVE_X_WINDOWS */
287 #include "keyboard.h"
290 #define max(A, B) ((A) > (B) ? (A) : (B))
291 #define min(A, B) ((A) < (B) ? (A) : (B))
292 #define abs(X) ((X) < 0 ? -(X) : (X))
295 /* Number of pt per inch (from the TeXbook). */
297 #define PT_PER_INCH 72.27
299 /* Non-zero if face attribute ATTR is unspecified. */
301 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
303 /* Value is the number of elements of VECTOR. */
305 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
307 /* Make a copy of string S on the stack using alloca. Value is a pointer
310 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
312 /* Make a copy of the contents of Lisp string S on the stack using
313 alloca. Value is a pointer to the copy. */
315 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
317 /* Size of hash table of realized faces in face caches (should be a
320 #define FACE_CACHE_BUCKETS_SIZE 1001
322 /* A definition of XColor for non-X frames. */
324 #ifndef HAVE_X_WINDOWS
329 unsigned short red
, green
, blue
;
335 #endif /* not HAVE_X_WINDOWS */
337 /* Keyword symbols used for face attribute names. */
339 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
340 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
341 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
342 Lisp_Object QCreverse_video
;
343 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
345 /* Symbols used for attribute values. */
347 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
348 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
349 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
350 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
351 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
352 Lisp_Object Qultra_expanded
;
353 Lisp_Object Qreleased_button
, Qpressed_button
;
354 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
355 Lisp_Object Qunspecified
;
357 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
359 /* The name of the function to call when the background of the frame
360 has changed, frame_update_face_colors. */
362 Lisp_Object Qframe_update_face_colors
;
364 /* Names of basic faces. */
366 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
367 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
368 extern Lisp_Object Qmode_line
;
370 /* The symbol `face-alias'. A symbols having that property is an
371 alias for another face. Value of the property is the name of
374 Lisp_Object Qface_alias
;
376 /* Names of frame parameters related to faces. */
378 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
379 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
381 /* Default stipple pattern used on monochrome displays. This stipple
382 pattern is used on monochrome displays instead of shades of gray
383 for a face background color. See `set-face-stipple' for possible
384 values for this variable. */
386 Lisp_Object Vface_default_stipple
;
388 /* Alist of alternative font families. Each element is of the form
389 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
390 try FAMILY1, then FAMILY2, ... */
392 Lisp_Object Vface_alternative_font_family_alist
;
394 /* Alist of alternative font registries. Each element is of the form
395 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
396 loaded, try REGISTRY1, then REGISTRY2, ... */
398 Lisp_Object Vface_alternative_font_registry_alist
;
400 /* Allowed scalable fonts. A value of nil means don't allow any
401 scalable fonts. A value of t means allow the use of any scalable
402 font. Otherwise, value must be a list of regular expressions. A
403 font may be scaled if its name matches a regular expression in the
406 Lisp_Object Vscalable_fonts_allowed
;
408 /* List of regular expressions that matches names of fonts to ignore. */
410 Lisp_Object Vface_ignored_fonts
;
412 /* Maximum number of fonts to consider in font_list. If not an
413 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
415 Lisp_Object Vfont_list_limit
;
416 #define DEFAULT_FONT_LIST_LIMIT 100
418 /* The symbols `foreground-color' and `background-color' which can be
419 used as part of a `face' property. This is for compatibility with
422 Lisp_Object Qforeground_color
, Qbackground_color
;
424 /* The symbols `face' and `mouse-face' used as text properties. */
427 extern Lisp_Object Qmouse_face
;
429 /* Error symbol for wrong_type_argument in load_pixmap. */
431 Lisp_Object Qbitmap_spec_p
;
433 /* Alist of global face definitions. Each element is of the form
434 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
435 is a Lisp vector of face attributes. These faces are used
436 to initialize faces for new frames. */
438 Lisp_Object Vface_new_frame_defaults
;
440 /* The next ID to assign to Lisp faces. */
442 static int next_lface_id
;
444 /* A vector mapping Lisp face Id's to face names. */
446 static Lisp_Object
*lface_id_to_name
;
447 static int lface_id_to_name_size
;
449 /* TTY color-related functions (defined in tty-colors.el). */
451 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
453 /* The name of the function used to compute colors on TTYs. */
455 Lisp_Object Qtty_color_alist
;
457 /* An alist of defined terminal colors and their RGB values. */
459 Lisp_Object Vtty_defined_color_alist
;
461 /* Counter for calls to clear_face_cache. If this counter reaches
462 CLEAR_FONT_TABLE_COUNT, and a frame has more than
463 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
465 static int clear_font_table_count
;
466 #define CLEAR_FONT_TABLE_COUNT 100
467 #define CLEAR_FONT_TABLE_NFONTS 10
469 /* Non-zero means face attributes have been changed since the last
470 redisplay. Used in redisplay_internal. */
472 int face_change_count
;
474 /* Incremented for every change in the `menu' face. */
476 int menu_face_change_count
;
478 /* Non-zero means don't display bold text if a face's foreground
479 and background colors are the inverse of the default colors of the
480 display. This is a kluge to suppress `bold black' foreground text
481 which is hard to read on an LCD monitor. */
483 int tty_suppress_bold_inverse_default_colors_p
;
485 /* A list of the form `((x . y))' used to avoid consing in
486 Finternal_set_lisp_face_attribute. */
488 static Lisp_Object Vparam_value_alist
;
490 /* The total number of colors currently allocated. */
493 static int ncolors_allocated
;
494 static int npixmaps_allocated
;
500 /* Function prototypes. */
505 static void map_tty_color
P_ ((struct frame
*, struct face
*,
506 enum lface_attribute_index
, int *));
507 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
508 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
509 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
510 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
512 static int first_font_matching
P_ ((struct frame
*f
, char *,
513 struct font_name
*));
514 static int x_face_list_fonts
P_ ((struct frame
*, char *,
515 struct font_name
*, int, int, int));
516 static int font_scalable_p
P_ ((struct font_name
*));
517 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
518 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
519 static unsigned char *xstrlwr
P_ ((unsigned char *));
520 static void signal_error
P_ ((char *, Lisp_Object
));
521 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
522 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
523 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
524 static void free_face_colors
P_ ((struct frame
*, struct face
*));
525 static int face_color_gray_p
P_ ((struct frame
*, char *));
526 static char *build_font_name
P_ ((struct font_name
*));
527 static void free_font_names
P_ ((struct font_name
*, int));
528 static int sorted_font_list
P_ ((struct frame
*, char *,
529 int (*cmpfn
) P_ ((const void *, const void *)),
530 struct font_name
**));
531 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
532 Lisp_Object
, struct font_name
**));
533 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
534 Lisp_Object
, struct font_name
**));
535 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
536 Lisp_Object
, Lisp_Object
, struct font_name
**));
537 static int cmp_font_names
P_ ((const void *, const void *));
538 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
539 struct face
*, int));
540 static struct face
*realize_x_face
P_ ((struct face_cache
*,
541 Lisp_Object
*, int, struct face
*));
542 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
543 Lisp_Object
*, int));
544 static int realize_basic_faces
P_ ((struct frame
*));
545 static int realize_default_face
P_ ((struct frame
*));
546 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
547 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
548 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
549 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
550 static unsigned lface_hash
P_ ((Lisp_Object
*));
551 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
552 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
553 static void free_realized_face
P_ ((struct frame
*, struct face
*));
554 static void clear_face_gcs
P_ ((struct face_cache
*));
555 static void free_face_cache
P_ ((struct face_cache
*));
556 static int face_numeric_weight
P_ ((Lisp_Object
));
557 static int face_numeric_slant
P_ ((Lisp_Object
));
558 static int face_numeric_swidth
P_ ((Lisp_Object
));
559 static int face_fontset
P_ ((Lisp_Object
*));
560 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
561 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
562 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
563 Lisp_Object
*, Lisp_Object
));
564 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
566 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
567 Lisp_Object
, int, int));
568 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
569 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
570 static void free_realized_faces
P_ ((struct face_cache
*));
571 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
572 struct font_name
*, int, int));
573 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
574 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
575 static int xlfd_numeric_slant
P_ ((struct font_name
*));
576 static int xlfd_numeric_weight
P_ ((struct font_name
*));
577 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
578 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
579 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
580 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
581 static int xlfd_fixed_p
P_ ((struct font_name
*));
582 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
584 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
585 struct font_name
*, int,
587 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
588 struct font_name
*, int));
590 #ifdef HAVE_WINDOW_SYSTEM
592 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
593 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
594 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
595 int (*cmpfn
) P_ ((const void *, const void *))));
596 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
597 static void x_free_gc
P_ ((struct frame
*, GC
));
598 static void clear_font_table
P_ ((struct frame
*));
601 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
602 #endif /* WINDOWSNT */
604 #endif /* HAVE_WINDOW_SYSTEM */
607 /***********************************************************************
609 ***********************************************************************/
611 #ifdef HAVE_X_WINDOWS
613 #ifdef DEBUG_X_COLORS
615 /* The following is a poor mans infrastructure for debugging X color
616 allocation problems on displays with PseudoColor-8. Some X servers
617 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
618 color reference counts completely so that they don't signal an
619 error when a color is freed whose reference count is already 0.
620 Other X servers do. To help me debug this, the following code
621 implements a simple reference counting schema of its own, for a
622 single display/screen. --gerd. */
624 /* Reference counts for pixel colors. */
626 int color_count
[256];
628 /* Register color PIXEL as allocated. */
631 register_color (pixel
)
634 xassert (pixel
< 256);
635 ++color_count
[pixel
];
639 /* Register color PIXEL as deallocated. */
642 unregister_color (pixel
)
645 xassert (pixel
< 256);
646 if (color_count
[pixel
] > 0)
647 --color_count
[pixel
];
653 /* Register N colors from PIXELS as deallocated. */
656 unregister_colors (pixels
, n
)
657 unsigned long *pixels
;
661 for (i
= 0; i
< n
; ++i
)
662 unregister_color (pixels
[i
]);
666 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
667 "Dump currently allocated colors and their reference counts to stderr.")
672 fputc ('\n', stderr
);
674 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
677 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
680 fputc ('\n', stderr
);
682 fputc ('\t', stderr
);
686 fputc ('\n', stderr
);
690 #endif /* DEBUG_X_COLORS */
693 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
694 color values. Interrupt input must be blocked when this function
698 x_free_colors (f
, pixels
, npixels
)
700 unsigned long *pixels
;
703 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
705 /* If display has an immutable color map, freeing colors is not
706 necessary and some servers don't allow it. So don't do it. */
707 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
709 #ifdef DEBUG_X_COLORS
710 unregister_colors (pixels
, npixels
);
712 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
718 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
719 color values. Interrupt input must be blocked when this function
723 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
727 unsigned long *pixels
;
730 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
731 int class = dpyinfo
->visual
->class;
733 /* If display has an immutable color map, freeing colors is not
734 necessary and some servers don't allow it. So don't do it. */
735 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
737 #ifdef DEBUG_X_COLORS
738 unregister_colors (pixels
, npixels
);
740 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
745 /* Create and return a GC for use on frame F. GC values and mask
746 are given by XGCV and MASK. */
749 x_create_gc (f
, mask
, xgcv
)
756 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
763 /* Free GC which was used on frame F. */
771 xassert (--ngcs
>= 0);
772 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
776 #endif /* HAVE_X_WINDOWS */
779 /* W32 emulation of GCs */
782 x_create_gc (f
, mask
, xgcv
)
789 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
796 /* Free GC which was used on frame F. */
804 xassert (--ngcs
>= 0);
809 #endif /* WINDOWSNT */
811 /* Like stricmp. Used to compare parts of font names which are in
816 unsigned char *s1
, *s2
;
820 unsigned char c1
= tolower (*s1
);
821 unsigned char c2
= tolower (*s2
);
823 return c1
< c2
? -1 : 1;
828 return *s2
== 0 ? 0 : -1;
833 /* Like strlwr, which might not always be available. */
835 static unsigned char *
839 unsigned char *p
= s
;
848 /* Signal `error' with message S, and additional argument ARG. */
851 signal_error (s
, arg
)
855 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
859 /* If FRAME is nil, return a pointer to the selected frame.
860 Otherwise, check that FRAME is a live frame, and return a pointer
861 to it. NPARAM is the parameter number of FRAME, for
862 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
863 Lisp function definitions. */
865 static INLINE
struct frame
*
866 frame_or_selected_frame (frame
, nparam
)
871 frame
= selected_frame
;
873 CHECK_LIVE_FRAME (frame
, nparam
);
874 return XFRAME (frame
);
878 /***********************************************************************
880 ***********************************************************************/
882 /* Initialize face cache and basic faces for frame F. */
888 /* Make a face cache, if F doesn't have one. */
889 if (FRAME_FACE_CACHE (f
) == NULL
)
890 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
892 #ifdef HAVE_WINDOW_SYSTEM
893 /* Make the image cache. */
894 if (FRAME_WINDOW_P (f
))
896 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
897 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
898 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
900 #endif /* HAVE_WINDOW_SYSTEM */
902 /* Realize basic faces. Must have enough information in frame
903 parameters to realize basic faces at this point. */
904 #ifdef HAVE_X_WINDOWS
905 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
908 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
910 if (!realize_basic_faces (f
))
915 /* Free face cache of frame F. Called from Fdelete_frame. */
921 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
925 free_face_cache (face_cache
);
926 FRAME_FACE_CACHE (f
) = NULL
;
929 #ifdef HAVE_WINDOW_SYSTEM
930 if (FRAME_WINDOW_P (f
))
932 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
935 --image_cache
->refcount
;
936 if (image_cache
->refcount
== 0)
937 free_image_cache (f
);
940 #endif /* HAVE_WINDOW_SYSTEM */
944 /* Clear face caches, and recompute basic faces for frame F. Call
945 this after changing frame parameters on which those faces depend,
946 or when realized faces have been freed due to changing attributes
950 recompute_basic_faces (f
)
953 if (FRAME_FACE_CACHE (f
))
955 clear_face_cache (0);
956 if (!realize_basic_faces (f
))
962 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
963 try to free unused fonts, too. */
966 clear_face_cache (clear_fonts_p
)
969 #ifdef HAVE_WINDOW_SYSTEM
970 Lisp_Object tail
, frame
;
974 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
976 /* From time to time see if we can unload some fonts. This also
977 frees all realized faces on all frames. Fonts needed by
978 faces will be loaded again when faces are realized again. */
979 clear_font_table_count
= 0;
981 FOR_EACH_FRAME (tail
, frame
)
984 if (FRAME_WINDOW_P (f
)
985 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
987 free_all_realized_faces (frame
);
988 clear_font_table (f
);
994 /* Clear GCs of realized faces. */
995 FOR_EACH_FRAME (tail
, frame
)
998 if (FRAME_WINDOW_P (f
))
1000 clear_face_gcs (FRAME_FACE_CACHE (f
));
1001 clear_image_cache (f
, 0);
1005 #endif /* HAVE_WINDOW_SYSTEM */
1009 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1010 "Clear face caches on all frames.\n\
1011 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
1013 Lisp_Object thoroughly
;
1015 clear_face_cache (!NILP (thoroughly
));
1016 ++face_change_count
;
1017 ++windows_or_buffers_changed
;
1023 #ifdef HAVE_WINDOW_SYSTEM
1026 /* Remove those fonts from the font table of frame F exept for the
1027 default ASCII font for the frame. Called from clear_face_cache
1028 from time to time. */
1031 clear_font_table (f
)
1034 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1037 xassert (FRAME_WINDOW_P (f
));
1039 /* Free those fonts that are not used by the frame F as the default. */
1040 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1042 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1044 if (!font_info
->name
1045 || font_info
->font
== FRAME_FONT (f
))
1049 if (font_info
->full_name
!= font_info
->name
)
1050 xfree (font_info
->full_name
);
1051 xfree (font_info
->name
);
1053 /* Free the font. */
1055 #ifdef HAVE_X_WINDOWS
1056 XFreeFont (dpyinfo
->display
, font_info
->font
);
1059 w32_unload_font (dpyinfo
, font_info
->font
);
1063 /* Mark font table slot free. */
1064 font_info
->font
= NULL
;
1065 font_info
->name
= font_info
->full_name
= NULL
;
1069 #endif /* HAVE_WINDOW_SYSTEM */
1073 /***********************************************************************
1075 ***********************************************************************/
1077 #ifdef HAVE_WINDOW_SYSTEM
1079 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1080 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1081 A bitmap specification is either a string, a file name, or a list\n\
1082 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1083 HEIGHT is its height, and DATA is a string containing the bits of\n\
1084 the pixmap. Bits are stored row by row, each row occupies\n\
1085 (WIDTH + 7)/8 bytes.")
1091 if (STRINGP (object
))
1092 /* If OBJECT is a string, it's a file name. */
1094 else if (CONSP (object
))
1096 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1097 HEIGHT must be integers > 0, and DATA must be string large
1098 enough to hold a bitmap of the specified size. */
1099 Lisp_Object width
, height
, data
;
1101 height
= width
= data
= Qnil
;
1105 width
= XCAR (object
);
1106 object
= XCDR (object
);
1109 height
= XCAR (object
);
1110 object
= XCDR (object
);
1112 data
= XCAR (object
);
1116 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1118 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1120 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1125 return pixmap_p
? Qt
: Qnil
;
1129 /* Load a bitmap according to NAME (which is either a file name or a
1130 pixmap spec) for use on frame F. Value is the bitmap_id (see
1131 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1132 bitmap cannot be loaded, display a message saying so, and return
1133 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1134 if these pointers are not null. */
1137 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1140 unsigned int *w_ptr
, *h_ptr
;
1148 tem
= Fbitmap_spec_p (name
);
1150 wrong_type_argument (Qbitmap_spec_p
, name
);
1155 /* Decode a bitmap spec into a bitmap. */
1160 w
= XINT (Fcar (name
));
1161 h
= XINT (Fcar (Fcdr (name
)));
1162 bits
= Fcar (Fcdr (Fcdr (name
)));
1164 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1169 /* It must be a string -- a file name. */
1170 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1176 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1187 ++npixmaps_allocated
;
1190 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1193 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1199 #endif /* HAVE_WINDOW_SYSTEM */
1203 /***********************************************************************
1205 ***********************************************************************/
1207 #ifdef HAVE_WINDOW_SYSTEM
1209 /* Update the line_height of frame F. Return non-zero if line height
1213 frame_update_line_height (f
)
1216 int line_height
, changed_p
;
1218 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1219 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1220 FRAME_LINE_HEIGHT (f
) = line_height
;
1224 #endif /* HAVE_WINDOW_SYSTEM */
1227 /***********************************************************************
1229 ***********************************************************************/
1231 #ifdef HAVE_WINDOW_SYSTEM
1233 /* Load font of face FACE which is used on frame F to display
1234 character C. The name of the font to load is determined by lface
1235 and fontset of FACE. */
1238 load_face_font (f
, face
, c
)
1243 struct font_info
*font_info
= NULL
;
1246 face
->font_info_id
= -1;
1249 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1254 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1259 face
->font_info_id
= font_info
->font_idx
;
1260 face
->font
= font_info
->font
;
1261 face
->font_name
= font_info
->full_name
;
1264 x_free_gc (f
, face
->gc
);
1269 add_to_log ("Unable to load font %s",
1270 build_string (font_name
), Qnil
);
1274 #endif /* HAVE_WINDOW_SYSTEM */
1278 /***********************************************************************
1280 ***********************************************************************/
1282 /* A version of defined_color for non-X frames. */
1285 tty_defined_color (f
, color_name
, color_def
, alloc
)
1291 Lisp_Object color_desc
;
1292 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1293 unsigned long red
= 0, green
= 0, blue
= 0;
1296 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1300 XSETFRAME (frame
, f
);
1302 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1303 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1305 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1306 if (CONSP (XCDR (XCDR (color_desc
))))
1308 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1309 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1310 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1314 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1315 /* We were called early during startup, and the colors are not
1316 yet set up in tty-defined-color-alist. Don't return a failure
1317 indication, since this produces the annoying "Unable to
1318 load color" messages in the *Messages* buffer. */
1321 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1323 if (strcmp (color_name
, "unspecified-fg") == 0)
1324 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1325 else if (strcmp (color_name
, "unspecified-bg") == 0)
1326 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1329 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1332 color_def
->pixel
= color_idx
;
1333 color_def
->red
= red
;
1334 color_def
->green
= green
;
1335 color_def
->blue
= blue
;
1341 /* Decide if color named COLOR_NAME is valid for the display
1342 associated with the frame F; if so, return the rgb values in
1343 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1345 This does the right thing for any type of frame. */
1348 defined_color (f
, color_name
, color_def
, alloc
)
1354 if (!FRAME_WINDOW_P (f
))
1355 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1356 #ifdef HAVE_X_WINDOWS
1357 else if (FRAME_X_P (f
))
1358 return x_defined_color (f
, color_name
, color_def
, alloc
);
1361 else if (FRAME_W32_P (f
))
1362 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1365 else if (FRAME_MAC_P (f
))
1366 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1373 /* Given the index IDX of a tty color on frame F, return its name, a
1377 tty_color_name (f
, idx
)
1381 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1384 Lisp_Object coldesc
;
1386 XSETFRAME (frame
, f
);
1387 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1389 if (!NILP (coldesc
))
1390 return XCAR (coldesc
);
1393 /* We can have an MSDOG frame under -nw for a short window of
1394 opportunity before internal_terminal_init is called. DTRT. */
1395 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1396 return msdos_stdcolor_name (idx
);
1399 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1400 return build_string (unspecified_fg
);
1401 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1402 return build_string (unspecified_bg
);
1405 return vga_stdcolor_name (idx
);
1408 return Qunspecified
;
1412 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1413 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1416 face_color_gray_p (f
, color_name
)
1423 if (defined_color (f
, color_name
, &color
, 0))
1424 gray_p
= ((abs (color
.red
- color
.green
)
1425 < max (color
.red
, color
.green
) / 20)
1426 && (abs (color
.green
- color
.blue
)
1427 < max (color
.green
, color
.blue
) / 20)
1428 && (abs (color
.blue
- color
.red
)
1429 < max (color
.blue
, color
.red
) / 20));
1437 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1438 BACKGROUND_P non-zero means the color will be used as background
1442 face_color_supported_p (f
, color_name
, background_p
)
1450 XSETFRAME (frame
, f
);
1451 return (FRAME_WINDOW_P (f
)
1452 ? (!NILP (Fxw_display_color_p (frame
))
1453 || xstricmp (color_name
, "black") == 0
1454 || xstricmp (color_name
, "white") == 0
1456 && face_color_gray_p (f
, color_name
))
1457 || (!NILP (Fx_display_grayscale_p (frame
))
1458 && face_color_gray_p (f
, color_name
)))
1459 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1463 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1464 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1465 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1466 If FRAME is nil or omitted, use the selected frame.")
1468 Lisp_Object color
, frame
;
1472 CHECK_FRAME (frame
, 0);
1473 CHECK_STRING (color
, 0);
1475 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1479 DEFUN ("color-supported-p", Fcolor_supported_p
,
1480 Scolor_supported_p
, 2, 3, 0,
1481 "Return non-nil if COLOR can be displayed on FRAME.\n\
1482 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1483 If FRAME is nil or omitted, use the selected frame.\n\
1484 COLOR must be a valid color name.")
1485 (color
, frame
, background_p
)
1486 Lisp_Object frame
, color
, background_p
;
1490 CHECK_FRAME (frame
, 0);
1491 CHECK_STRING (color
, 0);
1493 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1499 /* Load color with name NAME for use by face FACE on frame F.
1500 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1501 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1502 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1503 pixel color. If color cannot be loaded, display a message, and
1504 return the foreground, background or underline color of F, but
1505 record that fact in flags of the face so that we don't try to free
1509 load_color (f
, face
, name
, target_index
)
1513 enum lface_attribute_index target_index
;
1517 xassert (STRINGP (name
));
1518 xassert (target_index
== LFACE_FOREGROUND_INDEX
1519 || target_index
== LFACE_BACKGROUND_INDEX
1520 || target_index
== LFACE_UNDERLINE_INDEX
1521 || target_index
== LFACE_OVERLINE_INDEX
1522 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1523 || target_index
== LFACE_BOX_INDEX
);
1525 /* if the color map is full, defined_color will return a best match
1526 to the values in an existing cell. */
1527 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1529 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1531 switch (target_index
)
1533 case LFACE_FOREGROUND_INDEX
:
1534 face
->foreground_defaulted_p
= 1;
1535 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1538 case LFACE_BACKGROUND_INDEX
:
1539 face
->background_defaulted_p
= 1;
1540 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1543 case LFACE_UNDERLINE_INDEX
:
1544 face
->underline_defaulted_p
= 1;
1545 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1548 case LFACE_OVERLINE_INDEX
:
1549 face
->overline_color_defaulted_p
= 1;
1550 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1553 case LFACE_STRIKE_THROUGH_INDEX
:
1554 face
->strike_through_color_defaulted_p
= 1;
1555 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1558 case LFACE_BOX_INDEX
:
1559 face
->box_color_defaulted_p
= 1;
1560 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1569 ++ncolors_allocated
;
1576 #ifdef HAVE_WINDOW_SYSTEM
1578 /* Load colors for face FACE which is used on frame F. Colors are
1579 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1580 of ATTRS. If the background color specified is not supported on F,
1581 try to emulate gray colors with a stipple from Vface_default_stipple. */
1584 load_face_colors (f
, face
, attrs
)
1591 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1592 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1594 /* Swap colors if face is inverse-video. */
1595 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1603 /* Check for support for foreground, not for background because
1604 face_color_supported_p is smart enough to know that grays are
1605 "supported" as background because we are supposed to use stipple
1607 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1608 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1610 x_destroy_bitmap (f
, face
->stipple
);
1611 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1612 &face
->pixmap_w
, &face
->pixmap_h
);
1615 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1616 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1620 /* Free color PIXEL on frame F. */
1623 unload_color (f
, pixel
)
1625 unsigned long pixel
;
1627 #ifdef HAVE_X_WINDOWS
1629 x_free_colors (f
, &pixel
, 1);
1635 /* Free colors allocated for FACE. */
1638 free_face_colors (f
, face
)
1642 #ifdef HAVE_X_WINDOWS
1645 if (!face
->foreground_defaulted_p
)
1647 x_free_colors (f
, &face
->foreground
, 1);
1648 IF_DEBUG (--ncolors_allocated
);
1651 if (!face
->background_defaulted_p
)
1653 x_free_colors (f
, &face
->background
, 1);
1654 IF_DEBUG (--ncolors_allocated
);
1657 if (face
->underline_p
1658 && !face
->underline_defaulted_p
)
1660 x_free_colors (f
, &face
->underline_color
, 1);
1661 IF_DEBUG (--ncolors_allocated
);
1664 if (face
->overline_p
1665 && !face
->overline_color_defaulted_p
)
1667 x_free_colors (f
, &face
->overline_color
, 1);
1668 IF_DEBUG (--ncolors_allocated
);
1671 if (face
->strike_through_p
1672 && !face
->strike_through_color_defaulted_p
)
1674 x_free_colors (f
, &face
->strike_through_color
, 1);
1675 IF_DEBUG (--ncolors_allocated
);
1678 if (face
->box
!= FACE_NO_BOX
1679 && !face
->box_color_defaulted_p
)
1681 x_free_colors (f
, &face
->box_color
, 1);
1682 IF_DEBUG (--ncolors_allocated
);
1686 #endif /* HAVE_X_WINDOWS */
1689 #endif /* HAVE_WINDOW_SYSTEM */
1693 /***********************************************************************
1695 ***********************************************************************/
1697 /* An enumerator for each field of an XLFD font name. */
1718 /* An enumerator for each possible slant value of a font. Taken from
1719 the XLFD specification. */
1727 XLFD_SLANT_REVERSE_ITALIC
,
1728 XLFD_SLANT_REVERSE_OBLIQUE
,
1732 /* Relative font weight according to XLFD documentation. */
1736 XLFD_WEIGHT_UNKNOWN
,
1737 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1738 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1739 XLFD_WEIGHT_LIGHT
, /* 30 */
1740 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1741 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1742 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1743 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1744 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1745 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1748 /* Relative proportionate width. */
1752 XLFD_SWIDTH_UNKNOWN
,
1753 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1754 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1755 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1756 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1757 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1758 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1759 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1760 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1761 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1764 /* Structure used for tables mapping XLFD weight, slant, and width
1765 names to numeric and symbolic values. */
1771 Lisp_Object
*symbol
;
1774 /* Table of XLFD slant names and their numeric and symbolic
1775 representations. This table must be sorted by slant names in
1778 static struct table_entry slant_table
[] =
1780 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1781 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1782 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1783 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1784 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1785 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1788 /* Table of XLFD weight names. This table must be sorted by weight
1789 names in ascending order. */
1791 static struct table_entry weight_table
[] =
1793 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1794 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1795 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1796 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1797 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1798 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1799 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1800 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1801 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1802 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1803 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1804 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1805 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1806 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1807 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1808 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1811 /* Table of XLFD width names. This table must be sorted by width
1812 names in ascending order. */
1814 static struct table_entry swidth_table
[] =
1816 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1817 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1818 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1819 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1820 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1821 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1822 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1823 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1824 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1825 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1826 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1827 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1828 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1829 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1830 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1833 /* Structure used to hold the result of splitting font names in XLFD
1834 format into their fields. */
1838 /* The original name which is modified destructively by
1839 split_font_name. The pointer is kept here to be able to free it
1840 if it was allocated from the heap. */
1843 /* Font name fields. Each vector element points into `name' above.
1844 Fields are NUL-terminated. */
1845 char *fields
[XLFD_LAST
];
1847 /* Numeric values for those fields that interest us. See
1848 split_font_name for which these are. */
1849 int numeric
[XLFD_LAST
];
1851 /* Lower value mean higher priority. */
1852 int registry_priority
;
1855 /* The frame in effect when sorting font names. Set temporarily in
1856 sort_fonts so that it is available in font comparison functions. */
1858 static struct frame
*font_frame
;
1860 /* Order by which font selection chooses fonts. The default values
1861 mean `first, find a best match for the font width, then for the
1862 font height, then for weight, then for slant.' This variable can be
1863 set via set-face-font-sort-order. */
1866 static int font_sort_order
[4] = {
1867 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1870 static int font_sort_order
[4];
1873 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1874 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1875 is a pointer to the matching table entry or null if no table entry
1878 static struct table_entry
*
1879 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1880 struct table_entry
*table
;
1882 struct font_name
*font
;
1885 /* Function split_font_name converts fields to lower-case, so there
1886 is no need to use xstrlwr or xstricmp here. */
1887 char *s
= font
->fields
[field_index
];
1888 int low
, mid
, high
, cmp
;
1895 mid
= (low
+ high
) / 2;
1896 cmp
= strcmp (table
[mid
].name
, s
);
1910 /* Return a numeric representation for font name field
1911 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1912 has DIM entries. Value is the numeric value found or DFLT if no
1913 table entry matches. This function is used to translate weight,
1914 slant, and swidth names of XLFD font names to numeric values. */
1917 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1918 struct table_entry
*table
;
1920 struct font_name
*font
;
1924 struct table_entry
*p
;
1925 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1926 return p
? p
->numeric
: dflt
;
1930 /* Return a symbolic representation for font name field
1931 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1932 has DIM entries. Value is the symbolic value found or DFLT if no
1933 table entry matches. This function is used to translate weight,
1934 slant, and swidth names of XLFD font names to symbols. */
1936 static INLINE Lisp_Object
1937 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1938 struct table_entry
*table
;
1940 struct font_name
*font
;
1944 struct table_entry
*p
;
1945 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1946 return p
? *p
->symbol
: dflt
;
1950 /* Return a numeric value for the slant of the font given by FONT. */
1953 xlfd_numeric_slant (font
)
1954 struct font_name
*font
;
1956 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1957 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1961 /* Return a symbol representing the weight of the font given by FONT. */
1963 static INLINE Lisp_Object
1964 xlfd_symbolic_slant (font
)
1965 struct font_name
*font
;
1967 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1968 font
, XLFD_SLANT
, Qnormal
);
1972 /* Return a numeric value for the weight of the font given by FONT. */
1975 xlfd_numeric_weight (font
)
1976 struct font_name
*font
;
1978 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1979 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1983 /* Return a symbol representing the slant of the font given by FONT. */
1985 static INLINE Lisp_Object
1986 xlfd_symbolic_weight (font
)
1987 struct font_name
*font
;
1989 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1990 font
, XLFD_WEIGHT
, Qnormal
);
1994 /* Return a numeric value for the swidth of the font whose XLFD font
1995 name fields are found in FONT. */
1998 xlfd_numeric_swidth (font
)
1999 struct font_name
*font
;
2001 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2002 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2006 /* Return a symbolic value for the swidth of FONT. */
2008 static INLINE Lisp_Object
2009 xlfd_symbolic_swidth (font
)
2010 struct font_name
*font
;
2012 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2013 font
, XLFD_SWIDTH
, Qnormal
);
2017 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2018 entries. Value is a pointer to the matching table entry or null if
2019 no element of TABLE contains SYMBOL. */
2021 static struct table_entry
*
2022 face_value (table
, dim
, symbol
)
2023 struct table_entry
*table
;
2029 xassert (SYMBOLP (symbol
));
2031 for (i
= 0; i
< dim
; ++i
)
2032 if (EQ (*table
[i
].symbol
, symbol
))
2035 return i
< dim
? table
+ i
: NULL
;
2039 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2040 entries. Value is -1 if SYMBOL is not found in TABLE. */
2043 face_numeric_value (table
, dim
, symbol
)
2044 struct table_entry
*table
;
2048 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2049 return p
? p
->numeric
: -1;
2053 /* Return a numeric value representing the weight specified by Lisp
2054 symbol WEIGHT. Value is one of the enumerators of enum
2058 face_numeric_weight (weight
)
2061 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2065 /* Return a numeric value representing the slant specified by Lisp
2066 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2069 face_numeric_slant (slant
)
2072 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2076 /* Return a numeric value representing the swidth specified by Lisp
2077 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2080 face_numeric_swidth (width
)
2083 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2087 #ifdef HAVE_WINDOW_SYSTEM
2089 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2093 struct font_name
*font
;
2095 /* Function split_font_name converts fields to lower-case, so there
2096 is no need to use tolower here. */
2097 return *font
->fields
[XLFD_SPACING
] != 'p';
2101 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2103 The actual height of the font when displayed on F depends on the
2104 resolution of both the font and frame. For example, a 10pt font
2105 designed for a 100dpi display will display larger than 10pt on a
2106 75dpi display. (It's not unusual to use fonts not designed for the
2107 display one is using. For example, some intlfonts are available in
2108 72dpi versions, only.)
2110 Value is the real point size of FONT on frame F, or 0 if it cannot
2114 xlfd_point_size (f
, font
)
2116 struct font_name
*font
;
2118 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2119 double font_pixel
= atoi (font
->fields
[XLFD_PIXEL_SIZE
]);
2122 if (font_pixel
== 0)
2125 real_pt
= PT_PER_INCH
* 10.0 * font_pixel
/ resy
+ 0.5;
2131 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2132 of frame F. This function is used to guess a point size of font
2133 when only the pixel height of the font is available. */
2136 pixel_point_size (f
, pixel
)
2140 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2144 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2145 point size of one dot. */
2146 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2147 int_pt
= real_pt
+ 0.5;
2153 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2154 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2155 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2156 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2157 zero if the font name doesn't have the format we expect. The
2158 expected format is a font name that starts with a `-' and has
2159 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2160 forms of font names where certain field contents are enclosed in
2161 square brackets. We don't support that, for now. */
2164 split_font_name (f
, font
, numeric_p
)
2166 struct font_name
*font
;
2172 if (*font
->name
== '-')
2174 char *p
= xstrlwr (font
->name
) + 1;
2176 while (i
< XLFD_LAST
)
2178 font
->fields
[i
] = p
;
2181 while (*p
&& *p
!= '-')
2191 success_p
= i
== XLFD_LAST
;
2193 /* If requested, and font name was in the expected format,
2194 compute numeric values for some fields. */
2195 if (numeric_p
&& success_p
)
2197 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2198 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2199 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2200 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2201 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2202 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2205 /* Initialize it to zero. It will be overridden by font_list while
2206 trying alternate registries. */
2207 font
->registry_priority
= 0;
2213 /* Build an XLFD font name from font name fields in FONT. Value is a
2214 pointer to the font name, which is allocated via xmalloc. */
2217 build_font_name (font
)
2218 struct font_name
*font
;
2222 char *font_name
= (char *) xmalloc (size
);
2223 int total_length
= 0;
2225 for (i
= 0; i
< XLFD_LAST
; ++i
)
2227 /* Add 1 because of the leading `-'. */
2228 int len
= strlen (font
->fields
[i
]) + 1;
2230 /* Reallocate font_name if necessary. Add 1 for the final
2232 if (total_length
+ len
+ 1 >= size
)
2234 int new_size
= max (2 * size
, size
+ len
+ 1);
2235 int sz
= new_size
* sizeof *font_name
;
2236 font_name
= (char *) xrealloc (font_name
, sz
);
2240 font_name
[total_length
] = '-';
2241 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2242 total_length
+= len
;
2245 font_name
[total_length
] = 0;
2250 /* Free an array FONTS of N font_name structures. This frees FONTS
2251 itself and all `name' fields in its elements. */
2254 free_font_names (fonts
, n
)
2255 struct font_name
*fonts
;
2259 xfree (fonts
[--n
].name
);
2264 /* Sort vector FONTS of font_name structures which contains NFONTS
2265 elements using qsort and comparison function CMPFN. F is the frame
2266 on which the fonts will be used. The global variable font_frame
2267 is temporarily set to F to make it available in CMPFN. */
2270 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2272 struct font_name
*fonts
;
2274 int (*cmpfn
) P_ ((const void *, const void *));
2277 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2282 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2283 display in x_display_list. FONTS is a pointer to a vector of
2284 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2285 alternative patterns from Valternate_fontname_alist if no fonts are
2286 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2289 For all fonts found, set FONTS[i].name to the name of the font,
2290 allocated via xmalloc, and split font names into fields. Ignore
2291 fonts that we can't parse. Value is the number of fonts found. */
2294 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2298 struct font_name
*fonts
;
2299 int nfonts
, try_alternatives_p
;
2300 int scalable_fonts_p
;
2304 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2305 better to do it the other way around. */
2307 Lisp_Object lpattern
, tem
;
2309 lpattern
= build_string (pattern
);
2311 /* Get the list of fonts matching PATTERN. */
2314 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2317 lfonts
= x_list_fonts (f
, lpattern
, scalable_fonts_p
? -1 : 0, nfonts
);
2320 /* Make a copy of the font names we got from X, and
2321 split them into fields. */
2323 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2325 Lisp_Object elt
, tail
;
2326 char *name
= XSTRING (XCAR (tem
))->data
;
2328 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2332 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2338 /* Make a copy of the font name. */
2339 fonts
[n
].name
= xstrdup (name
);
2341 /* Ignore fonts having a name that we can't parse. */
2342 if (!split_font_name (f
, fonts
+ n
, 1))
2343 xfree (fonts
[n
].name
);
2344 else if (font_scalable_p (fonts
+ n
))
2346 if (!scalable_fonts_p
2347 || !may_use_scalable_font_p (fonts
+ n
, name
))
2348 xfree (fonts
[n
].name
);
2356 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2357 if (n
== 0 && try_alternatives_p
)
2359 Lisp_Object list
= Valternate_fontname_alist
;
2361 while (CONSP (list
))
2363 Lisp_Object entry
= XCAR (list
);
2365 && STRINGP (XCAR (entry
))
2366 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2373 Lisp_Object patterns
= XCAR (list
);
2376 while (CONSP (patterns
)
2377 /* If list is screwed up, give up. */
2378 && (name
= XCAR (patterns
),
2380 /* Ignore patterns equal to PATTERN because we tried that
2381 already with no success. */
2382 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2383 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2387 patterns
= XCDR (patterns
);
2395 /* Determine the first font matching PATTERN on frame F. Return in
2396 *FONT the matching font name, split into fields. Value is non-zero
2397 if a match was found. */
2400 first_font_matching (f
, pattern
, font
)
2403 struct font_name
*font
;
2406 struct font_name
*fonts
;
2408 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2409 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2413 bcopy (&fonts
[0], font
, sizeof *font
);
2415 fonts
[0].name
= NULL
;
2416 free_font_names (fonts
, nfonts
);
2423 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2424 using comparison function CMPFN. Value is the number of fonts
2425 found. If value is non-zero, *FONTS is set to a vector of
2426 font_name structures allocated from the heap containing matching
2427 fonts. Each element of *FONTS contains a name member that is also
2428 allocated from the heap. Font names in these structures are split
2429 into fields. Use free_font_names to free such an array. */
2432 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2435 int (*cmpfn
) P_ ((const void *, const void *));
2436 struct font_name
**fonts
;
2440 /* Get the list of fonts matching pattern. 100 should suffice. */
2441 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2442 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2443 nfonts
= XFASTINT (Vfont_list_limit
);
2445 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2446 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2448 /* Sort the resulting array and return it in *FONTS. If no
2449 fonts were found, make sure to set *FONTS to null. */
2451 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2462 /* Compare two font_name structures *A and *B. Value is analogous to
2463 strcmp. Sort order is given by the global variable
2464 font_sort_order. Font names are sorted so that, everything else
2465 being equal, fonts with a resolution closer to that of the frame on
2466 which they are used are listed first. The global variable
2467 font_frame is the frame on which we operate. */
2470 cmp_font_names (a
, b
)
2473 struct font_name
*x
= (struct font_name
*) a
;
2474 struct font_name
*y
= (struct font_name
*) b
;
2477 /* All strings have been converted to lower-case by split_font_name,
2478 so we can use strcmp here. */
2479 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2484 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2486 int j
= font_sort_order
[i
];
2487 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2492 /* Everything else being equal, we prefer fonts with an
2493 y-resolution closer to that of the frame. */
2494 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2495 int x_resy
= x
->numeric
[XLFD_RESY
];
2496 int y_resy
= y
->numeric
[XLFD_RESY
];
2497 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2505 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2506 is non-nil list fonts matching that pattern. Otherwise, if
2507 REGISTRY is non-nil return only fonts with that registry, otherwise
2508 return fonts of any registry. Set *FONTS to a vector of font_name
2509 structures allocated from the heap containing the fonts found.
2510 Value is the number of fonts found. */
2513 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2515 Lisp_Object pattern
, family
, registry
;
2516 struct font_name
**fonts
;
2518 char *pattern_str
, *family_str
, *registry_str
;
2522 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2523 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2525 pattern_str
= (char *) alloca (strlen (family_str
)
2526 + strlen (registry_str
)
2528 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2529 strcat (pattern_str
, family_str
);
2530 strcat (pattern_str
, "-*-");
2531 strcat (pattern_str
, registry_str
);
2532 if (!index (registry_str
, '-'))
2534 if (registry_str
[strlen (registry_str
) - 1] == '*')
2535 strcat (pattern_str
, "-*");
2537 strcat (pattern_str
, "*-*");
2541 pattern_str
= (char *) XSTRING (pattern
)->data
;
2543 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2547 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2548 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2549 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2552 static struct font_name
*
2553 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2554 struct font_name
*fonts1
, *fonts2
;
2555 int nfonts1
, nfonts2
;
2557 int new_nfonts
= nfonts1
+ nfonts2
;
2558 struct font_name
*new_fonts
;
2560 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2561 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2562 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2569 /* Get a sorted list of fonts of family FAMILY on frame F.
2571 If PATTERN is non-nil list fonts matching that pattern.
2573 If REGISTRY is non-nil, return fonts with that registry and the
2574 alternative registries from Vface_alternative_font_registry_alist.
2576 If REGISTRY is nil return fonts of any registry.
2578 Set *FONTS to a vector of font_name structures allocated from the
2579 heap containing the fonts found. Value is the number of fonts
2583 font_list (f
, pattern
, family
, registry
, fonts
)
2585 Lisp_Object pattern
, family
, registry
;
2586 struct font_name
**fonts
;
2588 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2590 if (!NILP (registry
)
2591 && CONSP (Vface_alternative_font_registry_alist
))
2595 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2600 for (alter
= XCDR (alter
), reg_prio
= 1;
2602 alter
= XCDR (alter
), reg_prio
++)
2603 if (STRINGP (XCAR (alter
)))
2606 struct font_name
*fonts2
;
2608 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2610 for (i
= 0; i
< nfonts2
; i
++)
2611 fonts2
[i
].registry_priority
= reg_prio
;
2612 *fonts
= (nfonts
> 0
2613 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2624 /* Remove elements from LIST whose cars are `equal'. Called from
2625 x-family-fonts and x-font-family-list to remove duplicate font
2629 remove_duplicates (list
)
2632 Lisp_Object tail
= list
;
2634 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2636 Lisp_Object next
= XCDR (tail
);
2637 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2638 XCDR (tail
) = XCDR (next
);
2645 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2646 "Return a list of available fonts of family FAMILY on FRAME.\n\
2647 If FAMILY is omitted or nil, list all families.\n\
2648 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2650 If FRAME is omitted or nil, use the selected frame.\n\
2651 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2652 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2653 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2654 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2655 width, weight and slant of the font. These symbols are the same as for\n\
2656 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2657 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2658 giving the registry and encoding of the font.\n\
2659 The result list is sorted according to the current setting of\n\
2660 the face font sort order.")
2662 Lisp_Object family
, frame
;
2664 struct frame
*f
= check_x_frame (frame
);
2665 struct font_name
*fonts
;
2668 struct gcpro gcpro1
;
2671 CHECK_STRING (family
, 1);
2675 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2676 for (i
= nfonts
- 1; i
>= 0; --i
)
2678 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2681 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2682 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2683 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2684 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2685 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2686 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2687 tem
= build_font_name (fonts
+ i
);
2688 ASET (v
, 6, build_string (tem
));
2689 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2690 fonts
[i
].fields
[XLFD_ENCODING
]);
2691 ASET (v
, 7, build_string (tem
));
2694 result
= Fcons (v
, result
);
2697 remove_duplicates (result
);
2698 free_font_names (fonts
, nfonts
);
2704 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2706 "Return a list of available font families on FRAME.\n\
2707 If FRAME is omitted or nil, use the selected frame.\n\
2708 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2709 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2714 struct frame
*f
= check_x_frame (frame
);
2716 struct font_name
*fonts
;
2718 struct gcpro gcpro1
;
2719 int count
= specpdl_ptr
- specpdl
;
2722 /* Let's consider all fonts. Increase the limit for matching
2723 fonts until we have them all. */
2726 specbind (intern ("font-list-limit"), make_number (limit
));
2727 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2729 if (nfonts
== limit
)
2731 free_font_names (fonts
, nfonts
);
2740 for (i
= nfonts
- 1; i
>= 0; --i
)
2741 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2742 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2745 remove_duplicates (result
);
2746 free_font_names (fonts
, nfonts
);
2748 return unbind_to (count
, result
);
2752 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2753 "Return a list of the names of available fonts matching PATTERN.\n\
2754 If optional arguments FACE and FRAME are specified, return only fonts\n\
2755 the same size as FACE on FRAME.\n\
2756 PATTERN is a string, perhaps with wildcard characters;\n\
2757 the * character matches any substring, and\n\
2758 the ? character matches any single character.\n\
2759 PATTERN is case-insensitive.\n\
2760 FACE is a face name--a symbol.\n\
2762 The return value is a list of strings, suitable as arguments to\n\
2765 Fonts Emacs can't use may or may not be excluded\n\
2766 even if they match PATTERN and FACE.\n\
2767 The optional fourth argument MAXIMUM sets a limit on how many\n\
2768 fonts to match. The first MAXIMUM fonts are reported.\n\
2769 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2770 occupied by a character of a font. In that case, return only fonts\n\
2771 the WIDTH times as wide as FACE on FRAME.")
2772 (pattern
, face
, frame
, maximum
, width
)
2773 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2780 CHECK_STRING (pattern
, 0);
2786 CHECK_NATNUM (maximum
, 0);
2787 maxnames
= XINT (maximum
);
2791 CHECK_NUMBER (width
, 4);
2793 /* We can't simply call check_x_frame because this function may be
2794 called before any frame is created. */
2795 f
= frame_or_selected_frame (frame
, 2);
2796 if (!FRAME_WINDOW_P (f
))
2798 /* Perhaps we have not yet created any frame. */
2803 /* Determine the width standard for comparison with the fonts we find. */
2809 /* This is of limited utility since it works with character
2810 widths. Keep it for compatibility. --gerd. */
2811 int face_id
= lookup_named_face (f
, face
, 0);
2812 struct face
*face
= (face_id
< 0
2814 : FACE_FROM_ID (f
, face_id
));
2816 if (face
&& face
->font
)
2817 size
= FONT_WIDTH (face
->font
);
2819 size
= FONT_WIDTH (FRAME_FONT (f
));
2822 size
*= XINT (width
);
2826 Lisp_Object args
[2];
2828 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2830 /* We don't have to check fontsets. */
2832 args
[1] = list_fontsets (f
, pattern
, size
);
2833 return Fnconc (2, args
);
2837 #endif /* HAVE_WINDOW_SYSTEM */
2841 /***********************************************************************
2843 ***********************************************************************/
2845 /* Access face attributes of face LFACE, a Lisp vector. */
2847 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2848 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2849 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2850 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2851 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2852 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2853 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2854 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2855 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2856 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2857 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2858 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2859 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2860 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2861 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2862 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2864 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2865 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2867 #define LFACEP(LFACE) \
2869 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2870 && EQ (AREF (LFACE, 0), Qface))
2875 /* Check consistency of Lisp face attribute vector ATTRS. */
2878 check_lface_attrs (attrs
)
2881 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2882 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2883 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2884 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2885 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2886 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2887 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2888 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2889 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2890 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2891 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2892 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2893 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2894 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2895 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2896 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2897 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2898 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2899 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2900 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2901 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2902 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2903 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2904 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2905 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2906 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2907 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2908 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2909 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2910 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2911 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2912 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2913 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2914 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2915 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2916 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2917 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2918 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2919 #ifdef HAVE_WINDOW_SYSTEM
2920 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2921 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2922 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2923 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2924 || NILP (attrs
[LFACE_FONT_INDEX
])
2925 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2930 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2938 xassert (LFACEP (lface
));
2939 check_lface_attrs (XVECTOR (lface
)->contents
);
2943 #else /* GLYPH_DEBUG == 0 */
2945 #define check_lface_attrs(attrs) (void) 0
2946 #define check_lface(lface) (void) 0
2948 #endif /* GLYPH_DEBUG == 0 */
2951 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2952 to make it a symvol. If FACE_NAME is an alias for another face,
2953 return that face's name. */
2956 resolve_face_name (face_name
)
2957 Lisp_Object face_name
;
2959 Lisp_Object aliased
;
2961 if (STRINGP (face_name
))
2962 face_name
= intern (XSTRING (face_name
)->data
);
2964 while (SYMBOLP (face_name
))
2966 aliased
= Fget (face_name
, Qface_alias
);
2970 face_name
= aliased
;
2977 /* Return the face definition of FACE_NAME on frame F. F null means
2978 return the definition for new frames. FACE_NAME may be a string or
2979 a symbol (apparently Emacs 20.2 allowed strings as face names in
2980 face text properties; Ediff uses that). If FACE_NAME is an alias
2981 for another face, return that face's definition. If SIGNAL_P is
2982 non-zero, signal an error if FACE_NAME is not a valid face name.
2983 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2986 static INLINE Lisp_Object
2987 lface_from_face_name (f
, face_name
, signal_p
)
2989 Lisp_Object face_name
;
2994 face_name
= resolve_face_name (face_name
);
2997 lface
= assq_no_quit (face_name
, f
->face_alist
);
2999 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3002 lface
= XCDR (lface
);
3004 signal_error ("Invalid face", face_name
);
3006 check_lface (lface
);
3011 /* Get face attributes of face FACE_NAME from frame-local faces on
3012 frame F. Store the resulting attributes in ATTRS which must point
3013 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3014 is non-zero, signal an error if FACE_NAME does not name a face.
3015 Otherwise, value is zero if FACE_NAME is not a face. */
3018 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3020 Lisp_Object face_name
;
3027 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3030 bcopy (XVECTOR (lface
)->contents
, attrs
,
3031 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3041 /* Non-zero if all attributes in face attribute vector ATTRS are
3042 specified, i.e. are non-nil. */
3045 lface_fully_specified_p (attrs
)
3050 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3051 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3052 && i
!= LFACE_AVGWIDTH_INDEX
)
3053 if (UNSPECIFIEDP (attrs
[i
]))
3056 return i
== LFACE_VECTOR_SIZE
;
3059 #ifdef HAVE_WINDOW_SYSTEM
3061 /* Set font-related attributes of Lisp face LFACE from the fullname of
3062 the font opened by FONTNAME. If FORCE_P is zero, set only
3063 unspecified attributes of LFACE. The exception is `font'
3064 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3066 If FONTNAME is not available on frame F,
3067 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3068 If the fullname is not in a valid XLFD format,
3069 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3070 in LFACE and return 1.
3071 Otherwise, return 1. */
3074 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3077 Lisp_Object fontname
;
3078 int force_p
, may_fail_p
;
3080 struct font_name font
;
3085 char *font_name
= XSTRING (fontname
)->data
;
3086 struct font_info
*font_info
;
3088 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3089 fontset
= fs_query_fontset (fontname
, 0);
3091 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3093 /* Check if FONT_NAME is surely available on the system. Usually
3094 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3095 returns quickly. But, even if FONT_NAME is not yet cached,
3096 caching it now is not futail because we anyway load the font
3099 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3109 font
.name
= STRDUPA (font_info
->full_name
);
3110 have_xlfd_p
= split_font_name (f
, &font
, 1);
3112 /* Set attributes only if unspecified, otherwise face defaults for
3113 new frames would never take effect. If we couldn't get a font
3114 name conforming to XLFD, set normal values. */
3116 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3121 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3122 + strlen (font
.fields
[XLFD_FOUNDRY
])
3124 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3125 font
.fields
[XLFD_FAMILY
]);
3126 val
= build_string (buffer
);
3129 val
= build_string ("*");
3130 LFACE_FAMILY (lface
) = val
;
3133 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3136 pt
= xlfd_point_size (f
, &font
);
3138 pt
= pixel_point_size (f
, font_info
->height
* 10);
3140 LFACE_HEIGHT (lface
) = make_number (pt
);
3143 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3144 LFACE_SWIDTH (lface
)
3145 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3147 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3148 LFACE_AVGWIDTH (lface
)
3150 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3153 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3154 LFACE_WEIGHT (lface
)
3155 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3157 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3159 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3161 LFACE_FONT (lface
) = fontname
;
3166 #endif /* HAVE_WINDOW_SYSTEM */
3169 /* Merges the face height FROM with the face height TO, and returns the
3170 merged height. If FROM is an invalid height, then INVALID is
3171 returned instead. FROM may be a either an absolute face height or a
3172 `relative' height, and TO must be an absolute height. The returned
3173 value is always an absolute height. GCPRO is a lisp value that will
3174 be protected from garbage-collection if this function makes a call
3178 merge_face_heights (from
, to
, invalid
, gcpro
)
3179 Lisp_Object from
, to
, invalid
, gcpro
;
3183 if (INTEGERP (from
))
3184 result
= XINT (from
);
3185 else if (NUMBERP (from
))
3186 result
= XFLOATINT (from
) * XINT (to
);
3187 #if 0 /* Probably not so useful. */
3188 else if (CONSP (from
) && CONSP (XCDR (from
)))
3190 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3192 if (INTEGERP (XCAR (XCDR (from
))))
3194 int inc
= XINT (XCAR (XCDR (from
)));
3195 if (EQ (XCAR (from
), Qminus
))
3198 result
= XFASTINT (to
);
3199 if (result
+ inc
> 0)
3200 /* Note that `underflows' don't mean FROM is invalid, so
3201 we just pin the result at TO if it would otherwise be
3208 else if (FUNCTIONP (from
))
3210 /* Call function with current height as argument.
3211 From is the new height. */
3212 Lisp_Object args
[2], height
;
3213 struct gcpro gcpro1
;
3219 height
= safe_call (2, args
);
3223 if (NUMBERP (height
))
3224 result
= XFLOATINT (height
);
3228 return make_number (result
);
3234 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3235 store the resulting attributes in TO, which must be already be
3236 completely specified and contain only absolute attributes. Every
3237 specified attribute of FROM overrides the corresponding attribute of
3238 TO; relative attributes in FROM are merged with the absolute value in
3239 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3240 face inheritance; it should be Qnil when called from other places. */
3243 merge_face_vectors (f
, from
, to
, cycle_check
)
3245 Lisp_Object
*from
, *to
;
3246 Lisp_Object cycle_check
;
3250 /* If FROM inherits from some other faces, merge their attributes into
3251 TO before merging FROM's direct attributes. Note that an :inherit
3252 attribute of `unspecified' is the same as one of nil; we never
3253 merge :inherit attributes, so nil is more correct, but lots of
3254 other code uses `unspecified' as a generic value for face attributes. */
3255 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3256 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3257 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3259 /* If TO specifies a :font attribute, and FROM specifies some
3260 font-related attribute, we need to clear TO's :font attribute
3261 (because it will be inconsistent with whatever FROM specifies, and
3262 FROM takes precedence). */
3263 if (!NILP (to
[LFACE_FONT_INDEX
])
3264 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3265 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3266 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3267 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3268 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3269 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3270 to
[LFACE_FONT_INDEX
] = Qnil
;
3272 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3273 if (!UNSPECIFIEDP (from
[i
]))
3274 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3275 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3279 /* TO is always an absolute face, which should inherit from nothing.
3280 We blindly copy the :inherit attribute above and fix it up here. */
3281 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3285 /* Checks the `cycle check' variable CHECK to see if it indicates that
3286 EL is part of a cycle; CHECK must be either Qnil or a value returned
3287 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3288 elements after which a cycle might be suspected; after that many
3289 elements, this macro begins consing in order to keep more precise
3292 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3295 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3296 the caller should make sure that's ok. */
3298 #define CYCLE_CHECK(check, el, suspicious) \
3301 : (INTEGERP (check) \
3302 ? (XFASTINT (check) < (suspicious) \
3303 ? make_number (XFASTINT (check) + 1) \
3304 : Fcons (el, Qnil)) \
3305 : (!NILP (Fmemq ((el), (check))) \
3307 : Fcons ((el), (check)))))
3310 /* Merge face attributes from the face on frame F whose name is
3311 INHERITS, into the vector of face attributes TO; INHERITS may also be
3312 a list of face names, in which case they are applied in order.
3313 CYCLE_CHECK is used to detect loops in face inheritance.
3314 Returns true if any of the inherited attributes are `font-related'. */
3317 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3319 Lisp_Object inherit
;
3321 Lisp_Object cycle_check
;
3323 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3324 /* Inherit from the named face INHERIT. */
3328 /* Make sure we're not in an inheritance loop. */
3329 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3330 if (NILP (cycle_check
))
3331 /* Cycle detected, ignore any further inheritance. */
3334 lface
= lface_from_face_name (f
, inherit
, 0);
3336 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3338 else if (CONSP (inherit
))
3339 /* Handle a list of inherited faces by calling ourselves recursively
3340 on each element. Note that we only do so for symbol elements, so
3341 it's not possible to infinitely recurse. */
3343 while (CONSP (inherit
))
3345 if (SYMBOLP (XCAR (inherit
)))
3346 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3348 /* Check for a circular inheritance list. */
3349 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3350 if (NILP (cycle_check
))
3351 /* Cycle detected. */
3354 inherit
= XCDR (inherit
);
3360 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3361 is a face property, determine the resulting face attributes on
3362 frame F, and store them in TO. PROP may be a single face
3363 specification or a list of such specifications. Each face
3364 specification can be
3366 1. A symbol or string naming a Lisp face.
3368 2. A property list of the form (KEYWORD VALUE ...) where each
3369 KEYWORD is a face attribute name, and value is an appropriate value
3372 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3373 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3374 for compatibility with 20.2.
3376 Face specifications earlier in lists take precedence over later
3380 merge_face_vector_with_property (f
, to
, prop
)
3387 Lisp_Object first
= XCAR (prop
);
3389 if (EQ (first
, Qforeground_color
)
3390 || EQ (first
, Qbackground_color
))
3392 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3393 . COLOR). COLOR must be a string. */
3394 Lisp_Object color_name
= XCDR (prop
);
3395 Lisp_Object color
= first
;
3397 if (STRINGP (color_name
))
3399 if (EQ (color
, Qforeground_color
))
3400 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3402 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3405 add_to_log ("Invalid face color", color_name
, Qnil
);
3407 else if (SYMBOLP (first
)
3408 && *XSYMBOL (first
)->name
->data
== ':')
3410 /* Assume this is the property list form. */
3411 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3413 Lisp_Object keyword
= XCAR (prop
);
3414 Lisp_Object value
= XCAR (XCDR (prop
));
3416 if (EQ (keyword
, QCfamily
))
3418 if (STRINGP (value
))
3419 to
[LFACE_FAMILY_INDEX
] = value
;
3421 add_to_log ("Invalid face font family", value
, Qnil
);
3423 else if (EQ (keyword
, QCheight
))
3425 Lisp_Object new_height
=
3426 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3429 if (NILP (new_height
))
3430 add_to_log ("Invalid face font height", value
, Qnil
);
3432 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3434 else if (EQ (keyword
, QCweight
))
3437 && face_numeric_weight (value
) >= 0)
3438 to
[LFACE_WEIGHT_INDEX
] = value
;
3440 add_to_log ("Invalid face weight", value
, Qnil
);
3442 else if (EQ (keyword
, QCslant
))
3445 && face_numeric_slant (value
) >= 0)
3446 to
[LFACE_SLANT_INDEX
] = value
;
3448 add_to_log ("Invalid face slant", value
, Qnil
);
3450 else if (EQ (keyword
, QCunderline
))
3455 to
[LFACE_UNDERLINE_INDEX
] = value
;
3457 add_to_log ("Invalid face underline", value
, Qnil
);
3459 else if (EQ (keyword
, QCoverline
))
3464 to
[LFACE_OVERLINE_INDEX
] = value
;
3466 add_to_log ("Invalid face overline", value
, Qnil
);
3468 else if (EQ (keyword
, QCstrike_through
))
3473 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3475 add_to_log ("Invalid face strike-through", value
, Qnil
);
3477 else if (EQ (keyword
, QCbox
))
3480 value
= make_number (1);
3481 if (INTEGERP (value
)
3485 to
[LFACE_BOX_INDEX
] = value
;
3487 add_to_log ("Invalid face box", value
, Qnil
);
3489 else if (EQ (keyword
, QCinverse_video
)
3490 || EQ (keyword
, QCreverse_video
))
3492 if (EQ (value
, Qt
) || NILP (value
))
3493 to
[LFACE_INVERSE_INDEX
] = value
;
3495 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3497 else if (EQ (keyword
, QCforeground
))
3499 if (STRINGP (value
))
3500 to
[LFACE_FOREGROUND_INDEX
] = value
;
3502 add_to_log ("Invalid face foreground", value
, Qnil
);
3504 else if (EQ (keyword
, QCbackground
))
3506 if (STRINGP (value
))
3507 to
[LFACE_BACKGROUND_INDEX
] = value
;
3509 add_to_log ("Invalid face background", value
, Qnil
);
3511 else if (EQ (keyword
, QCstipple
))
3513 #ifdef HAVE_X_WINDOWS
3514 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3515 if (!NILP (pixmap_p
))
3516 to
[LFACE_STIPPLE_INDEX
] = value
;
3518 add_to_log ("Invalid face stipple", value
, Qnil
);
3521 else if (EQ (keyword
, QCwidth
))
3524 && face_numeric_swidth (value
) >= 0)
3525 to
[LFACE_SWIDTH_INDEX
] = value
;
3527 add_to_log ("Invalid face width", value
, Qnil
);
3529 else if (EQ (keyword
, QCinherit
))
3531 if (SYMBOLP (value
))
3532 to
[LFACE_INHERIT_INDEX
] = value
;
3536 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3537 if (!SYMBOLP (XCAR (tail
)))
3540 to
[LFACE_INHERIT_INDEX
] = value
;
3542 add_to_log ("Invalid face inherit", value
, Qnil
);
3546 add_to_log ("Invalid attribute %s in face property",
3549 prop
= XCDR (XCDR (prop
));
3554 /* This is a list of face specs. Specifications at the
3555 beginning of the list take precedence over later
3556 specifications, so we have to merge starting with the
3557 last specification. */
3558 Lisp_Object next
= XCDR (prop
);
3560 merge_face_vector_with_property (f
, to
, next
);
3561 merge_face_vector_with_property (f
, to
, first
);
3566 /* PROP ought to be a face name. */
3567 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3569 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3571 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3576 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3577 Sinternal_make_lisp_face
, 1, 2, 0,
3578 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3579 If FACE was not known as a face before, create a new one.\n\
3580 If optional argument FRAME is specified, make a frame-local face\n\
3581 for that frame. Otherwise operate on the global face definition.\n\
3582 Value is a vector of face attributes.")
3584 Lisp_Object face
, frame
;
3586 Lisp_Object global_lface
, lface
;
3590 CHECK_SYMBOL (face
, 0);
3591 global_lface
= lface_from_face_name (NULL
, face
, 0);
3595 CHECK_LIVE_FRAME (frame
, 1);
3597 lface
= lface_from_face_name (f
, face
, 0);
3600 f
= NULL
, lface
= Qnil
;
3602 /* Add a global definition if there is none. */
3603 if (NILP (global_lface
))
3605 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3607 AREF (global_lface
, 0) = Qface
;
3608 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3609 Vface_new_frame_defaults
);
3611 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3612 face id to Lisp face is given by the vector lface_id_to_name.
3613 The mapping from Lisp face to Lisp face id is given by the
3614 property `face' of the Lisp face name. */
3615 if (next_lface_id
== lface_id_to_name_size
)
3617 int new_size
= max (50, 2 * lface_id_to_name_size
);
3618 int sz
= new_size
* sizeof *lface_id_to_name
;
3619 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3620 lface_id_to_name_size
= new_size
;
3623 lface_id_to_name
[next_lface_id
] = face
;
3624 Fput (face
, Qface
, make_number (next_lface_id
));
3628 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3629 AREF (global_lface
, i
) = Qunspecified
;
3631 /* Add a frame-local definition. */
3636 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3638 AREF (lface
, 0) = Qface
;
3639 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3642 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3643 AREF (lface
, i
) = Qunspecified
;
3646 lface
= global_lface
;
3648 xassert (LFACEP (lface
));
3649 check_lface (lface
);
3654 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3655 Sinternal_lisp_face_p
, 1, 2, 0,
3656 "Return non-nil if FACE names a face.\n\
3657 If optional second parameter FRAME is non-nil, check for the\n\
3658 existence of a frame-local face with name FACE on that frame.\n\
3659 Otherwise check for the existence of a global face.")
3661 Lisp_Object face
, frame
;
3667 CHECK_LIVE_FRAME (frame
, 1);
3668 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3671 lface
= lface_from_face_name (NULL
, face
, 0);
3677 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3678 Sinternal_copy_lisp_face
, 4, 4, 0,
3679 "Copy face FROM to TO.\n\
3680 If FRAME it t, copy the global face definition of FROM to the\n\
3681 global face definition of TO. Otherwise, copy the frame-local\n\
3682 definition of FROM on FRAME to the frame-local definition of TO\n\
3683 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3686 (from
, to
, frame
, new_frame
)
3687 Lisp_Object from
, to
, frame
, new_frame
;
3689 Lisp_Object lface
, copy
;
3691 CHECK_SYMBOL (from
, 0);
3692 CHECK_SYMBOL (to
, 1);
3693 if (NILP (new_frame
))
3698 /* Copy global definition of FROM. We don't make copies of
3699 strings etc. because 20.2 didn't do it either. */
3700 lface
= lface_from_face_name (NULL
, from
, 1);
3701 copy
= Finternal_make_lisp_face (to
, Qnil
);
3705 /* Copy frame-local definition of FROM. */
3706 CHECK_LIVE_FRAME (frame
, 2);
3707 CHECK_LIVE_FRAME (new_frame
, 3);
3708 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3709 copy
= Finternal_make_lisp_face (to
, new_frame
);
3712 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3713 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3719 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3720 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3721 "Set attribute ATTR of FACE to VALUE.\n\
3722 FRAME being a frame means change the face on that frame.\n\
3723 FRAME nil means change change the face of the selected frame.\n\
3724 FRAME t means change the default for new frames.\n\
3725 FRAME 0 means change the face on all frames, and change the default\n\
3727 (face
, attr
, value
, frame
)
3728 Lisp_Object face
, attr
, value
, frame
;
3731 Lisp_Object old_value
= Qnil
;
3732 /* Set 1 if ATTR is QCfont. */
3733 int font_attr_p
= 0;
3734 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3735 int font_related_attr_p
= 0;
3737 CHECK_SYMBOL (face
, 0);
3738 CHECK_SYMBOL (attr
, 1);
3740 face
= resolve_face_name (face
);
3742 /* If FRAME is 0, change face on all frames, and change the
3743 default for new frames. */
3744 if (INTEGERP (frame
) && XINT (frame
) == 0)
3747 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3748 FOR_EACH_FRAME (tail
, frame
)
3749 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3753 /* Set lface to the Lisp attribute vector of FACE. */
3755 lface
= lface_from_face_name (NULL
, face
, 1);
3759 frame
= selected_frame
;
3761 CHECK_LIVE_FRAME (frame
, 3);
3762 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3764 /* If a frame-local face doesn't exist yet, create one. */
3766 lface
= Finternal_make_lisp_face (face
, frame
);
3769 if (EQ (attr
, QCfamily
))
3771 if (!UNSPECIFIEDP (value
))
3773 CHECK_STRING (value
, 3);
3774 if (XSTRING (value
)->size
== 0)
3775 signal_error ("Invalid face family", value
);
3777 old_value
= LFACE_FAMILY (lface
);
3778 LFACE_FAMILY (lface
) = value
;
3779 font_related_attr_p
= 1;
3781 else if (EQ (attr
, QCheight
))
3783 if (!UNSPECIFIEDP (value
))
3786 (EQ (face
, Qdefault
) ? value
:
3787 /* The default face must have an absolute size, otherwise, we do
3788 a test merge with a random height to see if VALUE's ok. */
3789 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3791 if (!INTEGERP(test
) || XINT(test
) <= 0)
3792 signal_error ("Invalid face height", value
);
3795 old_value
= LFACE_HEIGHT (lface
);
3796 LFACE_HEIGHT (lface
) = value
;
3797 font_related_attr_p
= 1;
3799 else if (EQ (attr
, QCweight
))
3801 if (!UNSPECIFIEDP (value
))
3803 CHECK_SYMBOL (value
, 3);
3804 if (face_numeric_weight (value
) < 0)
3805 signal_error ("Invalid face weight", value
);
3807 old_value
= LFACE_WEIGHT (lface
);
3808 LFACE_WEIGHT (lface
) = value
;
3809 font_related_attr_p
= 1;
3811 else if (EQ (attr
, QCslant
))
3813 if (!UNSPECIFIEDP (value
))
3815 CHECK_SYMBOL (value
, 3);
3816 if (face_numeric_slant (value
) < 0)
3817 signal_error ("Invalid face slant", value
);
3819 old_value
= LFACE_SLANT (lface
);
3820 LFACE_SLANT (lface
) = value
;
3821 font_related_attr_p
= 1;
3823 else if (EQ (attr
, QCunderline
))
3825 if (!UNSPECIFIEDP (value
))
3826 if ((SYMBOLP (value
)
3828 && !EQ (value
, Qnil
))
3829 /* Underline color. */
3831 && XSTRING (value
)->size
== 0))
3832 signal_error ("Invalid face underline", value
);
3834 old_value
= LFACE_UNDERLINE (lface
);
3835 LFACE_UNDERLINE (lface
) = value
;
3837 else if (EQ (attr
, QCoverline
))
3839 if (!UNSPECIFIEDP (value
))
3840 if ((SYMBOLP (value
)
3842 && !EQ (value
, Qnil
))
3843 /* Overline color. */
3845 && XSTRING (value
)->size
== 0))
3846 signal_error ("Invalid face overline", value
);
3848 old_value
= LFACE_OVERLINE (lface
);
3849 LFACE_OVERLINE (lface
) = value
;
3851 else if (EQ (attr
, QCstrike_through
))
3853 if (!UNSPECIFIEDP (value
))
3854 if ((SYMBOLP (value
)
3856 && !EQ (value
, Qnil
))
3857 /* Strike-through color. */
3859 && XSTRING (value
)->size
== 0))
3860 signal_error ("Invalid face strike-through", value
);
3862 old_value
= LFACE_STRIKE_THROUGH (lface
);
3863 LFACE_STRIKE_THROUGH (lface
) = value
;
3865 else if (EQ (attr
, QCbox
))
3869 /* Allow t meaning a simple box of width 1 in foreground color
3872 value
= make_number (1);
3874 if (UNSPECIFIEDP (value
))
3876 else if (NILP (value
))
3878 else if (INTEGERP (value
))
3879 valid_p
= XINT (value
) != 0;
3880 else if (STRINGP (value
))
3881 valid_p
= XSTRING (value
)->size
> 0;
3882 else if (CONSP (value
))
3898 if (EQ (k
, QCline_width
))
3900 if (!INTEGERP (v
) || XINT (v
) == 0)
3903 else if (EQ (k
, QCcolor
))
3905 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3908 else if (EQ (k
, QCstyle
))
3910 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3917 valid_p
= NILP (tem
);
3923 signal_error ("Invalid face box", value
);
3925 old_value
= LFACE_BOX (lface
);
3926 LFACE_BOX (lface
) = value
;
3928 else if (EQ (attr
, QCinverse_video
)
3929 || EQ (attr
, QCreverse_video
))
3931 if (!UNSPECIFIEDP (value
))
3933 CHECK_SYMBOL (value
, 3);
3934 if (!EQ (value
, Qt
) && !NILP (value
))
3935 signal_error ("Invalid inverse-video face attribute value", value
);
3937 old_value
= LFACE_INVERSE (lface
);
3938 LFACE_INVERSE (lface
) = value
;
3940 else if (EQ (attr
, QCforeground
))
3942 if (!UNSPECIFIEDP (value
))
3944 /* Don't check for valid color names here because it depends
3945 on the frame (display) whether the color will be valid
3946 when the face is realized. */
3947 CHECK_STRING (value
, 3);
3948 if (XSTRING (value
)->size
== 0)
3949 signal_error ("Empty foreground color value", value
);
3951 old_value
= LFACE_FOREGROUND (lface
);
3952 LFACE_FOREGROUND (lface
) = value
;
3954 else if (EQ (attr
, QCbackground
))
3956 if (!UNSPECIFIEDP (value
))
3958 /* Don't check for valid color names here because it depends
3959 on the frame (display) whether the color will be valid
3960 when the face is realized. */
3961 CHECK_STRING (value
, 3);
3962 if (XSTRING (value
)->size
== 0)
3963 signal_error ("Empty background color value", value
);
3965 old_value
= LFACE_BACKGROUND (lface
);
3966 LFACE_BACKGROUND (lface
) = value
;
3968 else if (EQ (attr
, QCstipple
))
3970 #ifdef HAVE_X_WINDOWS
3971 if (!UNSPECIFIEDP (value
)
3973 && NILP (Fbitmap_spec_p (value
)))
3974 signal_error ("Invalid stipple attribute", value
);
3975 old_value
= LFACE_STIPPLE (lface
);
3976 LFACE_STIPPLE (lface
) = value
;
3977 #endif /* HAVE_X_WINDOWS */
3979 else if (EQ (attr
, QCwidth
))
3981 if (!UNSPECIFIEDP (value
))
3983 CHECK_SYMBOL (value
, 3);
3984 if (face_numeric_swidth (value
) < 0)
3985 signal_error ("Invalid face width", value
);
3987 old_value
= LFACE_SWIDTH (lface
);
3988 LFACE_SWIDTH (lface
) = value
;
3989 font_related_attr_p
= 1;
3991 else if (EQ (attr
, QCfont
))
3993 #ifdef HAVE_WINDOW_SYSTEM
3994 /* Set font-related attributes of the Lisp face from an
3999 CHECK_STRING (value
, 3);
4001 f
= SELECTED_FRAME ();
4003 f
= check_x_frame (frame
);
4005 /* VALUE may be a fontset name or an alias of fontset. In such
4006 a case, use the base fontset name. */
4007 tmp
= Fquery_fontset (value
, Qnil
);
4011 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4012 signal_error ("Invalid font or fontset name", value
);
4015 #endif /* HAVE_WINDOW_SYSTEM */
4017 else if (EQ (attr
, QCinherit
))
4020 if (SYMBOLP (value
))
4023 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4024 if (!SYMBOLP (XCAR (tail
)))
4027 LFACE_INHERIT (lface
) = value
;
4029 signal_error ("Invalid face inheritance", value
);
4031 else if (EQ (attr
, QCbold
))
4033 old_value
= LFACE_WEIGHT (lface
);
4034 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4035 font_related_attr_p
= 1;
4037 else if (EQ (attr
, QCitalic
))
4039 old_value
= LFACE_SLANT (lface
);
4040 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4041 font_related_attr_p
= 1;
4044 signal_error ("Invalid face attribute name", attr
);
4046 if (font_related_attr_p
4047 && !UNSPECIFIEDP (value
))
4048 /* If a font-related attribute other than QCfont is specified, the
4049 original `font' attribute nor that of default face is useless
4050 to determine a new font. Thus, we set it to nil so that font
4051 selection mechanism doesn't use it. */
4052 LFACE_FONT (lface
) = Qnil
;
4054 /* Changing a named face means that all realized faces depending on
4055 that face are invalid. Since we cannot tell which realized faces
4056 depend on the face, make sure they are all removed. This is done
4057 by incrementing face_change_count. The next call to
4058 init_iterator will then free realized faces. */
4060 && (EQ (attr
, QCfont
)
4061 || NILP (Fequal (old_value
, value
))))
4063 ++face_change_count
;
4064 ++windows_or_buffers_changed
;
4067 if (!UNSPECIFIEDP (value
)
4068 && NILP (Fequal (old_value
, value
)))
4074 if (EQ (face
, Qdefault
))
4076 #ifdef HAVE_WINDOW_SYSTEM
4077 /* Changed font-related attributes of the `default' face are
4078 reflected in changed `font' frame parameters. */
4079 if ((font_related_attr_p
|| font_attr_p
)
4080 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4081 set_font_frame_param (frame
, lface
);
4083 #endif /* HAVE_WINDOW_SYSTEM */
4085 if (EQ (attr
, QCforeground
))
4086 param
= Qforeground_color
;
4087 else if (EQ (attr
, QCbackground
))
4088 param
= Qbackground_color
;
4090 #ifdef HAVE_WINDOW_SYSTEM
4092 else if (EQ (face
, Qscroll_bar
))
4094 /* Changing the colors of `scroll-bar' sets frame parameters
4095 `scroll-bar-foreground' and `scroll-bar-background'. */
4096 if (EQ (attr
, QCforeground
))
4097 param
= Qscroll_bar_foreground
;
4098 else if (EQ (attr
, QCbackground
))
4099 param
= Qscroll_bar_background
;
4101 #endif /* not WINDOWSNT */
4102 else if (EQ (face
, Qborder
))
4104 /* Changing background color of `border' sets frame parameter
4106 if (EQ (attr
, QCbackground
))
4107 param
= Qborder_color
;
4109 else if (EQ (face
, Qcursor
))
4111 /* Changing background color of `cursor' sets frame parameter
4113 if (EQ (attr
, QCbackground
))
4114 param
= Qcursor_color
;
4116 else if (EQ (face
, Qmouse
))
4118 /* Changing background color of `mouse' sets frame parameter
4120 if (EQ (attr
, QCbackground
))
4121 param
= Qmouse_color
;
4123 #endif /* HAVE_WINDOW_SYSTEM */
4124 else if (EQ (face
, Qmenu
))
4125 ++menu_face_change_count
;
4129 /* Update `default-frame-alist', which is used for new frames. */
4131 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4134 /* Update the current frame's parameters. */
4137 cons
= XCAR (Vparam_value_alist
);
4138 XCAR (cons
) = param
;
4139 XCDR (cons
) = value
;
4140 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4148 #ifdef HAVE_WINDOW_SYSTEM
4150 /* Set the `font' frame parameter of FRAME determined from `default'
4151 face attributes LFACE. If a face or fontset name is explicitely
4152 specfied in LFACE, use it as is. Otherwise, determine a font name
4153 from the other font-related atrributes of LFACE. In that case, if
4154 there's no matching font, signals an error. */
4157 set_font_frame_param (frame
, lface
)
4158 Lisp_Object frame
, lface
;
4160 struct frame
*f
= XFRAME (frame
);
4162 if (FRAME_WINDOW_P (f
))
4164 Lisp_Object font_name
;
4167 if (STRINGP (LFACE_FONT (lface
)))
4168 font_name
= LFACE_FONT (lface
);
4171 /* Choose a font name that reflects LFACE's attributes and has
4172 the registry and encoding pattern specified in the default
4173 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4174 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4176 error ("No font matches the specified attribute");
4177 font_name
= build_string (font
);
4181 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4186 /* Update the corresponding face when frame parameter PARAM on frame F
4187 has been assigned the value NEW_VALUE. */
4190 update_face_from_frame_parameter (f
, param
, new_value
)
4192 Lisp_Object param
, new_value
;
4196 /* If there are no faces yet, give up. This is the case when called
4197 from Fx_create_frame, and we do the necessary things later in
4198 face-set-after-frame-defaults. */
4199 if (NILP (f
->face_alist
))
4202 if (EQ (param
, Qforeground_color
))
4204 lface
= lface_from_face_name (f
, Qdefault
, 1);
4205 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4206 ? new_value
: Qunspecified
);
4207 realize_basic_faces (f
);
4209 else if (EQ (param
, Qbackground_color
))
4213 /* Changing the background color might change the background
4214 mode, so that we have to load new defface specs. Call
4215 frame-update-face-colors to do that. */
4216 XSETFRAME (frame
, f
);
4217 call1 (Qframe_update_face_colors
, frame
);
4219 lface
= lface_from_face_name (f
, Qdefault
, 1);
4220 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4221 ? new_value
: Qunspecified
);
4222 realize_basic_faces (f
);
4224 if (EQ (param
, Qborder_color
))
4226 lface
= lface_from_face_name (f
, Qborder
, 1);
4227 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4228 ? new_value
: Qunspecified
);
4230 else if (EQ (param
, Qcursor_color
))
4232 lface
= lface_from_face_name (f
, Qcursor
, 1);
4233 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4234 ? new_value
: Qunspecified
);
4236 else if (EQ (param
, Qmouse_color
))
4238 lface
= lface_from_face_name (f
, Qmouse
, 1);
4239 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4240 ? new_value
: Qunspecified
);
4245 /* Get the value of X resource RESOURCE, class CLASS for the display
4246 of frame FRAME. This is here because ordinary `x-get-resource'
4247 doesn't take a frame argument. */
4249 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4250 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4251 (resource
, class, frame
)
4252 Lisp_Object resource
, class, frame
;
4254 Lisp_Object value
= Qnil
;
4257 CHECK_STRING (resource
, 0);
4258 CHECK_STRING (class, 1);
4259 CHECK_LIVE_FRAME (frame
, 2);
4261 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4262 resource
, class, Qnil
, Qnil
);
4264 #endif /* not macintosh */
4265 #endif /* not WINDOWSNT */
4270 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4271 If VALUE is "on" or "true", return t. If VALUE is "off" or
4272 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4273 error; if SIGNAL_P is zero, return 0. */
4276 face_boolean_x_resource_value (value
, signal_p
)
4280 Lisp_Object result
= make_number (0);
4282 xassert (STRINGP (value
));
4284 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4285 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4287 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4288 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4290 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4291 result
= Qunspecified
;
4293 signal_error ("Invalid face attribute value from X resource", value
);
4299 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4300 Finternal_set_lisp_face_attribute_from_resource
,
4301 Sinternal_set_lisp_face_attribute_from_resource
,
4303 (face
, attr
, value
, frame
)
4304 Lisp_Object face
, attr
, value
, frame
;
4306 CHECK_SYMBOL (face
, 0);
4307 CHECK_SYMBOL (attr
, 1);
4308 CHECK_STRING (value
, 2);
4310 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4311 value
= Qunspecified
;
4312 else if (EQ (attr
, QCheight
))
4314 value
= Fstring_to_number (value
, make_number (10));
4315 if (XINT (value
) <= 0)
4316 signal_error ("Invalid face height from X resource", value
);
4318 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4319 value
= face_boolean_x_resource_value (value
, 1);
4320 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4321 value
= intern (XSTRING (value
)->data
);
4322 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4323 value
= face_boolean_x_resource_value (value
, 1);
4324 else if (EQ (attr
, QCunderline
)
4325 || EQ (attr
, QCoverline
)
4326 || EQ (attr
, QCstrike_through
)
4327 || EQ (attr
, QCbox
))
4329 Lisp_Object boolean_value
;
4331 /* If the result of face_boolean_x_resource_value is t or nil,
4332 VALUE does NOT specify a color. */
4333 boolean_value
= face_boolean_x_resource_value (value
, 0);
4334 if (SYMBOLP (boolean_value
))
4335 value
= boolean_value
;
4338 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4341 #endif /* HAVE_WINDOW_SYSTEM */
4344 #ifdef HAVE_X_WINDOWS
4345 /***********************************************************************
4347 ***********************************************************************/
4349 #ifdef USE_X_TOOLKIT
4351 #include "../lwlib/lwlib-utils.h"
4353 /* Structure used to pass X resources to functions called via
4354 XtApplyToWidgets. */
4365 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4366 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4369 /* Set widget W's X resources from P which points to an x_resources
4370 structure. If W is a cascade button, apply resources to W's
4374 xm_apply_resources (w
, p
)
4379 struct x_resources
*res
= (struct x_resources
*) p
;
4381 XtSetValues (w
, res
->av
, res
->ac
);
4382 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4385 XtSetValues (submenu
, res
->av
, res
->ac
);
4386 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4391 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4392 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4395 1. Setting the XmNfontList resource leads to an infinite loop
4396 somewhere in LessTif. */
4399 xm_set_menu_resources_from_menu_face (f
, widget
)
4409 lface
= lface_from_face_name (f
, Qmenu
, 1);
4410 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4412 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4414 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4418 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4420 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4424 /* If any font-related attribute of `menu' is set, set the font. */
4426 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4427 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4428 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4429 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4430 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4431 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4433 #if 0 /* Setting the font leads to an infinite loop somewhere
4434 in LessTif during geometry computation. */
4436 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4437 fl
= XmFontListAppendEntry (NULL
, fe
);
4438 XtSetArg (av
[ac
], XmNfontList
, fl
);
4443 xassert (ac
<= sizeof av
/ sizeof *av
);
4447 struct x_resources res
;
4449 XtSetValues (widget
, av
, ac
);
4450 res
.av
= av
, res
.ac
= ac
;
4451 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4453 XmFontListFree (fl
);
4457 #endif /* USE_MOTIF */
4461 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4462 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4465 /* Set widget W's resources from P which points to an x_resources
4469 xl_apply_resources (widget
, p
)
4473 struct x_resources
*res
= (struct x_resources
*) p
;
4474 XtSetValues (widget
, res
->av
, res
->ac
);
4478 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4479 This is the Lucid version. */
4482 xl_set_menu_resources_from_menu_face (f
, widget
)
4491 lface
= lface_from_face_name (f
, Qmenu
, 1);
4492 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4494 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4496 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4500 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4502 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4507 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4508 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4509 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4510 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4511 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4512 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4514 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4520 struct x_resources res
;
4522 XtSetValues (widget
, av
, ac
);
4524 /* We must do children here in case we're handling a pop-up menu
4525 in which case WIDGET is a popup shell. XtApplyToWidgets
4526 is a function from lwlib. */
4527 res
.av
= av
, res
.ac
= ac
;
4528 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4532 #endif /* USE_LUCID */
4535 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4538 x_set_menu_resources_from_menu_face (f
, widget
)
4542 /* Realized faces may have been removed on frame F, e.g. because of
4543 face attribute changes. Recompute them, if necessary, since we
4544 will need the `menu' face. */
4545 if (f
->face_cache
->used
== 0)
4546 recompute_basic_faces (f
);
4550 xl_set_menu_resources_from_menu_face (f
, widget
);
4553 xm_set_menu_resources_from_menu_face (f
, widget
);
4558 #endif /* USE_X_TOOLKIT */
4560 #endif /* HAVE_X_WINDOWS */
4564 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4565 Sinternal_get_lisp_face_attribute
,
4567 "Return face attribute KEYWORD of face SYMBOL.\n\
4568 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4569 face attribute name, signal an error.\n\
4570 If the optional argument FRAME is given, report on face FACE in that\n\
4571 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4572 frames). If FRAME is omitted or nil, use the selected frame.")
4573 (symbol
, keyword
, frame
)
4574 Lisp_Object symbol
, keyword
, frame
;
4576 Lisp_Object lface
, value
= Qnil
;
4578 CHECK_SYMBOL (symbol
, 0);
4579 CHECK_SYMBOL (keyword
, 1);
4582 lface
= lface_from_face_name (NULL
, symbol
, 1);
4586 frame
= selected_frame
;
4587 CHECK_LIVE_FRAME (frame
, 2);
4588 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4591 if (EQ (keyword
, QCfamily
))
4592 value
= LFACE_FAMILY (lface
);
4593 else if (EQ (keyword
, QCheight
))
4594 value
= LFACE_HEIGHT (lface
);
4595 else if (EQ (keyword
, QCweight
))
4596 value
= LFACE_WEIGHT (lface
);
4597 else if (EQ (keyword
, QCslant
))
4598 value
= LFACE_SLANT (lface
);
4599 else if (EQ (keyword
, QCunderline
))
4600 value
= LFACE_UNDERLINE (lface
);
4601 else if (EQ (keyword
, QCoverline
))
4602 value
= LFACE_OVERLINE (lface
);
4603 else if (EQ (keyword
, QCstrike_through
))
4604 value
= LFACE_STRIKE_THROUGH (lface
);
4605 else if (EQ (keyword
, QCbox
))
4606 value
= LFACE_BOX (lface
);
4607 else if (EQ (keyword
, QCinverse_video
)
4608 || EQ (keyword
, QCreverse_video
))
4609 value
= LFACE_INVERSE (lface
);
4610 else if (EQ (keyword
, QCforeground
))
4611 value
= LFACE_FOREGROUND (lface
);
4612 else if (EQ (keyword
, QCbackground
))
4613 value
= LFACE_BACKGROUND (lface
);
4614 else if (EQ (keyword
, QCstipple
))
4615 value
= LFACE_STIPPLE (lface
);
4616 else if (EQ (keyword
, QCwidth
))
4617 value
= LFACE_SWIDTH (lface
);
4618 else if (EQ (keyword
, QCinherit
))
4619 value
= LFACE_INHERIT (lface
);
4620 else if (EQ (keyword
, QCfont
))
4621 value
= LFACE_FONT (lface
);
4623 signal_error ("Invalid face attribute name", keyword
);
4629 DEFUN ("internal-lisp-face-attribute-values",
4630 Finternal_lisp_face_attribute_values
,
4631 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4632 "Return a list of valid discrete values for face attribute ATTR.\n\
4633 Value is nil if ATTR doesn't have a discrete set of valid values.")
4637 Lisp_Object result
= Qnil
;
4639 CHECK_SYMBOL (attr
, 0);
4641 if (EQ (attr
, QCweight
)
4642 || EQ (attr
, QCslant
)
4643 || EQ (attr
, QCwidth
))
4645 /* Extract permissible symbols from tables. */
4646 struct table_entry
*table
;
4649 if (EQ (attr
, QCweight
))
4650 table
= weight_table
, dim
= DIM (weight_table
);
4651 else if (EQ (attr
, QCslant
))
4652 table
= slant_table
, dim
= DIM (slant_table
);
4654 table
= swidth_table
, dim
= DIM (swidth_table
);
4656 for (i
= 0; i
< dim
; ++i
)
4658 Lisp_Object symbol
= *table
[i
].symbol
;
4659 Lisp_Object tail
= result
;
4662 && !EQ (XCAR (tail
), symbol
))
4666 result
= Fcons (symbol
, result
);
4669 else if (EQ (attr
, QCunderline
))
4670 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4671 else if (EQ (attr
, QCoverline
))
4672 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4673 else if (EQ (attr
, QCstrike_through
))
4674 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4675 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4676 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4682 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4683 Sinternal_merge_in_global_face
, 2, 2, 0,
4684 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4685 Default face attributes override any local face attributes.")
4687 Lisp_Object face
, frame
;
4690 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4692 CHECK_LIVE_FRAME (frame
, 1);
4693 global_lface
= lface_from_face_name (NULL
, face
, 1);
4694 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4695 if (NILP (local_lface
))
4696 local_lface
= Finternal_make_lisp_face (face
, frame
);
4698 /* Make every specified global attribute override the local one.
4699 BEWARE!! This is only used from `face-set-after-frame-default' where
4700 the local frame is defined from default specs in `face-defface-spec'
4701 and those should be overridden by global settings. Hence the strange
4702 "global before local" priority. */
4703 lvec
= XVECTOR (local_lface
)->contents
;
4704 gvec
= XVECTOR (global_lface
)->contents
;
4705 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4706 if (! UNSPECIFIEDP (gvec
[i
]))
4713 /* The following function is implemented for compatibility with 20.2.
4714 The function is used in x-resolve-fonts when it is asked to
4715 return fonts with the same size as the font of a face. This is
4716 done in fontset.el. */
4718 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4719 "Return the font name of face FACE, or nil if it is unspecified.\n\
4720 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4721 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4722 The font default for a face is either nil, or a list\n\
4723 of the form (bold), (italic) or (bold italic).\n\
4724 If FRAME is omitted or nil, use the selected frame.")
4726 Lisp_Object face
, frame
;
4730 Lisp_Object result
= Qnil
;
4731 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4733 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4734 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4735 result
= Fcons (Qbold
, result
);
4737 if (!NILP (LFACE_SLANT (lface
))
4738 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4739 result
= Fcons (Qitalic
, result
);
4745 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4746 int face_id
= lookup_named_face (f
, face
, 0);
4747 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4748 return face
? build_string (face
->font_name
) : Qnil
;
4753 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4754 all attributes are `equal'. Tries to be fast because this function
4755 is called quite often. */
4758 lface_equal_p (v1
, v2
)
4759 Lisp_Object
*v1
, *v2
;
4763 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4765 Lisp_Object a
= v1
[i
];
4766 Lisp_Object b
= v2
[i
];
4768 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4769 and the other is specified. */
4770 equal_p
= XTYPE (a
) == XTYPE (b
);
4779 equal_p
= ((STRING_BYTES (XSTRING (a
))
4780 == STRING_BYTES (XSTRING (b
)))
4781 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4782 STRING_BYTES (XSTRING (a
))) == 0);
4791 equal_p
= !NILP (Fequal (a
, b
));
4801 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4802 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4803 "True if FACE1 and FACE2 are equal.\n\
4804 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4805 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4806 If FRAME is omitted or nil, use the selected frame.")
4807 (face1
, face2
, frame
)
4808 Lisp_Object face1
, face2
, frame
;
4812 Lisp_Object lface1
, lface2
;
4817 /* Don't use check_x_frame here because this function is called
4818 before X frames exist. At that time, if FRAME is nil,
4819 selected_frame will be used which is the frame dumped with
4820 Emacs. That frame is not an X frame. */
4821 f
= frame_or_selected_frame (frame
, 2);
4823 lface1
= lface_from_face_name (NULL
, face1
, 1);
4824 lface2
= lface_from_face_name (NULL
, face2
, 1);
4825 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4826 XVECTOR (lface2
)->contents
);
4827 return equal_p
? Qt
: Qnil
;
4831 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4832 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4833 "True if FACE has no attribute specified.\n\
4834 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4835 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4836 If FRAME is omitted or nil, use the selected frame.")
4838 Lisp_Object face
, frame
;
4845 frame
= selected_frame
;
4846 CHECK_LIVE_FRAME (frame
, 0);
4850 lface
= lface_from_face_name (NULL
, face
, 1);
4852 lface
= lface_from_face_name (f
, face
, 1);
4854 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4855 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4858 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4862 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4864 "Return an alist of frame-local faces defined on FRAME.\n\
4865 For internal use only.")
4869 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4870 return f
->face_alist
;
4874 /* Return a hash code for Lisp string STRING with case ignored. Used
4875 below in computing a hash value for a Lisp face. */
4877 static INLINE
unsigned
4878 hash_string_case_insensitive (string
)
4883 xassert (STRINGP (string
));
4884 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4885 hash
= (hash
<< 1) ^ tolower (*s
);
4890 /* Return a hash code for face attribute vector V. */
4892 static INLINE
unsigned
4896 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4897 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4898 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4899 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4900 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4901 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4902 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4906 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4907 considering charsets/registries). They do if they specify the same
4908 family, point size, weight, width, slant, and fontset. Both LFACE1
4909 and LFACE2 must be fully-specified. */
4912 lface_same_font_attributes_p (lface1
, lface2
)
4913 Lisp_Object
*lface1
, *lface2
;
4915 xassert (lface_fully_specified_p (lface1
)
4916 && lface_fully_specified_p (lface2
));
4917 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4918 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4919 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4920 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4921 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4922 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4923 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4924 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4925 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4926 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4927 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4928 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4933 /***********************************************************************
4935 ***********************************************************************/
4937 /* Allocate and return a new realized face for Lisp face attribute
4940 static struct face
*
4941 make_realized_face (attr
)
4944 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4945 bzero (face
, sizeof *face
);
4946 face
->ascii_face
= face
;
4947 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4952 /* Free realized face FACE, including its X resources. FACE may
4956 free_realized_face (f
, face
)
4962 #ifdef HAVE_WINDOW_SYSTEM
4963 if (FRAME_WINDOW_P (f
))
4965 /* Free fontset of FACE if it is ASCII face. */
4966 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4967 free_face_fontset (f
, face
);
4970 x_free_gc (f
, face
->gc
);
4974 free_face_colors (f
, face
);
4975 x_destroy_bitmap (f
, face
->stipple
);
4977 #endif /* HAVE_WINDOW_SYSTEM */
4984 /* Prepare face FACE for subsequent display on frame F. This
4985 allocated GCs if they haven't been allocated yet or have been freed
4986 by clearing the face cache. */
4989 prepare_face_for_display (f
, face
)
4993 #ifdef HAVE_WINDOW_SYSTEM
4994 xassert (FRAME_WINDOW_P (f
));
4999 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5001 xgcv
.foreground
= face
->foreground
;
5002 xgcv
.background
= face
->background
;
5003 #ifdef HAVE_X_WINDOWS
5004 xgcv
.graphics_exposures
= False
;
5006 /* The font of FACE may be null if we couldn't load it. */
5009 #ifdef HAVE_X_WINDOWS
5010 xgcv
.font
= face
->font
->fid
;
5013 xgcv
.font
= face
->font
;
5016 xgcv
.font
= face
->font
;
5022 #ifdef HAVE_X_WINDOWS
5025 xgcv
.fill_style
= FillOpaqueStippled
;
5026 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5027 mask
|= GCFillStyle
| GCStipple
;
5030 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5033 #endif /* HAVE_WINDOW_SYSTEM */
5037 /***********************************************************************
5039 ***********************************************************************/
5041 /* Return a new face cache for frame F. */
5043 static struct face_cache
*
5047 struct face_cache
*c
;
5050 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5051 bzero (c
, sizeof *c
);
5052 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5053 c
->buckets
= (struct face
**) xmalloc (size
);
5054 bzero (c
->buckets
, size
);
5056 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5062 /* Clear out all graphics contexts for all realized faces, except for
5063 the basic faces. This should be done from time to time just to avoid
5064 keeping too many graphics contexts that are no longer needed. */
5068 struct face_cache
*c
;
5070 if (c
&& FRAME_WINDOW_P (c
->f
))
5072 #ifdef HAVE_WINDOW_SYSTEM
5074 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5076 struct face
*face
= c
->faces_by_id
[i
];
5077 if (face
&& face
->gc
)
5079 x_free_gc (c
->f
, face
->gc
);
5083 #endif /* HAVE_WINDOW_SYSTEM */
5088 /* Free all realized faces in face cache C, including basic faces. C
5089 may be null. If faces are freed, make sure the frame's current
5090 matrix is marked invalid, so that a display caused by an expose
5091 event doesn't try to use faces we destroyed. */
5094 free_realized_faces (c
)
5095 struct face_cache
*c
;
5100 struct frame
*f
= c
->f
;
5102 /* We must block input here because we can't process X events
5103 safely while only some faces are freed, or when the frame's
5104 current matrix still references freed faces. */
5107 for (i
= 0; i
< c
->used
; ++i
)
5109 free_realized_face (f
, c
->faces_by_id
[i
]);
5110 c
->faces_by_id
[i
] = NULL
;
5114 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5115 bzero (c
->buckets
, size
);
5117 /* Must do a thorough redisplay the next time. Mark current
5118 matrices as invalid because they will reference faces freed
5119 above. This function is also called when a frame is
5120 destroyed. In this case, the root window of F is nil. */
5121 if (WINDOWP (f
->root_window
))
5123 clear_current_matrices (f
);
5124 ++windows_or_buffers_changed
;
5132 /* Free all faces realized for multibyte characters on frame F that
5136 free_realized_multibyte_face (f
, fontset
)
5140 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5144 /* We must block input here because we can't process X events safely
5145 while only some faces are freed, or when the frame's current
5146 matrix still references freed faces. */
5149 for (i
= 0; i
< cache
->used
; i
++)
5151 face
= cache
->faces_by_id
[i
];
5153 && face
!= face
->ascii_face
5154 && face
->fontset
== fontset
)
5156 uncache_face (cache
, face
);
5157 free_realized_face (f
, face
);
5161 /* Must do a thorough redisplay the next time. Mark current
5162 matrices as invalid because they will reference faces freed
5163 above. This function is also called when a frame is destroyed.
5164 In this case, the root window of F is nil. */
5165 if (WINDOWP (f
->root_window
))
5167 clear_current_matrices (f
);
5168 ++windows_or_buffers_changed
;
5175 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5176 This is done after attributes of a named face have been changed,
5177 because we can't tell which realized faces depend on that face. */
5180 free_all_realized_faces (frame
)
5186 FOR_EACH_FRAME (rest
, frame
)
5187 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5190 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5194 /* Free face cache C and faces in it, including their X resources. */
5198 struct face_cache
*c
;
5202 free_realized_faces (c
);
5204 xfree (c
->faces_by_id
);
5210 /* Cache realized face FACE in face cache C. HASH is the hash value
5211 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5212 collision list of the face hash table of C. This is done because
5213 otherwise lookup_face would find FACE for every character, even if
5214 faces with the same attributes but for specific characters exist. */
5217 cache_face (c
, face
, hash
)
5218 struct face_cache
*c
;
5222 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5226 if (face
->fontset
>= 0)
5228 struct face
*last
= c
->buckets
[i
];
5239 c
->buckets
[i
] = face
;
5240 face
->prev
= face
->next
= NULL
;
5246 face
->next
= c
->buckets
[i
];
5248 face
->next
->prev
= face
;
5249 c
->buckets
[i
] = face
;
5252 /* Find a free slot in C->faces_by_id and use the index of the free
5253 slot as FACE->id. */
5254 for (i
= 0; i
< c
->used
; ++i
)
5255 if (c
->faces_by_id
[i
] == NULL
)
5259 /* Maybe enlarge C->faces_by_id. */
5260 if (i
== c
->used
&& c
->used
== c
->size
)
5262 int new_size
= 2 * c
->size
;
5263 int sz
= new_size
* sizeof *c
->faces_by_id
;
5264 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5269 /* Check that FACE got a unique id. */
5274 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5275 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5281 #endif /* GLYPH_DEBUG */
5283 c
->faces_by_id
[i
] = face
;
5289 /* Remove face FACE from cache C. */
5292 uncache_face (c
, face
)
5293 struct face_cache
*c
;
5296 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5299 face
->prev
->next
= face
->next
;
5301 c
->buckets
[i
] = face
->next
;
5304 face
->next
->prev
= face
->prev
;
5306 c
->faces_by_id
[face
->id
] = NULL
;
5307 if (face
->id
== c
->used
)
5312 /* Look up a realized face with face attributes ATTR in the face cache
5313 of frame F. The face will be used to display character C. Value
5314 is the ID of the face found. If no suitable face is found, realize
5315 a new one. In that case, if C is a multibyte character, BASE_FACE
5316 is a face that has the same attributes. */
5319 lookup_face (f
, attr
, c
, base_face
)
5323 struct face
*base_face
;
5325 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5330 xassert (cache
!= NULL
);
5331 check_lface_attrs (attr
);
5333 /* Look up ATTR in the face cache. */
5334 hash
= lface_hash (attr
);
5335 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5337 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5338 if (face
->hash
== hash
5339 && (!FRAME_WINDOW_P (f
)
5340 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5341 && lface_equal_p (face
->lface
, attr
))
5344 /* If not found, realize a new face. */
5346 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5349 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5351 /* When this function is called from face_for_char (in this case, C is
5352 a multibyte character), a fontset of a face returned by
5353 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5354 C) is not sutisfied. The fontset is set for this face by
5355 face_for_char later. */
5357 if (FRAME_WINDOW_P (f
))
5358 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5360 #endif /* GLYPH_DEBUG */
5366 /* Return the face id of the realized face for named face SYMBOL on
5367 frame F suitable for displaying character C. Value is -1 if the
5368 face couldn't be determined, which might happen if the default face
5369 isn't realized and cannot be realized. */
5372 lookup_named_face (f
, symbol
, c
)
5377 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5378 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5379 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5381 if (default_face
== NULL
)
5383 if (!realize_basic_faces (f
))
5385 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5388 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5389 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5390 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5391 return lookup_face (f
, attrs
, c
, NULL
);
5395 /* Return the ID of the realized ASCII face of Lisp face with ID
5396 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5399 ascii_face_of_lisp_face (f
, lface_id
)
5405 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5407 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5408 face_id
= lookup_named_face (f
, face_name
, 0);
5417 /* Return a face for charset ASCII that is like the face with id
5418 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5419 STEPS < 0 means larger. Value is the id of the face. */
5422 smaller_face (f
, face_id
, steps
)
5426 #ifdef HAVE_WINDOW_SYSTEM
5428 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5429 int pt
, last_pt
, last_height
;
5432 struct face
*new_face
;
5434 /* If not called for an X frame, just return the original face. */
5435 if (FRAME_TERMCAP_P (f
))
5438 /* Try in increments of 1/2 pt. */
5439 delta
= steps
< 0 ? 5 : -5;
5440 steps
= abs (steps
);
5442 face
= FACE_FROM_ID (f
, face_id
);
5443 bcopy (face
->lface
, attrs
, sizeof attrs
);
5444 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5445 new_face_id
= face_id
;
5446 last_height
= FONT_HEIGHT (face
->font
);
5450 /* Give up if we cannot find a font within 10pt. */
5451 && abs (last_pt
- pt
) < 100)
5453 /* Look up a face for a slightly smaller/larger font. */
5455 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5456 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5457 new_face
= FACE_FROM_ID (f
, new_face_id
);
5459 /* If height changes, count that as one step. */
5460 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5461 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5464 last_height
= FONT_HEIGHT (new_face
->font
);
5471 #else /* not HAVE_WINDOW_SYSTEM */
5475 #endif /* not HAVE_WINDOW_SYSTEM */
5479 /* Return a face for charset ASCII that is like the face with id
5480 FACE_ID on frame F, but has height HEIGHT. */
5483 face_with_height (f
, face_id
, height
)
5488 #ifdef HAVE_WINDOW_SYSTEM
5490 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5492 if (FRAME_TERMCAP_P (f
)
5496 face
= FACE_FROM_ID (f
, face_id
);
5497 bcopy (face
->lface
, attrs
, sizeof attrs
);
5498 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5499 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5500 #endif /* HAVE_WINDOW_SYSTEM */
5506 /* Return the face id of the realized face for named face SYMBOL on
5507 frame F suitable for displaying character C, and use attributes of
5508 the face FACE_ID for attributes that aren't completely specified by
5509 SYMBOL. This is like lookup_named_face, except that the default
5510 attributes come from FACE_ID, not from the default face. FACE_ID
5511 is assumed to be already realized. */
5514 lookup_derived_face (f
, symbol
, c
, face_id
)
5520 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5521 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5522 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5527 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5528 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5529 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5530 return lookup_face (f
, attrs
, c
, default_face
);
5535 /***********************************************************************
5537 ***********************************************************************/
5539 DEFUN ("internal-set-font-selection-order",
5540 Finternal_set_font_selection_order
,
5541 Sinternal_set_font_selection_order
, 1, 1, 0,
5542 "Set font selection order for face font selection to ORDER.\n\
5543 ORDER must be a list of length 4 containing the symbols `:width',\n\
5544 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5545 first in ORDER are matched first, e.g. if `:height' appears before\n\
5546 `:weight' in ORDER, font selection first tries to find a font with\n\
5547 a suitable height, and then tries to match the font weight.\n\
5554 int indices
[DIM (font_sort_order
)];
5556 CHECK_LIST (order
, 0);
5557 bzero (indices
, sizeof indices
);
5561 CONSP (list
) && i
< DIM (indices
);
5562 list
= XCDR (list
), ++i
)
5564 Lisp_Object attr
= XCAR (list
);
5567 if (EQ (attr
, QCwidth
))
5569 else if (EQ (attr
, QCheight
))
5570 xlfd
= XLFD_POINT_SIZE
;
5571 else if (EQ (attr
, QCweight
))
5573 else if (EQ (attr
, QCslant
))
5578 if (indices
[i
] != 0)
5583 if (!NILP (list
) || i
!= DIM (indices
))
5584 signal_error ("Invalid font sort order", order
);
5585 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5586 if (indices
[i
] == 0)
5587 signal_error ("Invalid font sort order", order
);
5589 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5591 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5592 free_all_realized_faces (Qnil
);
5599 DEFUN ("internal-set-alternative-font-family-alist",
5600 Finternal_set_alternative_font_family_alist
,
5601 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5602 "Define alternative font families to try in face font selection.\n\
5603 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5604 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5605 be found. Value is ALIST.")
5609 CHECK_LIST (alist
, 0);
5610 Vface_alternative_font_family_alist
= alist
;
5611 free_all_realized_faces (Qnil
);
5616 DEFUN ("internal-set-alternative-font-registry-alist",
5617 Finternal_set_alternative_font_registry_alist
,
5618 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5619 "Define alternative font registries to try in face font selection.\n\
5620 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5621 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5622 be found. Value is ALIST.")
5626 CHECK_LIST (alist
, 0);
5627 Vface_alternative_font_registry_alist
= alist
;
5628 free_all_realized_faces (Qnil
);
5633 #ifdef HAVE_WINDOW_SYSTEM
5635 /* Value is non-zero if FONT is the name of a scalable font. The
5636 X11R6 XLFD spec says that point size, pixel size, and average width
5637 are zero for scalable fonts. Intlfonts contain at least one
5638 scalable font ("*-muleindian-1") for which this isn't true, so we
5639 just test average width. */
5642 font_scalable_p (font
)
5643 struct font_name
*font
;
5645 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5646 return (*s
== '0' && *(s
+ 1) == '\0')
5648 /* Windows implementation of XLFD is slightly broken for backward
5649 compatibility with previous broken versions, so test for
5650 wildcards as well as 0. */
5657 /* Ignore the difference of font point size less than this value. */
5659 #define FONT_POINT_SIZE_QUANTUM 5
5661 /* Value is non-zero if FONT1 is a better match for font attributes
5662 VALUES than FONT2. VALUES is an array of face attribute values in
5663 font sort order. COMPARE_PT_P zero means don't compare point
5664 sizes. AVGWIDTH, if not zero, is a specified font average width
5668 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5670 struct font_name
*font1
, *font2
;
5671 int compare_pt_p
, avgwidth
;
5675 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5677 int xlfd_idx
= font_sort_order
[i
];
5679 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5681 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5682 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5684 if (xlfd_idx
== XLFD_POINT_SIZE
5685 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5687 if (delta1
> delta2
)
5689 else if (delta1
< delta2
)
5693 /* The difference may be equal because, e.g., the face
5694 specifies `italic' but we have only `regular' and
5695 `oblique'. Prefer `oblique' in this case. */
5696 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5697 && font1
->numeric
[xlfd_idx
] > values
[i
]
5698 && font2
->numeric
[xlfd_idx
] < values
[i
])
5706 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5707 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5708 if (delta1
> delta2
)
5710 else if (delta1
< delta2
)
5714 return font1
->registry_priority
< font2
->registry_priority
;
5718 /* Value is non-zero if FONT is an exact match for face attributes in
5719 SPECIFIED. SPECIFIED is an array of face attribute values in font
5720 sort order. AVGWIDTH, if non-zero, is an average width to compare
5724 exact_face_match_p (specified
, font
, avgwidth
)
5726 struct font_name
*font
;
5731 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5732 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5735 return (i
== DIM (font_sort_order
)
5737 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5741 /* Value is the name of a scaled font, generated from scalable font
5742 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5743 Value is allocated from heap. */
5746 build_scalable_font_name (f
, font
, specified_pt
)
5748 struct font_name
*font
;
5751 char point_size
[20], pixel_size
[20];
5753 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5756 /* If scalable font is for a specific resolution, compute
5757 the point size we must specify from the resolution of
5758 the display and the specified resolution of the font. */
5759 if (font
->numeric
[XLFD_RESY
] != 0)
5761 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5762 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5767 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5770 /* Set point size of the font. */
5771 sprintf (point_size
, "%d", (int) pt
);
5772 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5773 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5775 /* Set pixel size. */
5776 sprintf (pixel_size
, "%d", pixel_value
);
5777 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5778 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5780 /* If font doesn't specify its resolution, use the
5781 resolution of the display. */
5782 if (font
->numeric
[XLFD_RESY
] == 0)
5785 sprintf (buffer
, "%d", (int) resy
);
5786 font
->fields
[XLFD_RESY
] = buffer
;
5787 font
->numeric
[XLFD_RESY
] = resy
;
5790 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5793 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5794 sprintf (buffer
, "%d", resx
);
5795 font
->fields
[XLFD_RESX
] = buffer
;
5796 font
->numeric
[XLFD_RESX
] = resx
;
5799 return build_font_name (font
);
5803 /* Value is non-zero if we are allowed to use scalable font FONT. We
5804 can't run a Lisp function here since this function may be called
5805 with input blocked. */
5808 may_use_scalable_font_p (font
, name
)
5809 struct font_name
*font
;
5812 if (EQ (Vscalable_fonts_allowed
, Qt
))
5814 else if (CONSP (Vscalable_fonts_allowed
))
5816 Lisp_Object tail
, regexp
;
5818 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5820 regexp
= XCAR (tail
);
5821 if (STRINGP (regexp
)
5822 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5832 /* Return the name of the best matching font for face attributes ATTRS
5833 in the array of font_name structures FONTS which contains NFONTS
5834 elements. WIDTH_RATIO is a factor with which to multiply average
5835 widths if ATTRS specifies such a width.
5837 Value is a font name which is allocated from the heap. FONTS is
5838 freed by this function. */
5841 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5844 struct font_name
*fonts
;
5849 struct font_name
*best
;
5852 int exact_p
, avgwidth
;
5857 /* Make specified font attributes available in `specified',
5858 indexed by sort order. */
5859 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5861 int xlfd_idx
= font_sort_order
[i
];
5863 if (xlfd_idx
== XLFD_SWIDTH
)
5864 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5865 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5866 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5867 else if (xlfd_idx
== XLFD_WEIGHT
)
5868 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5869 else if (xlfd_idx
== XLFD_SLANT
)
5870 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5875 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5877 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5881 /* Start with the first non-scalable font in the list. */
5882 for (i
= 0; i
< nfonts
; ++i
)
5883 if (!font_scalable_p (fonts
+ i
))
5886 /* Find the best match among the non-scalable fonts. */
5891 for (i
= 1; i
< nfonts
; ++i
)
5892 if (!font_scalable_p (fonts
+ i
)
5893 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5897 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5906 /* Unless we found an exact match among non-scalable fonts, see if
5907 we can find a better match among scalable fonts. */
5910 /* A scalable font is better if
5912 1. its weight, slant, swidth attributes are better, or.
5914 2. the best non-scalable font doesn't have the required
5915 point size, and the scalable fonts weight, slant, swidth
5918 int non_scalable_has_exact_height_p
;
5920 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5921 non_scalable_has_exact_height_p
= 1;
5923 non_scalable_has_exact_height_p
= 0;
5925 for (i
= 0; i
< nfonts
; ++i
)
5926 if (font_scalable_p (fonts
+ i
))
5929 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5930 || (!non_scalable_has_exact_height_p
5931 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5936 if (font_scalable_p (best
))
5937 font_name
= build_scalable_font_name (f
, best
, pt
);
5939 font_name
= build_font_name (best
);
5941 /* Free font_name structures. */
5942 free_font_names (fonts
, nfonts
);
5948 /* Try to get a list of fonts on frame F with font family FAMILY and
5949 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5950 of font_name structures for the fonts matched. Value is the number
5954 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5957 Lisp_Object pattern
, family
, registry
;
5958 struct font_name
**fonts
;
5962 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5963 family
= attrs
[LFACE_FAMILY_INDEX
];
5965 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5966 if (nfonts
== 0 && !NILP (family
))
5970 /* Try alternative font families. */
5971 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5973 for (alter
= XCDR (alter
);
5974 CONSP (alter
) && nfonts
== 0;
5975 alter
= XCDR (alter
))
5977 if (STRINGP (XCAR (alter
)))
5978 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5981 /* Try font family of the default face or "fixed". */
5984 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5986 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5988 family
= build_string ("fixed");
5989 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5992 /* Try any family with the given registry. */
5994 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6001 /* Return the fontset id of the base fontset name or alias name given
6002 by the fontset attribute of ATTRS. Value is -1 if the fontset
6003 attribute of ATTRS doesn't name a fontset. */
6006 face_fontset (attrs
)
6011 name
= attrs
[LFACE_FONT_INDEX
];
6012 if (!STRINGP (name
))
6014 return fs_query_fontset (name
, 0);
6018 /* Choose a name of font to use on frame F to display character C with
6019 Lisp face attributes specified by ATTRS. The font name is
6020 determined by the font-related attributes in ATTRS and the name
6021 pattern for C in FONTSET. Value is the font name which is
6022 allocated from the heap and must be freed by the caller, or NULL if
6023 we can get no information about the font name of C. It is assured
6024 that we always get some information for a single byte
6028 choose_face_font (f
, attrs
, fontset
, c
)
6033 Lisp_Object pattern
;
6034 char *font_name
= NULL
;
6035 struct font_name
*fonts
;
6036 int nfonts
, width_ratio
;
6038 /* Get (foundry and) family name and registry (and encoding) name of
6040 pattern
= fontset_font_pattern (f
, fontset
, c
);
6043 xassert (!SINGLE_BYTE_CHAR_P (c
));
6046 /* If what we got is a name pattern, return it. */
6047 if (STRINGP (pattern
))
6048 return xstrdup (XSTRING (pattern
)->data
);
6050 /* Family name may be specified both in ATTRS and car part of
6051 PATTERN. The former has higher priority if C is a single byte
6053 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
6054 && SINGLE_BYTE_CHAR_P (c
))
6055 XCAR (pattern
) = Qnil
;
6057 /* Get a list of fonts matching that pattern and choose the
6058 best match for the specified face attributes from it. */
6059 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
6061 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6063 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6064 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6068 #endif /* HAVE_WINDOW_SYSTEM */
6072 /***********************************************************************
6074 ***********************************************************************/
6076 /* Realize basic faces on frame F. Value is zero if frame parameters
6077 of F don't contain enough information needed to realize the default
6081 realize_basic_faces (f
)
6086 /* Block input there so that we won't be surprised by an X expose
6087 event, for instance without having the faces set up. */
6090 if (realize_default_face (f
))
6092 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6093 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6094 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6095 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6096 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6097 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6098 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6099 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6100 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6102 /* Reflect changes in the `menu' face in menu bars. */
6103 if (menu_face_change_count
)
6105 menu_face_change_count
= 0;
6107 #ifdef USE_X_TOOLKIT
6110 Widget menu
= f
->output_data
.x
->menubar_widget
;
6112 x_set_menu_resources_from_menu_face (f
, menu
);
6114 #endif /* USE_X_TOOLKIT */
6125 /* Realize the default face on frame F. If the face is not fully
6126 specified, make it fully-specified. Attributes of the default face
6127 that are not explicitly specified are taken from frame parameters. */
6130 realize_default_face (f
)
6133 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6135 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6136 Lisp_Object frame_font
;
6139 /* If the `default' face is not yet known, create it. */
6140 lface
= lface_from_face_name (f
, Qdefault
, 0);
6144 XSETFRAME (frame
, f
);
6145 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6148 #ifdef HAVE_WINDOW_SYSTEM
6149 if (FRAME_WINDOW_P (f
))
6151 /* Set frame_font to the value of the `font' frame parameter. */
6152 frame_font
= Fassq (Qfont
, f
->param_alist
);
6153 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6154 frame_font
= XCDR (frame_font
);
6155 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6157 #endif /* HAVE_WINDOW_SYSTEM */
6159 if (!FRAME_WINDOW_P (f
))
6161 LFACE_FAMILY (lface
) = build_string ("default");
6162 LFACE_SWIDTH (lface
) = Qnormal
;
6163 LFACE_HEIGHT (lface
) = make_number (1);
6164 LFACE_WEIGHT (lface
) = Qnormal
;
6165 LFACE_SLANT (lface
) = Qnormal
;
6166 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6169 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6170 LFACE_UNDERLINE (lface
) = Qnil
;
6172 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6173 LFACE_OVERLINE (lface
) = Qnil
;
6175 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6176 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6178 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6179 LFACE_BOX (lface
) = Qnil
;
6181 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6182 LFACE_INVERSE (lface
) = Qnil
;
6184 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6186 /* This function is called so early that colors are not yet
6187 set in the frame parameter list. */
6188 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6190 if (CONSP (color
) && STRINGP (XCDR (color
)))
6191 LFACE_FOREGROUND (lface
) = XCDR (color
);
6192 else if (FRAME_WINDOW_P (f
))
6194 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6195 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6200 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6202 /* This function is called so early that colors are not yet
6203 set in the frame parameter list. */
6204 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6205 if (CONSP (color
) && STRINGP (XCDR (color
)))
6206 LFACE_BACKGROUND (lface
) = XCDR (color
);
6207 else if (FRAME_WINDOW_P (f
))
6209 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6210 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6215 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6216 LFACE_STIPPLE (lface
) = Qnil
;
6218 /* Realize the face; it must be fully-specified now. */
6219 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6220 check_lface (lface
);
6221 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6222 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6227 /* Realize basic faces other than the default face in face cache C.
6228 SYMBOL is the face name, ID is the face id the realized face must
6229 have. The default face must have been realized already. */
6232 realize_named_face (f
, symbol
, id
)
6237 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6238 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6239 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6240 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6241 struct face
*new_face
;
6243 /* The default face must exist and be fully specified. */
6244 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6245 check_lface_attrs (attrs
);
6246 xassert (lface_fully_specified_p (attrs
));
6248 /* If SYMBOL isn't know as a face, create it. */
6252 XSETFRAME (frame
, f
);
6253 lface
= Finternal_make_lisp_face (symbol
, frame
);
6256 /* Merge SYMBOL's face with the default face. */
6257 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6258 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6260 /* Realize the face. */
6261 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6265 /* Realize the fully-specified face with attributes ATTRS in face
6266 cache CACHE for character C. If C is a multibyte character,
6267 BASE_FACE is a face that has the same attributes. Otherwise,
6268 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6269 ID of face to remove before caching the new face. Value is a
6270 pointer to the newly created realized face. */
6272 static struct face
*
6273 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6274 struct face_cache
*cache
;
6277 struct face
*base_face
;
6282 /* LFACE must be fully specified. */
6283 xassert (cache
!= NULL
);
6284 check_lface_attrs (attrs
);
6286 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6288 /* Remove the former face. */
6289 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6290 uncache_face (cache
, former_face
);
6291 free_realized_face (cache
->f
, former_face
);
6294 if (FRAME_WINDOW_P (cache
->f
))
6295 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6296 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6297 face
= realize_tty_face (cache
, attrs
, c
);
6301 /* Insert the new face. */
6302 cache_face (cache
, face
, lface_hash (attrs
));
6303 #ifdef HAVE_WINDOW_SYSTEM
6304 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6305 load_face_font (cache
->f
, face
, c
);
6306 #endif /* HAVE_WINDOW_SYSTEM */
6311 /* Realize the fully-specified face with attributes ATTRS in face
6312 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6313 a multibyte character, BASE_FACE is a face that has the same
6314 attributes. Otherwise, BASE_FACE is ignored. If the new face
6315 doesn't share font with the default face, a fontname is allocated
6316 from the heap and set in `font_name' of the new face, but it is not
6317 yet loaded here. Value is a pointer to the newly created realized
6320 static struct face
*
6321 realize_x_face (cache
, attrs
, c
, base_face
)
6322 struct face_cache
*cache
;
6325 struct face
*base_face
;
6327 #ifdef HAVE_WINDOW_SYSTEM
6328 struct face
*face
, *default_face
;
6330 Lisp_Object stipple
, overline
, strike_through
, box
;
6332 xassert (FRAME_WINDOW_P (cache
->f
));
6333 xassert (SINGLE_BYTE_CHAR_P (c
)
6336 /* Allocate a new realized face. */
6337 face
= make_realized_face (attrs
);
6341 /* If C is a multibyte character, we share all face attirbutes with
6342 BASE_FACE including the realized fontset. But, we must load a
6344 if (!SINGLE_BYTE_CHAR_P (c
))
6346 bcopy (base_face
, face
, sizeof *face
);
6349 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6350 face
->foreground_defaulted_p
= 1;
6351 face
->background_defaulted_p
= 1;
6352 face
->underline_defaulted_p
= 1;
6353 face
->overline_color_defaulted_p
= 1;
6354 face
->strike_through_color_defaulted_p
= 1;
6355 face
->box_color_defaulted_p
= 1;
6357 /* to force realize_face to load font */
6362 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6364 /* Determine the font to use. Most of the time, the font will be
6365 the same as the font of the default face, so try that first. */
6366 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6368 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6369 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6371 face
->font
= default_face
->font
;
6372 face
->fontset
= default_face
->fontset
;
6373 face
->font_info_id
= default_face
->font_info_id
;
6374 face
->font_name
= default_face
->font_name
;
6375 face
->ascii_face
= face
;
6377 /* But, as we can't share the fontset, make a new realized
6378 fontset that has the same base fontset as of the default
6381 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6385 /* If the face attribute ATTRS specifies a fontset, use it as
6386 the base of a new realized fontset. Otherwise, use the same
6387 base fontset as of the default face. The base determines
6388 registry and encoding of a font. It may also determine
6389 foundry and family. The other fields of font name pattern
6390 are constructed from ATTRS. */
6391 int fontset
= face_fontset (attrs
);
6393 if ((fontset
== -1) && default_face
)
6394 fontset
= default_face
->fontset
;
6395 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6396 face
->font
= NULL
; /* to force realize_face to load font */
6399 /* Load the font if it is specified in ATTRS. This fixes
6400 changing frame font on the Mac. */
6401 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6403 struct font_info
*font_info
=
6404 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6406 face
->font
= font_info
->font
;
6411 /* Load colors, and set remaining attributes. */
6413 load_face_colors (f
, face
, attrs
);
6416 box
= attrs
[LFACE_BOX_INDEX
];
6419 /* A simple box of line width 1 drawn in color given by
6421 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6423 face
->box
= FACE_SIMPLE_BOX
;
6424 face
->box_line_width
= 1;
6426 else if (INTEGERP (box
))
6428 /* Simple box of specified line width in foreground color of the
6430 xassert (XINT (box
) != 0);
6431 face
->box
= FACE_SIMPLE_BOX
;
6432 face
->box_line_width
= XINT (box
);
6433 face
->box_color
= face
->foreground
;
6434 face
->box_color_defaulted_p
= 1;
6436 else if (CONSP (box
))
6438 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6439 being one of `raised' or `sunken'. */
6440 face
->box
= FACE_SIMPLE_BOX
;
6441 face
->box_color
= face
->foreground
;
6442 face
->box_color_defaulted_p
= 1;
6443 face
->box_line_width
= 1;
6447 Lisp_Object keyword
, value
;
6449 keyword
= XCAR (box
);
6457 if (EQ (keyword
, QCline_width
))
6459 if (INTEGERP (value
) && XINT (value
) != 0)
6460 face
->box_line_width
= XINT (value
);
6462 else if (EQ (keyword
, QCcolor
))
6464 if (STRINGP (value
))
6466 face
->box_color
= load_color (f
, face
, value
,
6468 face
->use_box_color_for_shadows_p
= 1;
6471 else if (EQ (keyword
, QCstyle
))
6473 if (EQ (value
, Qreleased_button
))
6474 face
->box
= FACE_RAISED_BOX
;
6475 else if (EQ (value
, Qpressed_button
))
6476 face
->box
= FACE_SUNKEN_BOX
;
6481 /* Text underline, overline, strike-through. */
6483 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6485 /* Use default color (same as foreground color). */
6486 face
->underline_p
= 1;
6487 face
->underline_defaulted_p
= 1;
6488 face
->underline_color
= 0;
6490 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6492 /* Use specified color. */
6493 face
->underline_p
= 1;
6494 face
->underline_defaulted_p
= 0;
6495 face
->underline_color
6496 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6497 LFACE_UNDERLINE_INDEX
);
6499 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6501 face
->underline_p
= 0;
6502 face
->underline_defaulted_p
= 0;
6503 face
->underline_color
= 0;
6506 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6507 if (STRINGP (overline
))
6509 face
->overline_color
6510 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6511 LFACE_OVERLINE_INDEX
);
6512 face
->overline_p
= 1;
6514 else if (EQ (overline
, Qt
))
6516 face
->overline_color
= face
->foreground
;
6517 face
->overline_color_defaulted_p
= 1;
6518 face
->overline_p
= 1;
6521 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6522 if (STRINGP (strike_through
))
6524 face
->strike_through_color
6525 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6526 LFACE_STRIKE_THROUGH_INDEX
);
6527 face
->strike_through_p
= 1;
6529 else if (EQ (strike_through
, Qt
))
6531 face
->strike_through_color
= face
->foreground
;
6532 face
->strike_through_color_defaulted_p
= 1;
6533 face
->strike_through_p
= 1;
6536 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6537 if (!NILP (stipple
))
6538 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6540 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6542 #endif /* HAVE_WINDOW_SYSTEM */
6546 /* Map a specified color of face FACE on frame F to a tty color index.
6547 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6548 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6549 default foreground/background colors. */
6552 map_tty_color (f
, face
, idx
, defaulted
)
6555 enum lface_attribute_index idx
;
6558 Lisp_Object frame
, color
, def
;
6559 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6560 unsigned long default_pixel
, default_other_pixel
, pixel
;
6562 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6566 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6567 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6571 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6572 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6575 XSETFRAME (frame
, f
);
6576 color
= face
->lface
[idx
];
6579 && XSTRING (color
)->size
6580 && CONSP (Vtty_defined_color_alist
)
6581 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6584 /* Associations in tty-defined-color-alist are of the form
6585 (NAME INDEX R G B). We need the INDEX part. */
6586 pixel
= XINT (XCAR (XCDR (def
)));
6589 if (pixel
== default_pixel
&& STRINGP (color
))
6591 pixel
= load_color (f
, face
, color
, idx
);
6593 #if defined (MSDOS) || defined (WINDOWSNT)
6594 /* If the foreground of the default face is the default color,
6595 use the foreground color defined by the frame. */
6597 if (FRAME_MSDOS_P (f
))
6600 if (pixel
== default_pixel
6601 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6604 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6606 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6607 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6610 else if (pixel
== default_other_pixel
)
6613 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6615 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6616 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6622 #endif /* MSDOS or WINDOWSNT */
6626 face
->foreground
= pixel
;
6628 face
->background
= pixel
;
6632 /* Realize the fully-specified face with attributes ATTRS in face
6633 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6634 pointer to the newly created realized face. */
6636 static struct face
*
6637 realize_tty_face (cache
, attrs
, c
)
6638 struct face_cache
*cache
;
6644 int face_colors_defaulted
= 0;
6645 struct frame
*f
= cache
->f
;
6647 /* Frame must be a termcap frame. */
6648 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6650 /* Allocate a new realized face. */
6651 face
= make_realized_face (attrs
);
6652 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6654 /* Map face attributes to TTY appearances. We map slant to
6655 dimmed text because we want italic text to appear differently
6656 and because dimmed text is probably used infrequently. */
6657 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6658 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6660 if (weight
> XLFD_WEIGHT_MEDIUM
)
6661 face
->tty_bold_p
= 1;
6662 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6663 face
->tty_dim_p
= 1;
6664 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6665 face
->tty_underline_p
= 1;
6666 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6667 face
->tty_reverse_p
= 1;
6669 /* Map color names to color indices. */
6670 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6671 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6673 /* Swap colors if face is inverse-video. If the colors are taken
6674 from the frame colors, they are already inverted, since the
6675 frame-creation function calls x-handle-reverse-video. */
6676 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6678 unsigned long tem
= face
->foreground
;
6679 face
->foreground
= face
->background
;
6680 face
->background
= tem
;
6683 if (tty_suppress_bold_inverse_default_colors_p
6685 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6686 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6687 face
->tty_bold_p
= 0;
6693 DEFUN ("tty-suppress-bold-inverse-default-colors",
6694 Ftty_suppress_bold_inverse_default_colors
,
6695 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6696 "Suppress/allow boldness of faces with inverse default colors.\n\
6697 SUPPRESS non-nil means suppress it.\n\
6698 This affects bold faces on TTYs whose foreground is the default background\n\
6699 color of the display and whose background is the default foreground color.\n\
6700 For such faces, the bold face attribute is ignored if this variable\n\
6703 Lisp_Object suppress
;
6705 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6706 ++face_change_count
;
6712 /***********************************************************************
6714 ***********************************************************************/
6716 /* Return the ID of the face to use to display character CH with face
6717 property PROP on frame F in current_buffer. */
6720 compute_char_face (f
, ch
, prop
)
6727 if (NILP (current_buffer
->enable_multibyte_characters
))
6732 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6733 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6737 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6738 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6739 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6740 merge_face_vector_with_property (f
, attrs
, prop
);
6741 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6748 /* Return the face ID associated with buffer position POS for
6749 displaying ASCII characters. Return in *ENDPTR the position at
6750 which a different face is needed, as far as text properties and
6751 overlays are concerned. W is a window displaying current_buffer.
6753 REGION_BEG, REGION_END delimit the region, so it can be
6756 LIMIT is a position not to scan beyond. That is to limit the time
6757 this function can take.
6759 If MOUSE is non-zero, use the character's mouse-face, not its face.
6761 The face returned is suitable for displaying ASCII characters. */
6764 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6765 endptr
, limit
, mouse
)
6768 int region_beg
, region_end
;
6773 struct frame
*f
= XFRAME (w
->frame
);
6774 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6775 Lisp_Object prop
, position
;
6777 Lisp_Object
*overlay_vec
;
6780 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6781 Lisp_Object limit1
, end
;
6782 struct face
*default_face
;
6784 /* W must display the current buffer. We could write this function
6785 to use the frame and buffer of W, but right now it doesn't. */
6786 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6788 XSETFRAME (frame
, f
);
6789 XSETFASTINT (position
, pos
);
6792 if (pos
< region_beg
&& region_beg
< endpos
)
6793 endpos
= region_beg
;
6795 /* Get the `face' or `mouse_face' text property at POS, and
6796 determine the next position at which the property changes. */
6797 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6798 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6799 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6801 endpos
= XINT (end
);
6803 /* Look at properties from overlays. */
6808 /* First try with room for 40 overlays. */
6810 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6811 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6812 &next_overlay
, NULL
, 0);
6814 /* If there are more than 40, make enough space for all, and try
6816 if (noverlays
> len
)
6819 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6820 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6821 &next_overlay
, NULL
, 0);
6824 if (next_overlay
< endpos
)
6825 endpos
= next_overlay
;
6830 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6832 /* Optimize common cases where we can use the default face. */
6835 && !(pos
>= region_beg
&& pos
< region_end
))
6836 return DEFAULT_FACE_ID
;
6838 /* Begin with attributes from the default face. */
6839 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6841 /* Merge in attributes specified via text properties. */
6843 merge_face_vector_with_property (f
, attrs
, prop
);
6845 /* Now merge the overlay data. */
6846 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6847 for (i
= 0; i
< noverlays
; i
++)
6852 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6854 merge_face_vector_with_property (f
, attrs
, prop
);
6856 oend
= OVERLAY_END (overlay_vec
[i
]);
6857 oendpos
= OVERLAY_POSITION (oend
);
6858 if (oendpos
< endpos
)
6862 /* If in the region, merge in the region face. */
6863 if (pos
>= region_beg
&& pos
< region_end
)
6865 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6866 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6868 if (region_end
< endpos
)
6869 endpos
= region_end
;
6874 /* Look up a realized face with the given face attributes,
6875 or realize a new one for ASCII characters. */
6876 return lookup_face (f
, attrs
, 0, NULL
);
6880 /* Compute the face at character position POS in Lisp string STRING on
6881 window W, for ASCII characters.
6883 If STRING is an overlay string, it comes from position BUFPOS in
6884 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6885 not an overlay string. W must display the current buffer.
6886 REGION_BEG and REGION_END give the start and end positions of the
6887 region; both are -1 if no region is visible.
6889 BASE_FACE_ID is the id of a face to merge with. For strings coming
6890 from overlays or the `display' property it is the face at BUFPOS.
6892 Set *ENDPTR to the next position where to check for faces in
6893 STRING; -1 if the face is constant from POS to the end of the
6896 Value is the id of the face to use. The face returned is suitable
6897 for displaying ASCII characters. */
6900 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6901 region_end
, endptr
, base_face_id
)
6905 int region_beg
, region_end
;
6907 enum face_id base_face_id
;
6909 Lisp_Object prop
, position
, end
, limit
;
6910 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6911 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6912 struct face
*base_face
;
6913 int multibyte_p
= STRING_MULTIBYTE (string
);
6915 /* Get the value of the face property at the current position within
6916 STRING. Value is nil if there is no face property. */
6917 XSETFASTINT (position
, pos
);
6918 prop
= Fget_text_property (position
, Qface
, string
);
6920 /* Get the next position at which to check for faces. Value of end
6921 is nil if face is constant all the way to the end of the string.
6922 Otherwise it is a string position where to check faces next.
6923 Limit is the maximum position up to which to check for property
6924 changes in Fnext_single_property_change. Strings are usually
6925 short, so set the limit to the end of the string. */
6926 XSETFASTINT (limit
, XSTRING (string
)->size
);
6927 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6929 *endptr
= XFASTINT (end
);
6933 base_face
= FACE_FROM_ID (f
, base_face_id
);
6934 xassert (base_face
);
6936 /* Optimize the default case that there is no face property and we
6937 are not in the region. */
6939 && (base_face_id
!= DEFAULT_FACE_ID
6940 /* BUFPOS <= 0 means STRING is not an overlay string, so
6941 that the region doesn't have to be taken into account. */
6943 || bufpos
< region_beg
6944 || bufpos
>= region_end
)
6946 /* We can't realize faces for different charsets differently
6947 if we don't have fonts, so we can stop here if not working
6948 on a window-system frame. */
6949 || !FRAME_WINDOW_P (f
)
6950 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6951 return base_face
->id
;
6953 /* Begin with attributes from the base face. */
6954 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6956 /* Merge in attributes specified via text properties. */
6958 merge_face_vector_with_property (f
, attrs
, prop
);
6960 /* If in the region, merge in the region face. */
6962 && bufpos
>= region_beg
6963 && bufpos
< region_end
)
6965 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6966 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6969 /* Look up a realized face with the given face attributes,
6970 or realize a new one for ASCII characters. */
6971 return lookup_face (f
, attrs
, 0, NULL
);
6976 /***********************************************************************
6978 ***********************************************************************/
6982 /* Print the contents of the realized face FACE to stderr. */
6985 dump_realized_face (face
)
6988 fprintf (stderr
, "ID: %d\n", face
->id
);
6989 #ifdef HAVE_X_WINDOWS
6990 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6992 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6994 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6995 fprintf (stderr
, "background: 0x%lx (%s)\n",
6997 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6998 fprintf (stderr
, "font_name: %s (%s)\n",
7000 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7001 #ifdef HAVE_X_WINDOWS
7002 fprintf (stderr
, "font = %p\n", face
->font
);
7004 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7005 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7006 fprintf (stderr
, "underline: %d (%s)\n",
7008 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7009 fprintf (stderr
, "hash: %d\n", face
->hash
);
7010 fprintf (stderr
, "charset: %d\n", face
->charset
);
7014 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
7022 fprintf (stderr
, "font selection order: ");
7023 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7024 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7025 fprintf (stderr
, "\n");
7027 fprintf (stderr
, "alternative fonts: ");
7028 debug_print (Vface_alternative_font_family_alist
);
7029 fprintf (stderr
, "\n");
7031 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7032 Fdump_face (make_number (i
));
7037 CHECK_NUMBER (n
, 0);
7038 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7040 error ("Not a valid face");
7041 dump_realized_face (face
);
7048 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7052 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7053 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7054 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7058 #endif /* GLYPH_DEBUG != 0 */
7062 /***********************************************************************
7064 ***********************************************************************/
7069 Qface
= intern ("face");
7071 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7072 staticpro (&Qbitmap_spec_p
);
7073 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7074 staticpro (&Qframe_update_face_colors
);
7076 /* Lisp face attribute keywords. */
7077 QCfamily
= intern (":family");
7078 staticpro (&QCfamily
);
7079 QCheight
= intern (":height");
7080 staticpro (&QCheight
);
7081 QCweight
= intern (":weight");
7082 staticpro (&QCweight
);
7083 QCslant
= intern (":slant");
7084 staticpro (&QCslant
);
7085 QCunderline
= intern (":underline");
7086 staticpro (&QCunderline
);
7087 QCinverse_video
= intern (":inverse-video");
7088 staticpro (&QCinverse_video
);
7089 QCreverse_video
= intern (":reverse-video");
7090 staticpro (&QCreverse_video
);
7091 QCforeground
= intern (":foreground");
7092 staticpro (&QCforeground
);
7093 QCbackground
= intern (":background");
7094 staticpro (&QCbackground
);
7095 QCstipple
= intern (":stipple");;
7096 staticpro (&QCstipple
);
7097 QCwidth
= intern (":width");
7098 staticpro (&QCwidth
);
7099 QCfont
= intern (":font");
7100 staticpro (&QCfont
);
7101 QCbold
= intern (":bold");
7102 staticpro (&QCbold
);
7103 QCitalic
= intern (":italic");
7104 staticpro (&QCitalic
);
7105 QCoverline
= intern (":overline");
7106 staticpro (&QCoverline
);
7107 QCstrike_through
= intern (":strike-through");
7108 staticpro (&QCstrike_through
);
7109 QCbox
= intern (":box");
7111 QCinherit
= intern (":inherit");
7112 staticpro (&QCinherit
);
7114 /* Symbols used for Lisp face attribute values. */
7115 QCcolor
= intern (":color");
7116 staticpro (&QCcolor
);
7117 QCline_width
= intern (":line-width");
7118 staticpro (&QCline_width
);
7119 QCstyle
= intern (":style");
7120 staticpro (&QCstyle
);
7121 Qreleased_button
= intern ("released-button");
7122 staticpro (&Qreleased_button
);
7123 Qpressed_button
= intern ("pressed-button");
7124 staticpro (&Qpressed_button
);
7125 Qnormal
= intern ("normal");
7126 staticpro (&Qnormal
);
7127 Qultra_light
= intern ("ultra-light");
7128 staticpro (&Qultra_light
);
7129 Qextra_light
= intern ("extra-light");
7130 staticpro (&Qextra_light
);
7131 Qlight
= intern ("light");
7132 staticpro (&Qlight
);
7133 Qsemi_light
= intern ("semi-light");
7134 staticpro (&Qsemi_light
);
7135 Qsemi_bold
= intern ("semi-bold");
7136 staticpro (&Qsemi_bold
);
7137 Qbold
= intern ("bold");
7139 Qextra_bold
= intern ("extra-bold");
7140 staticpro (&Qextra_bold
);
7141 Qultra_bold
= intern ("ultra-bold");
7142 staticpro (&Qultra_bold
);
7143 Qoblique
= intern ("oblique");
7144 staticpro (&Qoblique
);
7145 Qitalic
= intern ("italic");
7146 staticpro (&Qitalic
);
7147 Qreverse_oblique
= intern ("reverse-oblique");
7148 staticpro (&Qreverse_oblique
);
7149 Qreverse_italic
= intern ("reverse-italic");
7150 staticpro (&Qreverse_italic
);
7151 Qultra_condensed
= intern ("ultra-condensed");
7152 staticpro (&Qultra_condensed
);
7153 Qextra_condensed
= intern ("extra-condensed");
7154 staticpro (&Qextra_condensed
);
7155 Qcondensed
= intern ("condensed");
7156 staticpro (&Qcondensed
);
7157 Qsemi_condensed
= intern ("semi-condensed");
7158 staticpro (&Qsemi_condensed
);
7159 Qsemi_expanded
= intern ("semi-expanded");
7160 staticpro (&Qsemi_expanded
);
7161 Qexpanded
= intern ("expanded");
7162 staticpro (&Qexpanded
);
7163 Qextra_expanded
= intern ("extra-expanded");
7164 staticpro (&Qextra_expanded
);
7165 Qultra_expanded
= intern ("ultra-expanded");
7166 staticpro (&Qultra_expanded
);
7167 Qbackground_color
= intern ("background-color");
7168 staticpro (&Qbackground_color
);
7169 Qforeground_color
= intern ("foreground-color");
7170 staticpro (&Qforeground_color
);
7171 Qunspecified
= intern ("unspecified");
7172 staticpro (&Qunspecified
);
7174 Qface_alias
= intern ("face-alias");
7175 staticpro (&Qface_alias
);
7176 Qdefault
= intern ("default");
7177 staticpro (&Qdefault
);
7178 Qtool_bar
= intern ("tool-bar");
7179 staticpro (&Qtool_bar
);
7180 Qregion
= intern ("region");
7181 staticpro (&Qregion
);
7182 Qfringe
= intern ("fringe");
7183 staticpro (&Qfringe
);
7184 Qheader_line
= intern ("header-line");
7185 staticpro (&Qheader_line
);
7186 Qscroll_bar
= intern ("scroll-bar");
7187 staticpro (&Qscroll_bar
);
7188 Qmenu
= intern ("menu");
7190 Qcursor
= intern ("cursor");
7191 staticpro (&Qcursor
);
7192 Qborder
= intern ("border");
7193 staticpro (&Qborder
);
7194 Qmouse
= intern ("mouse");
7195 staticpro (&Qmouse
);
7196 Qtty_color_desc
= intern ("tty-color-desc");
7197 staticpro (&Qtty_color_desc
);
7198 Qtty_color_by_index
= intern ("tty-color-by-index");
7199 staticpro (&Qtty_color_by_index
);
7200 Qtty_color_alist
= intern ("tty-color-alist");
7201 staticpro (&Qtty_color_alist
);
7203 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7204 staticpro (&Vparam_value_alist
);
7205 Vface_alternative_font_family_alist
= Qnil
;
7206 staticpro (&Vface_alternative_font_family_alist
);
7207 Vface_alternative_font_registry_alist
= Qnil
;
7208 staticpro (&Vface_alternative_font_registry_alist
);
7210 defsubr (&Sinternal_make_lisp_face
);
7211 defsubr (&Sinternal_lisp_face_p
);
7212 defsubr (&Sinternal_set_lisp_face_attribute
);
7213 #ifdef HAVE_WINDOW_SYSTEM
7214 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7216 defsubr (&Scolor_gray_p
);
7217 defsubr (&Scolor_supported_p
);
7218 defsubr (&Sinternal_get_lisp_face_attribute
);
7219 defsubr (&Sinternal_lisp_face_attribute_values
);
7220 defsubr (&Sinternal_lisp_face_equal_p
);
7221 defsubr (&Sinternal_lisp_face_empty_p
);
7222 defsubr (&Sinternal_copy_lisp_face
);
7223 defsubr (&Sinternal_merge_in_global_face
);
7224 defsubr (&Sface_font
);
7225 defsubr (&Sframe_face_alist
);
7226 defsubr (&Sinternal_set_font_selection_order
);
7227 defsubr (&Sinternal_set_alternative_font_family_alist
);
7228 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7230 defsubr (&Sdump_face
);
7231 defsubr (&Sshow_face_resources
);
7232 #endif /* GLYPH_DEBUG */
7233 defsubr (&Sclear_face_cache
);
7234 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7236 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7237 defsubr (&Sdump_colors
);
7240 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7241 "*Limit for font matching.\n\
7242 If an integer > 0, font matching functions won't load more than\n\
7243 that number of fonts when searching for a matching font.");
7244 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7246 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7247 "List of global face definitions (for internal use only.)");
7248 Vface_new_frame_defaults
= Qnil
;
7250 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7251 "*Default stipple pattern used on monochrome displays.\n\
7252 This stipple pattern is used on monochrome displays\n\
7253 instead of shades of gray for a face background color.\n\
7254 See `set-face-stipple' for possible values for this variable.");
7255 Vface_default_stipple
= build_string ("gray3");
7257 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7258 "An alist of defined terminal colors and their RGB values.");
7259 Vtty_defined_color_alist
= Qnil
;
7261 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7262 "Allowed scalable fonts.\n\
7263 A value of nil means don't allow any scalable fonts.\n\
7264 A value of t means allow any scalable font.\n\
7265 Otherwise, value must be a list of regular expressions. A font may be\n\
7266 scaled if its name matches a regular expression in the list.");
7267 #if defined (WINDOWSNT) || defined (macintosh)
7268 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7269 by default limits the fonts available severely. */
7270 Vscalable_fonts_allowed
= Qt
;
7272 Vscalable_fonts_allowed
= Qnil
;
7275 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7276 "List of ignored fonts.\n\
7277 Each element is a regular expression that matches names of fonts to ignore.");
7278 Vface_ignored_fonts
= Qnil
;
7280 #ifdef HAVE_WINDOW_SYSTEM
7281 defsubr (&Sbitmap_spec_p
);
7282 defsubr (&Sx_list_fonts
);
7283 defsubr (&Sinternal_face_x_get_resource
);
7284 defsubr (&Sx_family_fonts
);
7285 defsubr (&Sx_font_family_list
);
7286 #endif /* HAVE_WINDOW_SYSTEM */