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 attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
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 /* Non-zero while realizing the default face. */
492 static int realizing_basic_faces_p
;
494 /* The total number of colors currently allocated. */
497 static int ncolors_allocated
;
498 static int npixmaps_allocated
;
504 /* Function prototypes. */
509 static void map_tty_color
P_ ((struct frame
*, struct face
*,
510 enum lface_attribute_index
, int *));
511 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
512 static int may_use_scalable_font_p
P_ ((char *));
513 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
514 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
516 static int x_face_list_fonts
P_ ((struct frame
*, char *,
517 struct font_name
*, int, int));
518 static int font_scalable_p
P_ ((struct font_name
*));
519 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
520 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
521 static unsigned char *xstrlwr
P_ ((unsigned char *));
522 static void signal_error
P_ ((char *, Lisp_Object
));
523 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
524 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
525 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
526 static void free_face_colors
P_ ((struct frame
*, struct face
*));
527 static int face_color_gray_p
P_ ((struct frame
*, char *));
528 static char *build_font_name
P_ ((struct font_name
*));
529 static void free_font_names
P_ ((struct font_name
*, int));
530 static int sorted_font_list
P_ ((struct frame
*, char *,
531 int (*cmpfn
) P_ ((const void *, const void *)),
532 struct font_name
**));
533 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
534 Lisp_Object
, struct font_name
**));
535 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
536 Lisp_Object
, struct font_name
**));
537 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
538 Lisp_Object
, Lisp_Object
, struct font_name
**));
539 static int cmp_font_names
P_ ((const void *, const void *));
540 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
541 struct face
*, int));
542 static struct face
*realize_x_face
P_ ((struct face_cache
*,
543 Lisp_Object
*, int, struct face
*));
544 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
545 Lisp_Object
*, int));
546 static int realize_basic_faces
P_ ((struct frame
*));
547 static int realize_default_face
P_ ((struct frame
*));
548 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
549 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
550 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
551 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
552 static unsigned lface_hash
P_ ((Lisp_Object
*));
553 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
554 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
555 static void free_realized_face
P_ ((struct frame
*, struct face
*));
556 static void clear_face_gcs
P_ ((struct face_cache
*));
557 static void free_face_cache
P_ ((struct face_cache
*));
558 static int face_numeric_weight
P_ ((Lisp_Object
));
559 static int face_numeric_slant
P_ ((Lisp_Object
));
560 static int face_numeric_swidth
P_ ((Lisp_Object
));
561 static int face_fontset
P_ ((Lisp_Object
*));
562 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
563 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
564 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
565 Lisp_Object
*, Lisp_Object
));
566 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
568 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
569 Lisp_Object
, int, int));
570 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
571 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
572 static void free_realized_faces
P_ ((struct face_cache
*));
573 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
574 struct font_name
*, int, int));
575 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
576 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
577 static int xlfd_numeric_slant
P_ ((struct font_name
*));
578 static int xlfd_numeric_weight
P_ ((struct font_name
*));
579 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
580 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
581 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
582 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
583 static int xlfd_fixed_p
P_ ((struct font_name
*));
584 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
586 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
587 struct font_name
*, int,
589 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
590 struct font_name
*, int));
592 #ifdef HAVE_WINDOW_SYSTEM
594 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
595 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
596 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
597 int (*cmpfn
) P_ ((const void *, const void *))));
598 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
599 static void x_free_gc
P_ ((struct frame
*, GC
));
600 static void clear_font_table
P_ ((struct frame
*));
603 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
604 #endif /* WINDOWSNT */
607 static void x_update_menu_appearance
P_ ((struct frame
*));
608 #endif /* USE_X_TOOLKIT */
610 #endif /* HAVE_WINDOW_SYSTEM */
613 /***********************************************************************
615 ***********************************************************************/
617 #ifdef HAVE_X_WINDOWS
619 #ifdef DEBUG_X_COLORS
621 /* The following is a poor mans infrastructure for debugging X color
622 allocation problems on displays with PseudoColor-8. Some X servers
623 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
624 color reference counts completely so that they don't signal an
625 error when a color is freed whose reference count is already 0.
626 Other X servers do. To help me debug this, the following code
627 implements a simple reference counting schema of its own, for a
628 single display/screen. --gerd. */
630 /* Reference counts for pixel colors. */
632 int color_count
[256];
634 /* Register color PIXEL as allocated. */
637 register_color (pixel
)
640 xassert (pixel
< 256);
641 ++color_count
[pixel
];
645 /* Register color PIXEL as deallocated. */
648 unregister_color (pixel
)
651 xassert (pixel
< 256);
652 if (color_count
[pixel
] > 0)
653 --color_count
[pixel
];
659 /* Register N colors from PIXELS as deallocated. */
662 unregister_colors (pixels
, n
)
663 unsigned long *pixels
;
667 for (i
= 0; i
< n
; ++i
)
668 unregister_color (pixels
[i
]);
672 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
673 "Dump currently allocated colors and their reference counts to stderr.")
678 fputc ('\n', stderr
);
680 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
683 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
686 fputc ('\n', stderr
);
688 fputc ('\t', stderr
);
692 fputc ('\n', stderr
);
696 #endif /* DEBUG_X_COLORS */
699 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
700 color values. Interrupt input must be blocked when this function
704 x_free_colors (f
, pixels
, npixels
)
706 unsigned long *pixels
;
709 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
711 /* If display has an immutable color map, freeing colors is not
712 necessary and some servers don't allow it. So don't do it. */
713 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
715 #ifdef DEBUG_X_COLORS
716 unregister_colors (pixels
, npixels
);
718 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
724 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
725 color values. Interrupt input must be blocked when this function
729 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
733 unsigned long *pixels
;
736 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
737 int class = dpyinfo
->visual
->class;
739 /* If display has an immutable color map, freeing colors is not
740 necessary and some servers don't allow it. So don't do it. */
741 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
743 #ifdef DEBUG_X_COLORS
744 unregister_colors (pixels
, npixels
);
746 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
751 /* Create and return a GC for use on frame F. GC values and mask
752 are given by XGCV and MASK. */
755 x_create_gc (f
, mask
, xgcv
)
762 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
769 /* Free GC which was used on frame F. */
777 xassert (--ngcs
>= 0);
778 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
782 #endif /* HAVE_X_WINDOWS */
785 /* W32 emulation of GCs */
788 x_create_gc (f
, mask
, xgcv
)
795 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
802 /* Free GC which was used on frame F. */
810 xassert (--ngcs
>= 0);
815 #endif /* WINDOWSNT */
817 /* Like stricmp. Used to compare parts of font names which are in
822 unsigned char *s1
, *s2
;
826 unsigned char c1
= tolower (*s1
);
827 unsigned char c2
= tolower (*s2
);
829 return c1
< c2
? -1 : 1;
834 return *s2
== 0 ? 0 : -1;
839 /* Like strlwr, which might not always be available. */
841 static unsigned char *
845 unsigned char *p
= s
;
854 /* Signal `error' with message S, and additional argument ARG. */
857 signal_error (s
, arg
)
861 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
865 /* If FRAME is nil, return a pointer to the selected frame.
866 Otherwise, check that FRAME is a live frame, and return a pointer
867 to it. NPARAM is the parameter number of FRAME, for
868 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
869 Lisp function definitions. */
871 static INLINE
struct frame
*
872 frame_or_selected_frame (frame
, nparam
)
877 frame
= selected_frame
;
879 CHECK_LIVE_FRAME (frame
, nparam
);
880 return XFRAME (frame
);
884 /***********************************************************************
886 ***********************************************************************/
888 /* Initialize face cache and basic faces for frame F. */
894 /* Make a face cache, if F doesn't have one. */
895 if (FRAME_FACE_CACHE (f
) == NULL
)
896 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
898 #ifdef HAVE_WINDOW_SYSTEM
899 /* Make the image cache. */
900 if (FRAME_WINDOW_P (f
))
902 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
903 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
904 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
906 #endif /* HAVE_WINDOW_SYSTEM */
908 /* Realize basic faces. Must have enough information in frame
909 parameters to realize basic faces at this point. */
910 #ifdef HAVE_X_WINDOWS
911 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
914 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
916 if (!realize_basic_faces (f
))
921 /* Free face cache of frame F. Called from Fdelete_frame. */
927 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
931 free_face_cache (face_cache
);
932 FRAME_FACE_CACHE (f
) = NULL
;
935 #ifdef HAVE_WINDOW_SYSTEM
936 if (FRAME_WINDOW_P (f
))
938 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
941 --image_cache
->refcount
;
942 if (image_cache
->refcount
== 0)
943 free_image_cache (f
);
946 #endif /* HAVE_WINDOW_SYSTEM */
950 /* Clear face caches, and recompute basic faces for frame F. Call
951 this after changing frame parameters on which those faces depend,
952 or when realized faces have been freed due to changing attributes
956 recompute_basic_faces (f
)
959 if (FRAME_FACE_CACHE (f
))
961 clear_face_cache (0);
962 if (!realize_basic_faces (f
))
968 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
969 try to free unused fonts, too. */
972 clear_face_cache (clear_fonts_p
)
975 #ifdef HAVE_WINDOW_SYSTEM
976 Lisp_Object tail
, frame
;
980 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
982 /* From time to time see if we can unload some fonts. This also
983 frees all realized faces on all frames. Fonts needed by
984 faces will be loaded again when faces are realized again. */
985 clear_font_table_count
= 0;
987 FOR_EACH_FRAME (tail
, frame
)
990 if (FRAME_WINDOW_P (f
)
991 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
993 free_all_realized_faces (frame
);
994 clear_font_table (f
);
1000 /* Clear GCs of realized faces. */
1001 FOR_EACH_FRAME (tail
, frame
)
1004 if (FRAME_WINDOW_P (f
))
1006 clear_face_gcs (FRAME_FACE_CACHE (f
));
1007 clear_image_cache (f
, 0);
1011 #endif /* HAVE_WINDOW_SYSTEM */
1015 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1016 "Clear face caches on all frames.\n\
1017 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
1019 Lisp_Object thoroughly
;
1021 clear_face_cache (!NILP (thoroughly
));
1022 ++face_change_count
;
1023 ++windows_or_buffers_changed
;
1029 #ifdef HAVE_WINDOW_SYSTEM
1032 /* Remove those fonts from the font table of frame F exept for the
1033 default ASCII font for the frame. Called from clear_face_cache
1034 from time to time. */
1037 clear_font_table (f
)
1040 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1043 xassert (FRAME_WINDOW_P (f
));
1045 /* Free those fonts that are not used by the frame F as the default. */
1046 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1048 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1050 if (!font_info
->name
1051 || font_info
->font
== FRAME_FONT (f
))
1055 if (font_info
->full_name
!= font_info
->name
)
1056 xfree (font_info
->full_name
);
1057 xfree (font_info
->name
);
1059 /* Free the font. */
1061 #ifdef HAVE_X_WINDOWS
1062 XFreeFont (dpyinfo
->display
, font_info
->font
);
1065 w32_unload_font (dpyinfo
, font_info
->font
);
1069 /* Mark font table slot free. */
1070 font_info
->font
= NULL
;
1071 font_info
->name
= font_info
->full_name
= NULL
;
1075 #endif /* HAVE_WINDOW_SYSTEM */
1079 /***********************************************************************
1081 ***********************************************************************/
1083 #ifdef HAVE_WINDOW_SYSTEM
1085 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1086 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1087 A bitmap specification is either a string, a file name, or a list\n\
1088 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1089 HEIGHT is its height, and DATA is a string containing the bits of\n\
1090 the pixmap. Bits are stored row by row, each row occupies\n\
1091 (WIDTH + 7)/8 bytes.")
1097 if (STRINGP (object
))
1098 /* If OBJECT is a string, it's a file name. */
1100 else if (CONSP (object
))
1102 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1103 HEIGHT must be integers > 0, and DATA must be string large
1104 enough to hold a bitmap of the specified size. */
1105 Lisp_Object width
, height
, data
;
1107 height
= width
= data
= Qnil
;
1111 width
= XCAR (object
);
1112 object
= XCDR (object
);
1115 height
= XCAR (object
);
1116 object
= XCDR (object
);
1118 data
= XCAR (object
);
1122 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1124 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1126 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1131 return pixmap_p
? Qt
: Qnil
;
1135 /* Load a bitmap according to NAME (which is either a file name or a
1136 pixmap spec) for use on frame F. Value is the bitmap_id (see
1137 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1138 bitmap cannot be loaded, display a message saying so, and return
1139 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1140 if these pointers are not null. */
1143 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1146 unsigned int *w_ptr
, *h_ptr
;
1154 tem
= Fbitmap_spec_p (name
);
1156 wrong_type_argument (Qbitmap_spec_p
, name
);
1161 /* Decode a bitmap spec into a bitmap. */
1166 w
= XINT (Fcar (name
));
1167 h
= XINT (Fcar (Fcdr (name
)));
1168 bits
= Fcar (Fcdr (Fcdr (name
)));
1170 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1175 /* It must be a string -- a file name. */
1176 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1182 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1193 ++npixmaps_allocated
;
1196 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1199 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1205 #endif /* HAVE_WINDOW_SYSTEM */
1209 /***********************************************************************
1211 ***********************************************************************/
1213 #ifdef HAVE_WINDOW_SYSTEM
1215 /* Update the line_height of frame F. Return non-zero if line height
1219 frame_update_line_height (f
)
1222 int line_height
, changed_p
;
1224 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1225 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1226 FRAME_LINE_HEIGHT (f
) = line_height
;
1230 #endif /* HAVE_WINDOW_SYSTEM */
1233 /***********************************************************************
1235 ***********************************************************************/
1237 #ifdef HAVE_WINDOW_SYSTEM
1239 /* Load font of face FACE which is used on frame F to display
1240 character C. The name of the font to load is determined by lface
1241 and fontset of FACE. */
1244 load_face_font (f
, face
, c
)
1249 struct font_info
*font_info
= NULL
;
1252 face
->font_info_id
= -1;
1255 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1260 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1265 face
->font_info_id
= font_info
->font_idx
;
1266 face
->font
= font_info
->font
;
1267 face
->font_name
= font_info
->full_name
;
1270 x_free_gc (f
, face
->gc
);
1275 add_to_log ("Unable to load font %s",
1276 build_string (font_name
), Qnil
);
1280 #endif /* HAVE_WINDOW_SYSTEM */
1284 /***********************************************************************
1286 ***********************************************************************/
1288 /* A version of defined_color for non-X frames. */
1291 tty_defined_color (f
, color_name
, color_def
, alloc
)
1297 Lisp_Object color_desc
;
1298 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1299 unsigned long red
= 0, green
= 0, blue
= 0;
1302 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1306 XSETFRAME (frame
, f
);
1308 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1309 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1311 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1312 if (CONSP (XCDR (XCDR (color_desc
))))
1314 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1315 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1316 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1320 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1321 /* We were called early during startup, and the colors are not
1322 yet set up in tty-defined-color-alist. Don't return a failure
1323 indication, since this produces the annoying "Unable to
1324 load color" messages in the *Messages* buffer. */
1327 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1329 if (strcmp (color_name
, "unspecified-fg") == 0)
1330 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1331 else if (strcmp (color_name
, "unspecified-bg") == 0)
1332 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1335 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1338 color_def
->pixel
= color_idx
;
1339 color_def
->red
= red
;
1340 color_def
->green
= green
;
1341 color_def
->blue
= blue
;
1347 /* Decide if color named COLOR_NAME is valid for the display
1348 associated with the frame F; if so, return the rgb values in
1349 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1351 This does the right thing for any type of frame. */
1354 defined_color (f
, color_name
, color_def
, alloc
)
1360 if (!FRAME_WINDOW_P (f
))
1361 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1362 #ifdef HAVE_X_WINDOWS
1363 else if (FRAME_X_P (f
))
1364 return x_defined_color (f
, color_name
, color_def
, alloc
);
1367 else if (FRAME_W32_P (f
))
1368 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1371 else if (FRAME_MAC_P (f
))
1372 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1379 /* Given the index IDX of a tty color on frame F, return its name, a
1383 tty_color_name (f
, idx
)
1387 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1390 Lisp_Object coldesc
;
1392 XSETFRAME (frame
, f
);
1393 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1395 if (!NILP (coldesc
))
1396 return XCAR (coldesc
);
1399 /* We can have an MSDOG frame under -nw for a short window of
1400 opportunity before internal_terminal_init is called. DTRT. */
1401 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1402 return msdos_stdcolor_name (idx
);
1405 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1406 return build_string (unspecified_fg
);
1407 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1408 return build_string (unspecified_bg
);
1411 return vga_stdcolor_name (idx
);
1414 return Qunspecified
;
1418 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1419 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1422 face_color_gray_p (f
, color_name
)
1429 if (defined_color (f
, color_name
, &color
, 0))
1430 gray_p
= ((abs (color
.red
- color
.green
)
1431 < max (color
.red
, color
.green
) / 20)
1432 && (abs (color
.green
- color
.blue
)
1433 < max (color
.green
, color
.blue
) / 20)
1434 && (abs (color
.blue
- color
.red
)
1435 < max (color
.blue
, color
.red
) / 20));
1443 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1444 BACKGROUND_P non-zero means the color will be used as background
1448 face_color_supported_p (f
, color_name
, background_p
)
1456 XSETFRAME (frame
, f
);
1457 return (FRAME_WINDOW_P (f
)
1458 ? (!NILP (Fxw_display_color_p (frame
))
1459 || xstricmp (color_name
, "black") == 0
1460 || xstricmp (color_name
, "white") == 0
1462 && face_color_gray_p (f
, color_name
))
1463 || (!NILP (Fx_display_grayscale_p (frame
))
1464 && face_color_gray_p (f
, color_name
)))
1465 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1469 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1470 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1471 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1472 If FRAME is nil or omitted, use the selected frame.")
1474 Lisp_Object color
, frame
;
1478 CHECK_FRAME (frame
, 0);
1479 CHECK_STRING (color
, 0);
1481 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1485 DEFUN ("color-supported-p", Fcolor_supported_p
,
1486 Scolor_supported_p
, 2, 3, 0,
1487 "Return non-nil if COLOR can be displayed on FRAME.\n\
1488 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1489 If FRAME is nil or omitted, use the selected frame.\n\
1490 COLOR must be a valid color name.")
1491 (color
, frame
, background_p
)
1492 Lisp_Object frame
, color
, background_p
;
1496 CHECK_FRAME (frame
, 0);
1497 CHECK_STRING (color
, 0);
1499 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1505 /* Load color with name NAME for use by face FACE on frame F.
1506 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1507 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1508 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1509 pixel color. If color cannot be loaded, display a message, and
1510 return the foreground, background or underline color of F, but
1511 record that fact in flags of the face so that we don't try to free
1515 load_color (f
, face
, name
, target_index
)
1519 enum lface_attribute_index target_index
;
1523 xassert (STRINGP (name
));
1524 xassert (target_index
== LFACE_FOREGROUND_INDEX
1525 || target_index
== LFACE_BACKGROUND_INDEX
1526 || target_index
== LFACE_UNDERLINE_INDEX
1527 || target_index
== LFACE_OVERLINE_INDEX
1528 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1529 || target_index
== LFACE_BOX_INDEX
);
1531 /* if the color map is full, defined_color will return a best match
1532 to the values in an existing cell. */
1533 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1535 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1537 switch (target_index
)
1539 case LFACE_FOREGROUND_INDEX
:
1540 face
->foreground_defaulted_p
= 1;
1541 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1544 case LFACE_BACKGROUND_INDEX
:
1545 face
->background_defaulted_p
= 1;
1546 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1549 case LFACE_UNDERLINE_INDEX
:
1550 face
->underline_defaulted_p
= 1;
1551 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1554 case LFACE_OVERLINE_INDEX
:
1555 face
->overline_color_defaulted_p
= 1;
1556 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1559 case LFACE_STRIKE_THROUGH_INDEX
:
1560 face
->strike_through_color_defaulted_p
= 1;
1561 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1564 case LFACE_BOX_INDEX
:
1565 face
->box_color_defaulted_p
= 1;
1566 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1575 ++ncolors_allocated
;
1582 #ifdef HAVE_WINDOW_SYSTEM
1584 /* Load colors for face FACE which is used on frame F. Colors are
1585 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1586 of ATTRS. If the background color specified is not supported on F,
1587 try to emulate gray colors with a stipple from Vface_default_stipple. */
1590 load_face_colors (f
, face
, attrs
)
1597 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1598 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1600 /* Swap colors if face is inverse-video. */
1601 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1609 /* Check for support for foreground, not for background because
1610 face_color_supported_p is smart enough to know that grays are
1611 "supported" as background because we are supposed to use stipple
1613 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1614 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1616 x_destroy_bitmap (f
, face
->stipple
);
1617 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1618 &face
->pixmap_w
, &face
->pixmap_h
);
1621 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1622 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1626 /* Free color PIXEL on frame F. */
1629 unload_color (f
, pixel
)
1631 unsigned long pixel
;
1633 #ifdef HAVE_X_WINDOWS
1635 x_free_colors (f
, &pixel
, 1);
1641 /* Free colors allocated for FACE. */
1644 free_face_colors (f
, face
)
1648 #ifdef HAVE_X_WINDOWS
1651 if (!face
->foreground_defaulted_p
)
1653 x_free_colors (f
, &face
->foreground
, 1);
1654 IF_DEBUG (--ncolors_allocated
);
1657 if (!face
->background_defaulted_p
)
1659 x_free_colors (f
, &face
->background
, 1);
1660 IF_DEBUG (--ncolors_allocated
);
1663 if (face
->underline_p
1664 && !face
->underline_defaulted_p
)
1666 x_free_colors (f
, &face
->underline_color
, 1);
1667 IF_DEBUG (--ncolors_allocated
);
1670 if (face
->overline_p
1671 && !face
->overline_color_defaulted_p
)
1673 x_free_colors (f
, &face
->overline_color
, 1);
1674 IF_DEBUG (--ncolors_allocated
);
1677 if (face
->strike_through_p
1678 && !face
->strike_through_color_defaulted_p
)
1680 x_free_colors (f
, &face
->strike_through_color
, 1);
1681 IF_DEBUG (--ncolors_allocated
);
1684 if (face
->box
!= FACE_NO_BOX
1685 && !face
->box_color_defaulted_p
)
1687 x_free_colors (f
, &face
->box_color
, 1);
1688 IF_DEBUG (--ncolors_allocated
);
1692 #endif /* HAVE_X_WINDOWS */
1695 #endif /* HAVE_WINDOW_SYSTEM */
1699 /***********************************************************************
1701 ***********************************************************************/
1703 /* An enumerator for each field of an XLFD font name. */
1724 /* An enumerator for each possible slant value of a font. Taken from
1725 the XLFD specification. */
1733 XLFD_SLANT_REVERSE_ITALIC
,
1734 XLFD_SLANT_REVERSE_OBLIQUE
,
1738 /* Relative font weight according to XLFD documentation. */
1742 XLFD_WEIGHT_UNKNOWN
,
1743 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1744 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1745 XLFD_WEIGHT_LIGHT
, /* 30 */
1746 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1747 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1748 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1749 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1750 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1751 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1754 /* Relative proportionate width. */
1758 XLFD_SWIDTH_UNKNOWN
,
1759 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1760 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1761 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1762 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1763 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1764 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1765 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1766 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1767 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1770 /* Structure used for tables mapping XLFD weight, slant, and width
1771 names to numeric and symbolic values. */
1777 Lisp_Object
*symbol
;
1780 /* Table of XLFD slant names and their numeric and symbolic
1781 representations. This table must be sorted by slant names in
1784 static struct table_entry slant_table
[] =
1786 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1787 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1788 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1789 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1790 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1791 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1794 /* Table of XLFD weight names. This table must be sorted by weight
1795 names in ascending order. */
1797 static struct table_entry weight_table
[] =
1799 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1800 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1801 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1802 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1803 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1804 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1805 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1806 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1807 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1808 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1809 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1810 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1811 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1812 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1813 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1814 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1817 /* Table of XLFD width names. This table must be sorted by width
1818 names in ascending order. */
1820 static struct table_entry swidth_table
[] =
1822 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1823 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1824 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1825 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1826 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1827 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1828 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1829 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1830 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1831 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1832 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1833 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1834 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1835 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1836 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1839 /* Structure used to hold the result of splitting font names in XLFD
1840 format into their fields. */
1844 /* The original name which is modified destructively by
1845 split_font_name. The pointer is kept here to be able to free it
1846 if it was allocated from the heap. */
1849 /* Font name fields. Each vector element points into `name' above.
1850 Fields are NUL-terminated. */
1851 char *fields
[XLFD_LAST
];
1853 /* Numeric values for those fields that interest us. See
1854 split_font_name for which these are. */
1855 int numeric
[XLFD_LAST
];
1857 /* Lower value mean higher priority. */
1858 int registry_priority
;
1861 /* The frame in effect when sorting font names. Set temporarily in
1862 sort_fonts so that it is available in font comparison functions. */
1864 static struct frame
*font_frame
;
1866 /* Order by which font selection chooses fonts. The default values
1867 mean `first, find a best match for the font width, then for the
1868 font height, then for weight, then for slant.' This variable can be
1869 set via set-face-font-sort-order. */
1872 static int font_sort_order
[4] = {
1873 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1876 static int font_sort_order
[4];
1879 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1880 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1881 is a pointer to the matching table entry or null if no table entry
1884 static struct table_entry
*
1885 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1886 struct table_entry
*table
;
1888 struct font_name
*font
;
1891 /* Function split_font_name converts fields to lower-case, so there
1892 is no need to use xstrlwr or xstricmp here. */
1893 char *s
= font
->fields
[field_index
];
1894 int low
, mid
, high
, cmp
;
1901 mid
= (low
+ high
) / 2;
1902 cmp
= strcmp (table
[mid
].name
, s
);
1916 /* Return a numeric representation for font name field
1917 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1918 has DIM entries. Value is the numeric value found or DFLT if no
1919 table entry matches. This function is used to translate weight,
1920 slant, and swidth names of XLFD font names to numeric values. */
1923 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1924 struct table_entry
*table
;
1926 struct font_name
*font
;
1930 struct table_entry
*p
;
1931 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1932 return p
? p
->numeric
: dflt
;
1936 /* Return a symbolic representation for font name field
1937 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1938 has DIM entries. Value is the symbolic value found or DFLT if no
1939 table entry matches. This function is used to translate weight,
1940 slant, and swidth names of XLFD font names to symbols. */
1942 static INLINE Lisp_Object
1943 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1944 struct table_entry
*table
;
1946 struct font_name
*font
;
1950 struct table_entry
*p
;
1951 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1952 return p
? *p
->symbol
: dflt
;
1956 /* Return a numeric value for the slant of the font given by FONT. */
1959 xlfd_numeric_slant (font
)
1960 struct font_name
*font
;
1962 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1963 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1967 /* Return a symbol representing the weight of the font given by FONT. */
1969 static INLINE Lisp_Object
1970 xlfd_symbolic_slant (font
)
1971 struct font_name
*font
;
1973 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1974 font
, XLFD_SLANT
, Qnormal
);
1978 /* Return a numeric value for the weight of the font given by FONT. */
1981 xlfd_numeric_weight (font
)
1982 struct font_name
*font
;
1984 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1985 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1989 /* Return a symbol representing the slant of the font given by FONT. */
1991 static INLINE Lisp_Object
1992 xlfd_symbolic_weight (font
)
1993 struct font_name
*font
;
1995 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1996 font
, XLFD_WEIGHT
, Qnormal
);
2000 /* Return a numeric value for the swidth of the font whose XLFD font
2001 name fields are found in FONT. */
2004 xlfd_numeric_swidth (font
)
2005 struct font_name
*font
;
2007 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2008 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2012 /* Return a symbolic value for the swidth of FONT. */
2014 static INLINE Lisp_Object
2015 xlfd_symbolic_swidth (font
)
2016 struct font_name
*font
;
2018 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2019 font
, XLFD_SWIDTH
, Qnormal
);
2023 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2024 entries. Value is a pointer to the matching table entry or null if
2025 no element of TABLE contains SYMBOL. */
2027 static struct table_entry
*
2028 face_value (table
, dim
, symbol
)
2029 struct table_entry
*table
;
2035 xassert (SYMBOLP (symbol
));
2037 for (i
= 0; i
< dim
; ++i
)
2038 if (EQ (*table
[i
].symbol
, symbol
))
2041 return i
< dim
? table
+ i
: NULL
;
2045 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2046 entries. Value is -1 if SYMBOL is not found in TABLE. */
2049 face_numeric_value (table
, dim
, symbol
)
2050 struct table_entry
*table
;
2054 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2055 return p
? p
->numeric
: -1;
2059 /* Return a numeric value representing the weight specified by Lisp
2060 symbol WEIGHT. Value is one of the enumerators of enum
2064 face_numeric_weight (weight
)
2067 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2071 /* Return a numeric value representing the slant specified by Lisp
2072 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2075 face_numeric_slant (slant
)
2078 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2082 /* Return a numeric value representing the swidth specified by Lisp
2083 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2086 face_numeric_swidth (width
)
2089 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2093 #ifdef HAVE_WINDOW_SYSTEM
2095 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2099 struct font_name
*font
;
2101 /* Function split_font_name converts fields to lower-case, so there
2102 is no need to use tolower here. */
2103 return *font
->fields
[XLFD_SPACING
] != 'p';
2107 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2109 The actual height of the font when displayed on F depends on the
2110 resolution of both the font and frame. For example, a 10pt font
2111 designed for a 100dpi display will display larger than 10pt on a
2112 75dpi display. (It's not unusual to use fonts not designed for the
2113 display one is using. For example, some intlfonts are available in
2114 72dpi versions, only.)
2116 Value is the real point size of FONT on frame F, or 0 if it cannot
2120 xlfd_point_size (f
, font
)
2122 struct font_name
*font
;
2124 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2125 double font_pixel
= atoi (font
->fields
[XLFD_PIXEL_SIZE
]);
2128 if (font_pixel
== 0)
2131 real_pt
= PT_PER_INCH
* 10.0 * font_pixel
/ resy
+ 0.5;
2137 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2138 of frame F. This function is used to guess a point size of font
2139 when only the pixel height of the font is available. */
2142 pixel_point_size (f
, pixel
)
2146 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2150 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2151 point size of one dot. */
2152 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2153 int_pt
= real_pt
+ 0.5;
2159 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2160 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2161 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2162 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2163 zero if the font name doesn't have the format we expect. The
2164 expected format is a font name that starts with a `-' and has
2165 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2166 forms of font names where certain field contents are enclosed in
2167 square brackets. We don't support that, for now. */
2170 split_font_name (f
, font
, numeric_p
)
2172 struct font_name
*font
;
2178 if (*font
->name
== '-')
2180 char *p
= xstrlwr (font
->name
) + 1;
2182 while (i
< XLFD_LAST
)
2184 font
->fields
[i
] = p
;
2187 while (*p
&& *p
!= '-')
2197 success_p
= i
== XLFD_LAST
;
2199 /* If requested, and font name was in the expected format,
2200 compute numeric values for some fields. */
2201 if (numeric_p
&& success_p
)
2203 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2204 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2205 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2206 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2207 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2208 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2211 /* Initialize it to zero. It will be overridden by font_list while
2212 trying alternate registries. */
2213 font
->registry_priority
= 0;
2219 /* Build an XLFD font name from font name fields in FONT. Value is a
2220 pointer to the font name, which is allocated via xmalloc. */
2223 build_font_name (font
)
2224 struct font_name
*font
;
2228 char *font_name
= (char *) xmalloc (size
);
2229 int total_length
= 0;
2231 for (i
= 0; i
< XLFD_LAST
; ++i
)
2233 /* Add 1 because of the leading `-'. */
2234 int len
= strlen (font
->fields
[i
]) + 1;
2236 /* Reallocate font_name if necessary. Add 1 for the final
2238 if (total_length
+ len
+ 1 >= size
)
2240 int new_size
= max (2 * size
, size
+ len
+ 1);
2241 int sz
= new_size
* sizeof *font_name
;
2242 font_name
= (char *) xrealloc (font_name
, sz
);
2246 font_name
[total_length
] = '-';
2247 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2248 total_length
+= len
;
2251 font_name
[total_length
] = 0;
2256 /* Free an array FONTS of N font_name structures. This frees FONTS
2257 itself and all `name' fields in its elements. */
2260 free_font_names (fonts
, n
)
2261 struct font_name
*fonts
;
2265 xfree (fonts
[--n
].name
);
2270 /* Sort vector FONTS of font_name structures which contains NFONTS
2271 elements using qsort and comparison function CMPFN. F is the frame
2272 on which the fonts will be used. The global variable font_frame
2273 is temporarily set to F to make it available in CMPFN. */
2276 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2278 struct font_name
*fonts
;
2280 int (*cmpfn
) P_ ((const void *, const void *));
2283 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2288 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2289 display in x_display_list. FONTS is a pointer to a vector of
2290 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2291 alternative patterns from Valternate_fontname_alist if no fonts are
2292 found matching PATTERN.
2294 For all fonts found, set FONTS[i].name to the name of the font,
2295 allocated via xmalloc, and split font names into fields. Ignore
2296 fonts that we can't parse. Value is the number of fonts found. */
2299 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2302 struct font_name
*fonts
;
2303 int nfonts
, try_alternatives_p
;
2307 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2308 better to do it the other way around. */
2310 Lisp_Object lpattern
, tem
;
2312 lpattern
= build_string (pattern
);
2314 /* Get the list of fonts matching PATTERN. */
2317 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2320 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2323 /* Make a copy of the font names we got from X, and
2324 split them into fields. */
2326 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2328 Lisp_Object elt
, tail
;
2329 char *name
= XSTRING (XCAR (tem
))->data
;
2331 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2332 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2336 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2345 /* Make a copy of the font name. */
2346 fonts
[n
].name
= xstrdup (name
);
2348 if (split_font_name (f
, fonts
+ n
, 1))
2350 if (font_scalable_p (fonts
+ n
)
2351 && !may_use_scalable_font_p (name
))
2354 xfree (fonts
[n
].name
);
2360 xfree (fonts
[n
].name
);
2363 /* If someone specified a default font that's scalable, try
2364 to do the right thing. */
2365 if (realizing_basic_faces_p
2366 && try_alternatives_p
2370 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2372 fonts
[n
].name
= xstrdup (XSTRING (XCAR (tem
))->data
);
2373 if (split_font_name (f
, fonts
+ n
, 1))
2376 xfree (fonts
[n
].name
);
2380 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2381 if (n
== 0 && try_alternatives_p
)
2383 Lisp_Object list
= Valternate_fontname_alist
;
2385 while (CONSP (list
))
2387 Lisp_Object entry
= XCAR (list
);
2389 && STRINGP (XCAR (entry
))
2390 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2397 Lisp_Object patterns
= XCAR (list
);
2400 while (CONSP (patterns
)
2401 /* If list is screwed up, give up. */
2402 && (name
= XCAR (patterns
),
2404 /* Ignore patterns equal to PATTERN because we tried that
2405 already with no success. */
2406 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2407 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2410 patterns
= XCDR (patterns
);
2418 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2419 using comparison function CMPFN. Value is the number of fonts
2420 found. If value is non-zero, *FONTS is set to a vector of
2421 font_name structures allocated from the heap containing matching
2422 fonts. Each element of *FONTS contains a name member that is also
2423 allocated from the heap. Font names in these structures are split
2424 into fields. Use free_font_names to free such an array. */
2427 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2430 int (*cmpfn
) P_ ((const void *, const void *));
2431 struct font_name
**fonts
;
2435 /* Get the list of fonts matching pattern. 100 should suffice. */
2436 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2437 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2438 nfonts
= XFASTINT (Vfont_list_limit
);
2440 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2441 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2443 /* Sort the resulting array and return it in *FONTS. If no
2444 fonts were found, make sure to set *FONTS to null. */
2446 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2457 /* Compare two font_name structures *A and *B. Value is analogous to
2458 strcmp. Sort order is given by the global variable
2459 font_sort_order. Font names are sorted so that, everything else
2460 being equal, fonts with a resolution closer to that of the frame on
2461 which they are used are listed first. The global variable
2462 font_frame is the frame on which we operate. */
2465 cmp_font_names (a
, b
)
2468 struct font_name
*x
= (struct font_name
*) a
;
2469 struct font_name
*y
= (struct font_name
*) b
;
2472 /* All strings have been converted to lower-case by split_font_name,
2473 so we can use strcmp here. */
2474 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2479 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2481 int j
= font_sort_order
[i
];
2482 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2487 /* Everything else being equal, we prefer fonts with an
2488 y-resolution closer to that of the frame. */
2489 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2490 int x_resy
= x
->numeric
[XLFD_RESY
];
2491 int y_resy
= y
->numeric
[XLFD_RESY
];
2492 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2500 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2501 is non-nil list fonts matching that pattern. Otherwise, if
2502 REGISTRY is non-nil return only fonts with that registry, otherwise
2503 return fonts of any registry. Set *FONTS to a vector of font_name
2504 structures allocated from the heap containing the fonts found.
2505 Value is the number of fonts found. */
2508 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2510 Lisp_Object pattern
, family
, registry
;
2511 struct font_name
**fonts
;
2513 char *pattern_str
, *family_str
, *registry_str
;
2517 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2518 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2520 pattern_str
= (char *) alloca (strlen (family_str
)
2521 + strlen (registry_str
)
2523 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2524 strcat (pattern_str
, family_str
);
2525 strcat (pattern_str
, "-*-");
2526 strcat (pattern_str
, registry_str
);
2527 if (!index (registry_str
, '-'))
2529 if (registry_str
[strlen (registry_str
) - 1] == '*')
2530 strcat (pattern_str
, "-*");
2532 strcat (pattern_str
, "*-*");
2536 pattern_str
= (char *) XSTRING (pattern
)->data
;
2538 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2542 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2543 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2544 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2547 static struct font_name
*
2548 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2549 struct font_name
*fonts1
, *fonts2
;
2550 int nfonts1
, nfonts2
;
2552 int new_nfonts
= nfonts1
+ nfonts2
;
2553 struct font_name
*new_fonts
;
2555 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2556 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2557 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2564 /* Get a sorted list of fonts of family FAMILY on frame F.
2566 If PATTERN is non-nil list fonts matching that pattern.
2568 If REGISTRY is non-nil, return fonts with that registry and the
2569 alternative registries from Vface_alternative_font_registry_alist.
2571 If REGISTRY is nil return fonts of any registry.
2573 Set *FONTS to a vector of font_name structures allocated from the
2574 heap containing the fonts found. Value is the number of fonts
2578 font_list (f
, pattern
, family
, registry
, fonts
)
2580 Lisp_Object pattern
, family
, registry
;
2581 struct font_name
**fonts
;
2583 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2585 if (!NILP (registry
)
2586 && CONSP (Vface_alternative_font_registry_alist
))
2590 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2595 for (alter
= XCDR (alter
), reg_prio
= 1;
2597 alter
= XCDR (alter
), reg_prio
++)
2598 if (STRINGP (XCAR (alter
)))
2601 struct font_name
*fonts2
;
2603 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2605 for (i
= 0; i
< nfonts2
; i
++)
2606 fonts2
[i
].registry_priority
= reg_prio
;
2607 *fonts
= (nfonts
> 0
2608 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2619 /* Remove elements from LIST whose cars are `equal'. Called from
2620 x-family-fonts and x-font-family-list to remove duplicate font
2624 remove_duplicates (list
)
2627 Lisp_Object tail
= list
;
2629 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2631 Lisp_Object next
= XCDR (tail
);
2632 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2633 XCDR (tail
) = XCDR (next
);
2640 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2641 "Return a list of available fonts of family FAMILY on FRAME.\n\
2642 If FAMILY is omitted or nil, list all families.\n\
2643 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2645 If FRAME is omitted or nil, use the selected frame.\n\
2646 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2647 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2648 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2649 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2650 width, weight and slant of the font. These symbols are the same as for\n\
2651 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2652 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2653 giving the registry and encoding of the font.\n\
2654 The result list is sorted according to the current setting of\n\
2655 the face font sort order.")
2657 Lisp_Object family
, frame
;
2659 struct frame
*f
= check_x_frame (frame
);
2660 struct font_name
*fonts
;
2663 struct gcpro gcpro1
;
2666 CHECK_STRING (family
, 1);
2670 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2671 for (i
= nfonts
- 1; i
>= 0; --i
)
2673 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2676 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2677 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2678 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2679 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2680 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2681 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2682 tem
= build_font_name (fonts
+ i
);
2683 ASET (v
, 6, build_string (tem
));
2684 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2685 fonts
[i
].fields
[XLFD_ENCODING
]);
2686 ASET (v
, 7, build_string (tem
));
2689 result
= Fcons (v
, result
);
2692 remove_duplicates (result
);
2693 free_font_names (fonts
, nfonts
);
2699 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2701 "Return a list of available font families on FRAME.\n\
2702 If FRAME is omitted or nil, use the selected frame.\n\
2703 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2704 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2709 struct frame
*f
= check_x_frame (frame
);
2711 struct font_name
*fonts
;
2713 struct gcpro gcpro1
;
2714 int count
= specpdl_ptr
- specpdl
;
2717 /* Let's consider all fonts. Increase the limit for matching
2718 fonts until we have them all. */
2721 specbind (intern ("font-list-limit"), make_number (limit
));
2722 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2724 if (nfonts
== limit
)
2726 free_font_names (fonts
, nfonts
);
2735 for (i
= nfonts
- 1; i
>= 0; --i
)
2736 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2737 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2740 remove_duplicates (result
);
2741 free_font_names (fonts
, nfonts
);
2743 return unbind_to (count
, result
);
2747 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2748 "Return a list of the names of available fonts matching PATTERN.\n\
2749 If optional arguments FACE and FRAME are specified, return only fonts\n\
2750 the same size as FACE on FRAME.\n\
2751 PATTERN is a string, perhaps with wildcard characters;\n\
2752 the * character matches any substring, and\n\
2753 the ? character matches any single character.\n\
2754 PATTERN is case-insensitive.\n\
2755 FACE is a face name--a symbol.\n\
2757 The return value is a list of strings, suitable as arguments to\n\
2760 Fonts Emacs can't use may or may not be excluded\n\
2761 even if they match PATTERN and FACE.\n\
2762 The optional fourth argument MAXIMUM sets a limit on how many\n\
2763 fonts to match. The first MAXIMUM fonts are reported.\n\
2764 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2765 occupied by a character of a font. In that case, return only fonts\n\
2766 the WIDTH times as wide as FACE on FRAME.")
2767 (pattern
, face
, frame
, maximum
, width
)
2768 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2775 CHECK_STRING (pattern
, 0);
2781 CHECK_NATNUM (maximum
, 0);
2782 maxnames
= XINT (maximum
);
2786 CHECK_NUMBER (width
, 4);
2788 /* We can't simply call check_x_frame because this function may be
2789 called before any frame is created. */
2790 f
= frame_or_selected_frame (frame
, 2);
2791 if (!FRAME_WINDOW_P (f
))
2793 /* Perhaps we have not yet created any frame. */
2798 /* Determine the width standard for comparison with the fonts we find. */
2804 /* This is of limited utility since it works with character
2805 widths. Keep it for compatibility. --gerd. */
2806 int face_id
= lookup_named_face (f
, face
, 0);
2807 struct face
*face
= (face_id
< 0
2809 : FACE_FROM_ID (f
, face_id
));
2811 if (face
&& face
->font
)
2812 size
= FONT_WIDTH (face
->font
);
2814 size
= FONT_WIDTH (FRAME_FONT (f
));
2817 size
*= XINT (width
);
2821 Lisp_Object args
[2];
2823 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2825 /* We don't have to check fontsets. */
2827 args
[1] = list_fontsets (f
, pattern
, size
);
2828 return Fnconc (2, args
);
2832 #endif /* HAVE_WINDOW_SYSTEM */
2836 /***********************************************************************
2838 ***********************************************************************/
2840 /* Access face attributes of face LFACE, a Lisp vector. */
2842 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2843 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2844 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2845 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2846 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2847 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2848 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2849 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2850 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2851 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2852 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2853 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2854 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2855 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2856 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2857 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2859 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2860 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2862 #define LFACEP(LFACE) \
2864 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2865 && EQ (AREF (LFACE, 0), Qface))
2870 /* Check consistency of Lisp face attribute vector ATTRS. */
2873 check_lface_attrs (attrs
)
2876 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2877 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2878 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2879 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2880 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2881 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2882 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2883 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2884 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2885 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2886 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2887 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2888 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2889 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2890 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2891 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2892 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2893 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2894 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2895 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2896 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2897 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2898 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2899 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2900 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2901 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2902 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2903 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2904 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2905 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2906 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2907 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2908 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2909 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2910 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2911 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2912 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2913 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2914 #ifdef HAVE_WINDOW_SYSTEM
2915 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2916 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2917 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2918 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2919 || NILP (attrs
[LFACE_FONT_INDEX
])
2920 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2925 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2933 xassert (LFACEP (lface
));
2934 check_lface_attrs (XVECTOR (lface
)->contents
);
2938 #else /* GLYPH_DEBUG == 0 */
2940 #define check_lface_attrs(attrs) (void) 0
2941 #define check_lface(lface) (void) 0
2943 #endif /* GLYPH_DEBUG == 0 */
2946 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2947 to make it a symvol. If FACE_NAME is an alias for another face,
2948 return that face's name. */
2951 resolve_face_name (face_name
)
2952 Lisp_Object face_name
;
2954 Lisp_Object aliased
;
2956 if (STRINGP (face_name
))
2957 face_name
= intern (XSTRING (face_name
)->data
);
2959 while (SYMBOLP (face_name
))
2961 aliased
= Fget (face_name
, Qface_alias
);
2965 face_name
= aliased
;
2972 /* Return the face definition of FACE_NAME on frame F. F null means
2973 return the definition for new frames. FACE_NAME may be a string or
2974 a symbol (apparently Emacs 20.2 allowed strings as face names in
2975 face text properties; Ediff uses that). If FACE_NAME is an alias
2976 for another face, return that face's definition. If SIGNAL_P is
2977 non-zero, signal an error if FACE_NAME is not a valid face name.
2978 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2981 static INLINE Lisp_Object
2982 lface_from_face_name (f
, face_name
, signal_p
)
2984 Lisp_Object face_name
;
2989 face_name
= resolve_face_name (face_name
);
2992 lface
= assq_no_quit (face_name
, f
->face_alist
);
2994 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2997 lface
= XCDR (lface
);
2999 signal_error ("Invalid face", face_name
);
3001 check_lface (lface
);
3006 /* Get face attributes of face FACE_NAME from frame-local faces on
3007 frame F. Store the resulting attributes in ATTRS which must point
3008 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3009 is non-zero, signal an error if FACE_NAME does not name a face.
3010 Otherwise, value is zero if FACE_NAME is not a face. */
3013 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3015 Lisp_Object face_name
;
3022 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3025 bcopy (XVECTOR (lface
)->contents
, attrs
,
3026 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3036 /* Non-zero if all attributes in face attribute vector ATTRS are
3037 specified, i.e. are non-nil. */
3040 lface_fully_specified_p (attrs
)
3045 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3046 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3047 && i
!= LFACE_AVGWIDTH_INDEX
)
3048 if (UNSPECIFIEDP (attrs
[i
]))
3051 return i
== LFACE_VECTOR_SIZE
;
3054 #ifdef HAVE_WINDOW_SYSTEM
3056 /* Set font-related attributes of Lisp face LFACE from the fullname of
3057 the font opened by FONTNAME. If FORCE_P is zero, set only
3058 unspecified attributes of LFACE. The exception is `font'
3059 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3061 If FONTNAME is not available on frame F,
3062 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3063 If the fullname is not in a valid XLFD format,
3064 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3065 in LFACE and return 1.
3066 Otherwise, return 1. */
3069 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3072 Lisp_Object fontname
;
3073 int force_p
, may_fail_p
;
3075 struct font_name font
;
3080 char *font_name
= XSTRING (fontname
)->data
;
3081 struct font_info
*font_info
;
3083 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3084 fontset
= fs_query_fontset (fontname
, 0);
3086 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3088 /* Check if FONT_NAME is surely available on the system. Usually
3089 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3090 returns quickly. But, even if FONT_NAME is not yet cached,
3091 caching it now is not futail because we anyway load the font
3094 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3104 font
.name
= STRDUPA (font_info
->full_name
);
3105 have_xlfd_p
= split_font_name (f
, &font
, 1);
3107 /* Set attributes only if unspecified, otherwise face defaults for
3108 new frames would never take effect. If we couldn't get a font
3109 name conforming to XLFD, set normal values. */
3111 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3116 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3117 + strlen (font
.fields
[XLFD_FOUNDRY
])
3119 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3120 font
.fields
[XLFD_FAMILY
]);
3121 val
= build_string (buffer
);
3124 val
= build_string ("*");
3125 LFACE_FAMILY (lface
) = val
;
3128 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3131 pt
= xlfd_point_size (f
, &font
);
3133 pt
= pixel_point_size (f
, font_info
->height
* 10);
3135 LFACE_HEIGHT (lface
) = make_number (pt
);
3138 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3139 LFACE_SWIDTH (lface
)
3140 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3142 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3143 LFACE_AVGWIDTH (lface
)
3145 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3148 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3149 LFACE_WEIGHT (lface
)
3150 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3152 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3154 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3156 LFACE_FONT (lface
) = fontname
;
3161 #endif /* HAVE_WINDOW_SYSTEM */
3164 /* Merges the face height FROM with the face height TO, and returns the
3165 merged height. If FROM is an invalid height, then INVALID is
3166 returned instead. FROM may be a either an absolute face height or a
3167 `relative' height, and TO must be an absolute height. The returned
3168 value is always an absolute height. GCPRO is a lisp value that will
3169 be protected from garbage-collection if this function makes a call
3173 merge_face_heights (from
, to
, invalid
, gcpro
)
3174 Lisp_Object from
, to
, invalid
, gcpro
;
3178 if (INTEGERP (from
))
3179 result
= XINT (from
);
3180 else if (NUMBERP (from
))
3181 result
= XFLOATINT (from
) * XINT (to
);
3182 #if 0 /* Probably not so useful. */
3183 else if (CONSP (from
) && CONSP (XCDR (from
)))
3185 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3187 if (INTEGERP (XCAR (XCDR (from
))))
3189 int inc
= XINT (XCAR (XCDR (from
)));
3190 if (EQ (XCAR (from
), Qminus
))
3193 result
= XFASTINT (to
);
3194 if (result
+ inc
> 0)
3195 /* Note that `underflows' don't mean FROM is invalid, so
3196 we just pin the result at TO if it would otherwise be
3203 else if (FUNCTIONP (from
))
3205 /* Call function with current height as argument.
3206 From is the new height. */
3207 Lisp_Object args
[2], height
;
3208 struct gcpro gcpro1
;
3214 height
= safe_call (2, args
);
3218 if (NUMBERP (height
))
3219 result
= XFLOATINT (height
);
3223 return make_number (result
);
3229 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3230 store the resulting attributes in TO, which must be already be
3231 completely specified and contain only absolute attributes. Every
3232 specified attribute of FROM overrides the corresponding attribute of
3233 TO; relative attributes in FROM are merged with the absolute value in
3234 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3235 face inheritance; it should be Qnil when called from other places. */
3238 merge_face_vectors (f
, from
, to
, cycle_check
)
3240 Lisp_Object
*from
, *to
;
3241 Lisp_Object cycle_check
;
3245 /* If FROM inherits from some other faces, merge their attributes into
3246 TO before merging FROM's direct attributes. Note that an :inherit
3247 attribute of `unspecified' is the same as one of nil; we never
3248 merge :inherit attributes, so nil is more correct, but lots of
3249 other code uses `unspecified' as a generic value for face attributes. */
3250 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3251 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3252 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3254 /* If TO specifies a :font attribute, and FROM specifies some
3255 font-related attribute, we need to clear TO's :font attribute
3256 (because it will be inconsistent with whatever FROM specifies, and
3257 FROM takes precedence). */
3258 if (!NILP (to
[LFACE_FONT_INDEX
])
3259 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3260 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3261 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3262 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3263 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3264 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3265 to
[LFACE_FONT_INDEX
] = Qnil
;
3267 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3268 if (!UNSPECIFIEDP (from
[i
]))
3269 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3270 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3274 /* TO is always an absolute face, which should inherit from nothing.
3275 We blindly copy the :inherit attribute above and fix it up here. */
3276 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3280 /* Checks the `cycle check' variable CHECK to see if it indicates that
3281 EL is part of a cycle; CHECK must be either Qnil or a value returned
3282 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3283 elements after which a cycle might be suspected; after that many
3284 elements, this macro begins consing in order to keep more precise
3287 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3290 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3291 the caller should make sure that's ok. */
3293 #define CYCLE_CHECK(check, el, suspicious) \
3296 : (INTEGERP (check) \
3297 ? (XFASTINT (check) < (suspicious) \
3298 ? make_number (XFASTINT (check) + 1) \
3299 : Fcons (el, Qnil)) \
3300 : (!NILP (Fmemq ((el), (check))) \
3302 : Fcons ((el), (check)))))
3305 /* Merge face attributes from the face on frame F whose name is
3306 INHERITS, into the vector of face attributes TO; INHERITS may also be
3307 a list of face names, in which case they are applied in order.
3308 CYCLE_CHECK is used to detect loops in face inheritance.
3309 Returns true if any of the inherited attributes are `font-related'. */
3312 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3314 Lisp_Object inherit
;
3316 Lisp_Object cycle_check
;
3318 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3319 /* Inherit from the named face INHERIT. */
3323 /* Make sure we're not in an inheritance loop. */
3324 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3325 if (NILP (cycle_check
))
3326 /* Cycle detected, ignore any further inheritance. */
3329 lface
= lface_from_face_name (f
, inherit
, 0);
3331 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3333 else if (CONSP (inherit
))
3334 /* Handle a list of inherited faces by calling ourselves recursively
3335 on each element. Note that we only do so for symbol elements, so
3336 it's not possible to infinitely recurse. */
3338 while (CONSP (inherit
))
3340 if (SYMBOLP (XCAR (inherit
)))
3341 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3343 /* Check for a circular inheritance list. */
3344 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3345 if (NILP (cycle_check
))
3346 /* Cycle detected. */
3349 inherit
= XCDR (inherit
);
3355 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3356 is a face property, determine the resulting face attributes on
3357 frame F, and store them in TO. PROP may be a single face
3358 specification or a list of such specifications. Each face
3359 specification can be
3361 1. A symbol or string naming a Lisp face.
3363 2. A property list of the form (KEYWORD VALUE ...) where each
3364 KEYWORD is a face attribute name, and value is an appropriate value
3367 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3368 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3369 for compatibility with 20.2.
3371 Face specifications earlier in lists take precedence over later
3375 merge_face_vector_with_property (f
, to
, prop
)
3382 Lisp_Object first
= XCAR (prop
);
3384 if (EQ (first
, Qforeground_color
)
3385 || EQ (first
, Qbackground_color
))
3387 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3388 . COLOR). COLOR must be a string. */
3389 Lisp_Object color_name
= XCDR (prop
);
3390 Lisp_Object color
= first
;
3392 if (STRINGP (color_name
))
3394 if (EQ (color
, Qforeground_color
))
3395 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3397 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3400 add_to_log ("Invalid face color", color_name
, Qnil
);
3402 else if (SYMBOLP (first
)
3403 && *XSYMBOL (first
)->name
->data
== ':')
3405 /* Assume this is the property list form. */
3406 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3408 Lisp_Object keyword
= XCAR (prop
);
3409 Lisp_Object value
= XCAR (XCDR (prop
));
3411 if (EQ (keyword
, QCfamily
))
3413 if (STRINGP (value
))
3414 to
[LFACE_FAMILY_INDEX
] = value
;
3416 add_to_log ("Invalid face font family", value
, Qnil
);
3418 else if (EQ (keyword
, QCheight
))
3420 Lisp_Object new_height
=
3421 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3424 if (NILP (new_height
))
3425 add_to_log ("Invalid face font height", value
, Qnil
);
3427 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3429 else if (EQ (keyword
, QCweight
))
3432 && face_numeric_weight (value
) >= 0)
3433 to
[LFACE_WEIGHT_INDEX
] = value
;
3435 add_to_log ("Invalid face weight", value
, Qnil
);
3437 else if (EQ (keyword
, QCslant
))
3440 && face_numeric_slant (value
) >= 0)
3441 to
[LFACE_SLANT_INDEX
] = value
;
3443 add_to_log ("Invalid face slant", value
, Qnil
);
3445 else if (EQ (keyword
, QCunderline
))
3450 to
[LFACE_UNDERLINE_INDEX
] = value
;
3452 add_to_log ("Invalid face underline", value
, Qnil
);
3454 else if (EQ (keyword
, QCoverline
))
3459 to
[LFACE_OVERLINE_INDEX
] = value
;
3461 add_to_log ("Invalid face overline", value
, Qnil
);
3463 else if (EQ (keyword
, QCstrike_through
))
3468 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3470 add_to_log ("Invalid face strike-through", value
, Qnil
);
3472 else if (EQ (keyword
, QCbox
))
3475 value
= make_number (1);
3476 if (INTEGERP (value
)
3480 to
[LFACE_BOX_INDEX
] = value
;
3482 add_to_log ("Invalid face box", value
, Qnil
);
3484 else if (EQ (keyword
, QCinverse_video
)
3485 || EQ (keyword
, QCreverse_video
))
3487 if (EQ (value
, Qt
) || NILP (value
))
3488 to
[LFACE_INVERSE_INDEX
] = value
;
3490 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3492 else if (EQ (keyword
, QCforeground
))
3494 if (STRINGP (value
))
3495 to
[LFACE_FOREGROUND_INDEX
] = value
;
3497 add_to_log ("Invalid face foreground", value
, Qnil
);
3499 else if (EQ (keyword
, QCbackground
))
3501 if (STRINGP (value
))
3502 to
[LFACE_BACKGROUND_INDEX
] = value
;
3504 add_to_log ("Invalid face background", value
, Qnil
);
3506 else if (EQ (keyword
, QCstipple
))
3508 #ifdef HAVE_X_WINDOWS
3509 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3510 if (!NILP (pixmap_p
))
3511 to
[LFACE_STIPPLE_INDEX
] = value
;
3513 add_to_log ("Invalid face stipple", value
, Qnil
);
3516 else if (EQ (keyword
, QCwidth
))
3519 && face_numeric_swidth (value
) >= 0)
3520 to
[LFACE_SWIDTH_INDEX
] = value
;
3522 add_to_log ("Invalid face width", value
, Qnil
);
3524 else if (EQ (keyword
, QCinherit
))
3526 if (SYMBOLP (value
))
3527 to
[LFACE_INHERIT_INDEX
] = value
;
3531 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3532 if (!SYMBOLP (XCAR (tail
)))
3535 to
[LFACE_INHERIT_INDEX
] = value
;
3537 add_to_log ("Invalid face inherit", value
, Qnil
);
3541 add_to_log ("Invalid attribute %s in face property",
3544 prop
= XCDR (XCDR (prop
));
3549 /* This is a list of face specs. Specifications at the
3550 beginning of the list take precedence over later
3551 specifications, so we have to merge starting with the
3552 last specification. */
3553 Lisp_Object next
= XCDR (prop
);
3555 merge_face_vector_with_property (f
, to
, next
);
3556 merge_face_vector_with_property (f
, to
, first
);
3561 /* PROP ought to be a face name. */
3562 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3564 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3566 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3571 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3572 Sinternal_make_lisp_face
, 1, 2, 0,
3573 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3574 If FACE was not known as a face before, create a new one.\n\
3575 If optional argument FRAME is specified, make a frame-local face\n\
3576 for that frame. Otherwise operate on the global face definition.\n\
3577 Value is a vector of face attributes.")
3579 Lisp_Object face
, frame
;
3581 Lisp_Object global_lface
, lface
;
3585 CHECK_SYMBOL (face
, 0);
3586 global_lface
= lface_from_face_name (NULL
, face
, 0);
3590 CHECK_LIVE_FRAME (frame
, 1);
3592 lface
= lface_from_face_name (f
, face
, 0);
3595 f
= NULL
, lface
= Qnil
;
3597 /* Add a global definition if there is none. */
3598 if (NILP (global_lface
))
3600 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3602 AREF (global_lface
, 0) = Qface
;
3603 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3604 Vface_new_frame_defaults
);
3606 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3607 face id to Lisp face is given by the vector lface_id_to_name.
3608 The mapping from Lisp face to Lisp face id is given by the
3609 property `face' of the Lisp face name. */
3610 if (next_lface_id
== lface_id_to_name_size
)
3612 int new_size
= max (50, 2 * lface_id_to_name_size
);
3613 int sz
= new_size
* sizeof *lface_id_to_name
;
3614 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3615 lface_id_to_name_size
= new_size
;
3618 lface_id_to_name
[next_lface_id
] = face
;
3619 Fput (face
, Qface
, make_number (next_lface_id
));
3623 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3624 AREF (global_lface
, i
) = Qunspecified
;
3626 /* Add a frame-local definition. */
3631 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3633 AREF (lface
, 0) = Qface
;
3634 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3637 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3638 AREF (lface
, i
) = Qunspecified
;
3641 lface
= global_lface
;
3643 xassert (LFACEP (lface
));
3644 check_lface (lface
);
3649 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3650 Sinternal_lisp_face_p
, 1, 2, 0,
3651 "Return non-nil if FACE names a face.\n\
3652 If optional second parameter FRAME is non-nil, check for the\n\
3653 existence of a frame-local face with name FACE on that frame.\n\
3654 Otherwise check for the existence of a global face.")
3656 Lisp_Object face
, frame
;
3662 CHECK_LIVE_FRAME (frame
, 1);
3663 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3666 lface
= lface_from_face_name (NULL
, face
, 0);
3672 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3673 Sinternal_copy_lisp_face
, 4, 4, 0,
3674 "Copy face FROM to TO.\n\
3675 If FRAME it t, copy the global face definition of FROM to the\n\
3676 global face definition of TO. Otherwise, copy the frame-local\n\
3677 definition of FROM on FRAME to the frame-local definition of TO\n\
3678 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3681 (from
, to
, frame
, new_frame
)
3682 Lisp_Object from
, to
, frame
, new_frame
;
3684 Lisp_Object lface
, copy
;
3686 CHECK_SYMBOL (from
, 0);
3687 CHECK_SYMBOL (to
, 1);
3688 if (NILP (new_frame
))
3693 /* Copy global definition of FROM. We don't make copies of
3694 strings etc. because 20.2 didn't do it either. */
3695 lface
= lface_from_face_name (NULL
, from
, 1);
3696 copy
= Finternal_make_lisp_face (to
, Qnil
);
3700 /* Copy frame-local definition of FROM. */
3701 CHECK_LIVE_FRAME (frame
, 2);
3702 CHECK_LIVE_FRAME (new_frame
, 3);
3703 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3704 copy
= Finternal_make_lisp_face (to
, new_frame
);
3707 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3708 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3714 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3715 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3716 "Set attribute ATTR of FACE to VALUE.\n\
3717 FRAME being a frame means change the face on that frame.\n\
3718 FRAME nil means change change the face of the selected frame.\n\
3719 FRAME t means change the default for new frames.\n\
3720 FRAME 0 means change the face on all frames, and change the default\n\
3722 (face
, attr
, value
, frame
)
3723 Lisp_Object face
, attr
, value
, frame
;
3726 Lisp_Object old_value
= Qnil
;
3727 /* Set 1 if ATTR is QCfont. */
3728 int font_attr_p
= 0;
3729 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3730 int font_related_attr_p
= 0;
3732 CHECK_SYMBOL (face
, 0);
3733 CHECK_SYMBOL (attr
, 1);
3735 face
= resolve_face_name (face
);
3737 /* If FRAME is 0, change face on all frames, and change the
3738 default for new frames. */
3739 if (INTEGERP (frame
) && XINT (frame
) == 0)
3742 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3743 FOR_EACH_FRAME (tail
, frame
)
3744 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3748 /* Set lface to the Lisp attribute vector of FACE. */
3750 lface
= lface_from_face_name (NULL
, face
, 1);
3754 frame
= selected_frame
;
3756 CHECK_LIVE_FRAME (frame
, 3);
3757 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3759 /* If a frame-local face doesn't exist yet, create one. */
3761 lface
= Finternal_make_lisp_face (face
, frame
);
3764 if (EQ (attr
, QCfamily
))
3766 if (!UNSPECIFIEDP (value
))
3768 CHECK_STRING (value
, 3);
3769 if (XSTRING (value
)->size
== 0)
3770 signal_error ("Invalid face family", value
);
3772 old_value
= LFACE_FAMILY (lface
);
3773 LFACE_FAMILY (lface
) = value
;
3774 font_related_attr_p
= 1;
3776 else if (EQ (attr
, QCheight
))
3778 if (!UNSPECIFIEDP (value
))
3781 (EQ (face
, Qdefault
) ? value
:
3782 /* The default face must have an absolute size, otherwise, we do
3783 a test merge with a random height to see if VALUE's ok. */
3784 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3786 if (!INTEGERP(test
) || XINT(test
) <= 0)
3787 signal_error ("Invalid face height", value
);
3790 old_value
= LFACE_HEIGHT (lface
);
3791 LFACE_HEIGHT (lface
) = value
;
3792 font_related_attr_p
= 1;
3794 else if (EQ (attr
, QCweight
))
3796 if (!UNSPECIFIEDP (value
))
3798 CHECK_SYMBOL (value
, 3);
3799 if (face_numeric_weight (value
) < 0)
3800 signal_error ("Invalid face weight", value
);
3802 old_value
= LFACE_WEIGHT (lface
);
3803 LFACE_WEIGHT (lface
) = value
;
3804 font_related_attr_p
= 1;
3806 else if (EQ (attr
, QCslant
))
3808 if (!UNSPECIFIEDP (value
))
3810 CHECK_SYMBOL (value
, 3);
3811 if (face_numeric_slant (value
) < 0)
3812 signal_error ("Invalid face slant", value
);
3814 old_value
= LFACE_SLANT (lface
);
3815 LFACE_SLANT (lface
) = value
;
3816 font_related_attr_p
= 1;
3818 else if (EQ (attr
, QCunderline
))
3820 if (!UNSPECIFIEDP (value
))
3821 if ((SYMBOLP (value
)
3823 && !EQ (value
, Qnil
))
3824 /* Underline color. */
3826 && XSTRING (value
)->size
== 0))
3827 signal_error ("Invalid face underline", value
);
3829 old_value
= LFACE_UNDERLINE (lface
);
3830 LFACE_UNDERLINE (lface
) = value
;
3832 else if (EQ (attr
, QCoverline
))
3834 if (!UNSPECIFIEDP (value
))
3835 if ((SYMBOLP (value
)
3837 && !EQ (value
, Qnil
))
3838 /* Overline color. */
3840 && XSTRING (value
)->size
== 0))
3841 signal_error ("Invalid face overline", value
);
3843 old_value
= LFACE_OVERLINE (lface
);
3844 LFACE_OVERLINE (lface
) = value
;
3846 else if (EQ (attr
, QCstrike_through
))
3848 if (!UNSPECIFIEDP (value
))
3849 if ((SYMBOLP (value
)
3851 && !EQ (value
, Qnil
))
3852 /* Strike-through color. */
3854 && XSTRING (value
)->size
== 0))
3855 signal_error ("Invalid face strike-through", value
);
3857 old_value
= LFACE_STRIKE_THROUGH (lface
);
3858 LFACE_STRIKE_THROUGH (lface
) = value
;
3860 else if (EQ (attr
, QCbox
))
3864 /* Allow t meaning a simple box of width 1 in foreground color
3867 value
= make_number (1);
3869 if (UNSPECIFIEDP (value
))
3871 else if (NILP (value
))
3873 else if (INTEGERP (value
))
3874 valid_p
= XINT (value
) != 0;
3875 else if (STRINGP (value
))
3876 valid_p
= XSTRING (value
)->size
> 0;
3877 else if (CONSP (value
))
3893 if (EQ (k
, QCline_width
))
3895 if (!INTEGERP (v
) || XINT (v
) == 0)
3898 else if (EQ (k
, QCcolor
))
3900 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3903 else if (EQ (k
, QCstyle
))
3905 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3912 valid_p
= NILP (tem
);
3918 signal_error ("Invalid face box", value
);
3920 old_value
= LFACE_BOX (lface
);
3921 LFACE_BOX (lface
) = value
;
3923 else if (EQ (attr
, QCinverse_video
)
3924 || EQ (attr
, QCreverse_video
))
3926 if (!UNSPECIFIEDP (value
))
3928 CHECK_SYMBOL (value
, 3);
3929 if (!EQ (value
, Qt
) && !NILP (value
))
3930 signal_error ("Invalid inverse-video face attribute value", value
);
3932 old_value
= LFACE_INVERSE (lface
);
3933 LFACE_INVERSE (lface
) = value
;
3935 else if (EQ (attr
, QCforeground
))
3937 if (!UNSPECIFIEDP (value
))
3939 /* Don't check for valid color names here because it depends
3940 on the frame (display) whether the color will be valid
3941 when the face is realized. */
3942 CHECK_STRING (value
, 3);
3943 if (XSTRING (value
)->size
== 0)
3944 signal_error ("Empty foreground color value", value
);
3946 old_value
= LFACE_FOREGROUND (lface
);
3947 LFACE_FOREGROUND (lface
) = value
;
3949 else if (EQ (attr
, QCbackground
))
3951 if (!UNSPECIFIEDP (value
))
3953 /* Don't check for valid color names here because it depends
3954 on the frame (display) whether the color will be valid
3955 when the face is realized. */
3956 CHECK_STRING (value
, 3);
3957 if (XSTRING (value
)->size
== 0)
3958 signal_error ("Empty background color value", value
);
3960 old_value
= LFACE_BACKGROUND (lface
);
3961 LFACE_BACKGROUND (lface
) = value
;
3963 else if (EQ (attr
, QCstipple
))
3965 #ifdef HAVE_X_WINDOWS
3966 if (!UNSPECIFIEDP (value
)
3968 && NILP (Fbitmap_spec_p (value
)))
3969 signal_error ("Invalid stipple attribute", value
);
3970 old_value
= LFACE_STIPPLE (lface
);
3971 LFACE_STIPPLE (lface
) = value
;
3972 #endif /* HAVE_X_WINDOWS */
3974 else if (EQ (attr
, QCwidth
))
3976 if (!UNSPECIFIEDP (value
))
3978 CHECK_SYMBOL (value
, 3);
3979 if (face_numeric_swidth (value
) < 0)
3980 signal_error ("Invalid face width", value
);
3982 old_value
= LFACE_SWIDTH (lface
);
3983 LFACE_SWIDTH (lface
) = value
;
3984 font_related_attr_p
= 1;
3986 else if (EQ (attr
, QCfont
))
3988 #ifdef HAVE_WINDOW_SYSTEM
3989 /* Set font-related attributes of the Lisp face from an
3994 CHECK_STRING (value
, 3);
3996 f
= SELECTED_FRAME ();
3998 f
= check_x_frame (frame
);
4000 /* VALUE may be a fontset name or an alias of fontset. In such
4001 a case, use the base fontset name. */
4002 tmp
= Fquery_fontset (value
, Qnil
);
4006 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4007 signal_error ("Invalid font or fontset name", value
);
4010 #endif /* HAVE_WINDOW_SYSTEM */
4012 else if (EQ (attr
, QCinherit
))
4015 if (SYMBOLP (value
))
4018 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4019 if (!SYMBOLP (XCAR (tail
)))
4022 LFACE_INHERIT (lface
) = value
;
4024 signal_error ("Invalid face inheritance", value
);
4026 else if (EQ (attr
, QCbold
))
4028 old_value
= LFACE_WEIGHT (lface
);
4029 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4030 font_related_attr_p
= 1;
4032 else if (EQ (attr
, QCitalic
))
4034 old_value
= LFACE_SLANT (lface
);
4035 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4036 font_related_attr_p
= 1;
4039 signal_error ("Invalid face attribute name", attr
);
4041 if (font_related_attr_p
4042 && !UNSPECIFIEDP (value
))
4043 /* If a font-related attribute other than QCfont is specified, the
4044 original `font' attribute nor that of default face is useless
4045 to determine a new font. Thus, we set it to nil so that font
4046 selection mechanism doesn't use it. */
4047 LFACE_FONT (lface
) = Qnil
;
4049 /* Changing a named face means that all realized faces depending on
4050 that face are invalid. Since we cannot tell which realized faces
4051 depend on the face, make sure they are all removed. This is done
4052 by incrementing face_change_count. The next call to
4053 init_iterator will then free realized faces. */
4055 && (EQ (attr
, QCfont
)
4056 || NILP (Fequal (old_value
, value
))))
4058 ++face_change_count
;
4059 ++windows_or_buffers_changed
;
4062 if (!UNSPECIFIEDP (value
)
4063 && NILP (Fequal (old_value
, value
)))
4069 if (EQ (face
, Qdefault
))
4071 #ifdef HAVE_WINDOW_SYSTEM
4072 /* Changed font-related attributes of the `default' face are
4073 reflected in changed `font' frame parameters. */
4074 if ((font_related_attr_p
|| font_attr_p
)
4075 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4076 set_font_frame_param (frame
, lface
);
4078 #endif /* HAVE_WINDOW_SYSTEM */
4080 if (EQ (attr
, QCforeground
))
4081 param
= Qforeground_color
;
4082 else if (EQ (attr
, QCbackground
))
4083 param
= Qbackground_color
;
4085 #ifdef HAVE_WINDOW_SYSTEM
4087 else if (EQ (face
, Qscroll_bar
))
4089 /* Changing the colors of `scroll-bar' sets frame parameters
4090 `scroll-bar-foreground' and `scroll-bar-background'. */
4091 if (EQ (attr
, QCforeground
))
4092 param
= Qscroll_bar_foreground
;
4093 else if (EQ (attr
, QCbackground
))
4094 param
= Qscroll_bar_background
;
4096 #endif /* not WINDOWSNT */
4097 else if (EQ (face
, Qborder
))
4099 /* Changing background color of `border' sets frame parameter
4101 if (EQ (attr
, QCbackground
))
4102 param
= Qborder_color
;
4104 else if (EQ (face
, Qcursor
))
4106 /* Changing background color of `cursor' sets frame parameter
4108 if (EQ (attr
, QCbackground
))
4109 param
= Qcursor_color
;
4111 else if (EQ (face
, Qmouse
))
4113 /* Changing background color of `mouse' sets frame parameter
4115 if (EQ (attr
, QCbackground
))
4116 param
= Qmouse_color
;
4118 #endif /* HAVE_WINDOW_SYSTEM */
4119 else if (EQ (face
, Qmenu
))
4120 ++menu_face_change_count
;
4124 /* Update `default-frame-alist', which is used for new frames. */
4126 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4129 /* Update the current frame's parameters. */
4132 cons
= XCAR (Vparam_value_alist
);
4133 XCAR (cons
) = param
;
4134 XCDR (cons
) = value
;
4135 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4143 #ifdef HAVE_WINDOW_SYSTEM
4145 /* Set the `font' frame parameter of FRAME determined from `default'
4146 face attributes LFACE. If a face or fontset name is explicitely
4147 specfied in LFACE, use it as is. Otherwise, determine a font name
4148 from the other font-related atrributes of LFACE. In that case, if
4149 there's no matching font, signals an error. */
4152 set_font_frame_param (frame
, lface
)
4153 Lisp_Object frame
, lface
;
4155 struct frame
*f
= XFRAME (frame
);
4157 if (FRAME_WINDOW_P (f
))
4159 Lisp_Object font_name
;
4162 if (STRINGP (LFACE_FONT (lface
)))
4163 font_name
= LFACE_FONT (lface
);
4166 /* Choose a font name that reflects LFACE's attributes and has
4167 the registry and encoding pattern specified in the default
4168 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4169 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4171 error ("No font matches the specified attribute");
4172 font_name
= build_string (font
);
4176 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4181 /* Update the corresponding face when frame parameter PARAM on frame F
4182 has been assigned the value NEW_VALUE. */
4185 update_face_from_frame_parameter (f
, param
, new_value
)
4187 Lisp_Object param
, new_value
;
4191 /* If there are no faces yet, give up. This is the case when called
4192 from Fx_create_frame, and we do the necessary things later in
4193 face-set-after-frame-defaults. */
4194 if (NILP (f
->face_alist
))
4197 if (EQ (param
, Qforeground_color
))
4199 lface
= lface_from_face_name (f
, Qdefault
, 1);
4200 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4201 ? new_value
: Qunspecified
);
4202 realize_basic_faces (f
);
4204 else if (EQ (param
, Qbackground_color
))
4208 /* Changing the background color might change the background
4209 mode, so that we have to load new defface specs. Call
4210 frame-update-face-colors to do that. */
4211 XSETFRAME (frame
, f
);
4212 call1 (Qframe_update_face_colors
, frame
);
4214 lface
= lface_from_face_name (f
, Qdefault
, 1);
4215 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4216 ? new_value
: Qunspecified
);
4217 realize_basic_faces (f
);
4219 if (EQ (param
, Qborder_color
))
4221 lface
= lface_from_face_name (f
, Qborder
, 1);
4222 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4223 ? new_value
: Qunspecified
);
4225 else if (EQ (param
, Qcursor_color
))
4227 lface
= lface_from_face_name (f
, Qcursor
, 1);
4228 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4229 ? new_value
: Qunspecified
);
4231 else if (EQ (param
, Qmouse_color
))
4233 lface
= lface_from_face_name (f
, Qmouse
, 1);
4234 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4235 ? new_value
: Qunspecified
);
4240 /* Get the value of X resource RESOURCE, class CLASS for the display
4241 of frame FRAME. This is here because ordinary `x-get-resource'
4242 doesn't take a frame argument. */
4244 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4245 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4246 (resource
, class, frame
)
4247 Lisp_Object resource
, class, frame
;
4249 Lisp_Object value
= Qnil
;
4252 CHECK_STRING (resource
, 0);
4253 CHECK_STRING (class, 1);
4254 CHECK_LIVE_FRAME (frame
, 2);
4256 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4257 resource
, class, Qnil
, Qnil
);
4259 #endif /* not macintosh */
4260 #endif /* not WINDOWSNT */
4265 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4266 If VALUE is "on" or "true", return t. If VALUE is "off" or
4267 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4268 error; if SIGNAL_P is zero, return 0. */
4271 face_boolean_x_resource_value (value
, signal_p
)
4275 Lisp_Object result
= make_number (0);
4277 xassert (STRINGP (value
));
4279 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4280 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4282 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4283 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4285 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4286 result
= Qunspecified
;
4288 signal_error ("Invalid face attribute value from X resource", value
);
4294 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4295 Finternal_set_lisp_face_attribute_from_resource
,
4296 Sinternal_set_lisp_face_attribute_from_resource
,
4298 (face
, attr
, value
, frame
)
4299 Lisp_Object face
, attr
, value
, frame
;
4301 CHECK_SYMBOL (face
, 0);
4302 CHECK_SYMBOL (attr
, 1);
4303 CHECK_STRING (value
, 2);
4305 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4306 value
= Qunspecified
;
4307 else if (EQ (attr
, QCheight
))
4309 value
= Fstring_to_number (value
, make_number (10));
4310 if (XINT (value
) <= 0)
4311 signal_error ("Invalid face height from X resource", value
);
4313 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4314 value
= face_boolean_x_resource_value (value
, 1);
4315 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4316 value
= intern (XSTRING (value
)->data
);
4317 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4318 value
= face_boolean_x_resource_value (value
, 1);
4319 else if (EQ (attr
, QCunderline
)
4320 || EQ (attr
, QCoverline
)
4321 || EQ (attr
, QCstrike_through
)
4322 || EQ (attr
, QCbox
))
4324 Lisp_Object boolean_value
;
4326 /* If the result of face_boolean_x_resource_value is t or nil,
4327 VALUE does NOT specify a color. */
4328 boolean_value
= face_boolean_x_resource_value (value
, 0);
4329 if (SYMBOLP (boolean_value
))
4330 value
= boolean_value
;
4333 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4336 #endif /* HAVE_WINDOW_SYSTEM */
4339 /***********************************************************************
4341 ***********************************************************************/
4343 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4345 /* Make menus on frame F appear as specified by the `menu' face. */
4348 x_update_menu_appearance (f
)
4351 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4355 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4359 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4360 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4361 char *myname
= XSTRING (Vx_resource_name
)->data
;
4364 const char *popup_path
= "popup_menu";
4366 const char *popup_path
= "menu.popup";
4369 if (STRINGP (LFACE_FOREGROUND (lface
)))
4371 sprintf (line
, "%s.%s*foreground: %s",
4373 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4374 XrmPutLineResource (&rdb
, line
);
4375 sprintf (line
, "%s.pane.menubar*foreground: %s",
4376 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4377 XrmPutLineResource (&rdb
, line
);
4381 if (STRINGP (LFACE_BACKGROUND (lface
)))
4383 sprintf (line
, "%s.%s*background: %s",
4385 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4386 XrmPutLineResource (&rdb
, line
);
4387 sprintf (line
, "%s.pane.menubar*background: %s",
4388 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4389 XrmPutLineResource (&rdb
, line
);
4394 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4395 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4396 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4397 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4398 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4399 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4402 const char *suffix
= "List";
4404 const char *suffix
= "";
4406 sprintf (line
, "%s.pane.menubar*font%s: %s",
4407 myname
, suffix
, face
->font_name
);
4408 XrmPutLineResource (&rdb
, line
);
4409 sprintf (line
, "%s.%s*font%s: %s",
4410 myname
, popup_path
, suffix
, face
->font_name
);
4411 XrmPutLineResource (&rdb
, line
);
4415 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4417 free_frame_menubar (f
);
4418 set_frame_menubar (f
, 1, 1);
4423 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4427 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4428 Sinternal_get_lisp_face_attribute
,
4430 "Return face attribute KEYWORD of face SYMBOL.\n\
4431 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4432 face attribute name, signal an error.\n\
4433 If the optional argument FRAME is given, report on face FACE in that\n\
4434 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4435 frames). If FRAME is omitted or nil, use the selected frame.")
4436 (symbol
, keyword
, frame
)
4437 Lisp_Object symbol
, keyword
, frame
;
4439 Lisp_Object lface
, value
= Qnil
;
4441 CHECK_SYMBOL (symbol
, 0);
4442 CHECK_SYMBOL (keyword
, 1);
4445 lface
= lface_from_face_name (NULL
, symbol
, 1);
4449 frame
= selected_frame
;
4450 CHECK_LIVE_FRAME (frame
, 2);
4451 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4454 if (EQ (keyword
, QCfamily
))
4455 value
= LFACE_FAMILY (lface
);
4456 else if (EQ (keyword
, QCheight
))
4457 value
= LFACE_HEIGHT (lface
);
4458 else if (EQ (keyword
, QCweight
))
4459 value
= LFACE_WEIGHT (lface
);
4460 else if (EQ (keyword
, QCslant
))
4461 value
= LFACE_SLANT (lface
);
4462 else if (EQ (keyword
, QCunderline
))
4463 value
= LFACE_UNDERLINE (lface
);
4464 else if (EQ (keyword
, QCoverline
))
4465 value
= LFACE_OVERLINE (lface
);
4466 else if (EQ (keyword
, QCstrike_through
))
4467 value
= LFACE_STRIKE_THROUGH (lface
);
4468 else if (EQ (keyword
, QCbox
))
4469 value
= LFACE_BOX (lface
);
4470 else if (EQ (keyword
, QCinverse_video
)
4471 || EQ (keyword
, QCreverse_video
))
4472 value
= LFACE_INVERSE (lface
);
4473 else if (EQ (keyword
, QCforeground
))
4474 value
= LFACE_FOREGROUND (lface
);
4475 else if (EQ (keyword
, QCbackground
))
4476 value
= LFACE_BACKGROUND (lface
);
4477 else if (EQ (keyword
, QCstipple
))
4478 value
= LFACE_STIPPLE (lface
);
4479 else if (EQ (keyword
, QCwidth
))
4480 value
= LFACE_SWIDTH (lface
);
4481 else if (EQ (keyword
, QCinherit
))
4482 value
= LFACE_INHERIT (lface
);
4483 else if (EQ (keyword
, QCfont
))
4484 value
= LFACE_FONT (lface
);
4486 signal_error ("Invalid face attribute name", keyword
);
4492 DEFUN ("internal-lisp-face-attribute-values",
4493 Finternal_lisp_face_attribute_values
,
4494 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4495 "Return a list of valid discrete values for face attribute ATTR.\n\
4496 Value is nil if ATTR doesn't have a discrete set of valid values.")
4500 Lisp_Object result
= Qnil
;
4502 CHECK_SYMBOL (attr
, 0);
4504 if (EQ (attr
, QCweight
)
4505 || EQ (attr
, QCslant
)
4506 || EQ (attr
, QCwidth
))
4508 /* Extract permissible symbols from tables. */
4509 struct table_entry
*table
;
4512 if (EQ (attr
, QCweight
))
4513 table
= weight_table
, dim
= DIM (weight_table
);
4514 else if (EQ (attr
, QCslant
))
4515 table
= slant_table
, dim
= DIM (slant_table
);
4517 table
= swidth_table
, dim
= DIM (swidth_table
);
4519 for (i
= 0; i
< dim
; ++i
)
4521 Lisp_Object symbol
= *table
[i
].symbol
;
4522 Lisp_Object tail
= result
;
4525 && !EQ (XCAR (tail
), symbol
))
4529 result
= Fcons (symbol
, result
);
4532 else if (EQ (attr
, QCunderline
))
4533 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4534 else if (EQ (attr
, QCoverline
))
4535 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4536 else if (EQ (attr
, QCstrike_through
))
4537 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4538 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4539 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4545 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4546 Sinternal_merge_in_global_face
, 2, 2, 0,
4547 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4548 Default face attributes override any local face attributes.")
4550 Lisp_Object face
, frame
;
4553 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4555 CHECK_LIVE_FRAME (frame
, 1);
4556 global_lface
= lface_from_face_name (NULL
, face
, 1);
4557 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4558 if (NILP (local_lface
))
4559 local_lface
= Finternal_make_lisp_face (face
, frame
);
4561 /* Make every specified global attribute override the local one.
4562 BEWARE!! This is only used from `face-set-after-frame-default' where
4563 the local frame is defined from default specs in `face-defface-spec'
4564 and those should be overridden by global settings. Hence the strange
4565 "global before local" priority. */
4566 lvec
= XVECTOR (local_lface
)->contents
;
4567 gvec
= XVECTOR (global_lface
)->contents
;
4568 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4569 if (! UNSPECIFIEDP (gvec
[i
]))
4576 /* The following function is implemented for compatibility with 20.2.
4577 The function is used in x-resolve-fonts when it is asked to
4578 return fonts with the same size as the font of a face. This is
4579 done in fontset.el. */
4581 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4582 "Return the font name of face FACE, or nil if it is unspecified.\n\
4583 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4584 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4585 The font default for a face is either nil, or a list\n\
4586 of the form (bold), (italic) or (bold italic).\n\
4587 If FRAME is omitted or nil, use the selected frame.")
4589 Lisp_Object face
, frame
;
4593 Lisp_Object result
= Qnil
;
4594 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4596 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4597 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4598 result
= Fcons (Qbold
, result
);
4600 if (!NILP (LFACE_SLANT (lface
))
4601 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4602 result
= Fcons (Qitalic
, result
);
4608 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4609 int face_id
= lookup_named_face (f
, face
, 0);
4610 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4611 return face
? build_string (face
->font_name
) : Qnil
;
4616 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4617 all attributes are `equal'. Tries to be fast because this function
4618 is called quite often. */
4621 lface_equal_p (v1
, v2
)
4622 Lisp_Object
*v1
, *v2
;
4626 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4628 Lisp_Object a
= v1
[i
];
4629 Lisp_Object b
= v2
[i
];
4631 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4632 and the other is specified. */
4633 equal_p
= XTYPE (a
) == XTYPE (b
);
4642 equal_p
= ((STRING_BYTES (XSTRING (a
))
4643 == STRING_BYTES (XSTRING (b
)))
4644 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4645 STRING_BYTES (XSTRING (a
))) == 0);
4654 equal_p
= !NILP (Fequal (a
, b
));
4664 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4665 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4666 "True if FACE1 and FACE2 are equal.\n\
4667 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4668 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4669 If FRAME is omitted or nil, use the selected frame.")
4670 (face1
, face2
, frame
)
4671 Lisp_Object face1
, face2
, frame
;
4675 Lisp_Object lface1
, lface2
;
4680 /* Don't use check_x_frame here because this function is called
4681 before X frames exist. At that time, if FRAME is nil,
4682 selected_frame will be used which is the frame dumped with
4683 Emacs. That frame is not an X frame. */
4684 f
= frame_or_selected_frame (frame
, 2);
4686 lface1
= lface_from_face_name (NULL
, face1
, 1);
4687 lface2
= lface_from_face_name (NULL
, face2
, 1);
4688 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4689 XVECTOR (lface2
)->contents
);
4690 return equal_p
? Qt
: Qnil
;
4694 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4695 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4696 "True if FACE has no attribute specified.\n\
4697 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4698 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4699 If FRAME is omitted or nil, use the selected frame.")
4701 Lisp_Object face
, frame
;
4708 frame
= selected_frame
;
4709 CHECK_LIVE_FRAME (frame
, 0);
4713 lface
= lface_from_face_name (NULL
, face
, 1);
4715 lface
= lface_from_face_name (f
, face
, 1);
4717 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4718 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4721 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4725 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4727 "Return an alist of frame-local faces defined on FRAME.\n\
4728 For internal use only.")
4732 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4733 return f
->face_alist
;
4737 /* Return a hash code for Lisp string STRING with case ignored. Used
4738 below in computing a hash value for a Lisp face. */
4740 static INLINE
unsigned
4741 hash_string_case_insensitive (string
)
4746 xassert (STRINGP (string
));
4747 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4748 hash
= (hash
<< 1) ^ tolower (*s
);
4753 /* Return a hash code for face attribute vector V. */
4755 static INLINE
unsigned
4759 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4760 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4761 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4762 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4763 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4764 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4765 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4769 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4770 considering charsets/registries). They do if they specify the same
4771 family, point size, weight, width, slant, and fontset. Both LFACE1
4772 and LFACE2 must be fully-specified. */
4775 lface_same_font_attributes_p (lface1
, lface2
)
4776 Lisp_Object
*lface1
, *lface2
;
4778 xassert (lface_fully_specified_p (lface1
)
4779 && lface_fully_specified_p (lface2
));
4780 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4781 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4782 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4783 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4784 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4785 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4786 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4787 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4788 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4789 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4790 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4791 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4796 /***********************************************************************
4798 ***********************************************************************/
4800 /* Allocate and return a new realized face for Lisp face attribute
4803 static struct face
*
4804 make_realized_face (attr
)
4807 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4808 bzero (face
, sizeof *face
);
4809 face
->ascii_face
= face
;
4810 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4815 /* Free realized face FACE, including its X resources. FACE may
4819 free_realized_face (f
, face
)
4825 #ifdef HAVE_WINDOW_SYSTEM
4826 if (FRAME_WINDOW_P (f
))
4828 /* Free fontset of FACE if it is ASCII face. */
4829 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4830 free_face_fontset (f
, face
);
4833 x_free_gc (f
, face
->gc
);
4837 free_face_colors (f
, face
);
4838 x_destroy_bitmap (f
, face
->stipple
);
4840 #endif /* HAVE_WINDOW_SYSTEM */
4847 /* Prepare face FACE for subsequent display on frame F. This
4848 allocated GCs if they haven't been allocated yet or have been freed
4849 by clearing the face cache. */
4852 prepare_face_for_display (f
, face
)
4856 #ifdef HAVE_WINDOW_SYSTEM
4857 xassert (FRAME_WINDOW_P (f
));
4862 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4864 xgcv
.foreground
= face
->foreground
;
4865 xgcv
.background
= face
->background
;
4866 #ifdef HAVE_X_WINDOWS
4867 xgcv
.graphics_exposures
= False
;
4869 /* The font of FACE may be null if we couldn't load it. */
4872 #ifdef HAVE_X_WINDOWS
4873 xgcv
.font
= face
->font
->fid
;
4876 xgcv
.font
= face
->font
;
4879 xgcv
.font
= face
->font
;
4885 #ifdef HAVE_X_WINDOWS
4888 xgcv
.fill_style
= FillOpaqueStippled
;
4889 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4890 mask
|= GCFillStyle
| GCStipple
;
4893 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4896 #endif /* HAVE_WINDOW_SYSTEM */
4900 /***********************************************************************
4902 ***********************************************************************/
4904 /* Return a new face cache for frame F. */
4906 static struct face_cache
*
4910 struct face_cache
*c
;
4913 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4914 bzero (c
, sizeof *c
);
4915 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4916 c
->buckets
= (struct face
**) xmalloc (size
);
4917 bzero (c
->buckets
, size
);
4919 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4925 /* Clear out all graphics contexts for all realized faces, except for
4926 the basic faces. This should be done from time to time just to avoid
4927 keeping too many graphics contexts that are no longer needed. */
4931 struct face_cache
*c
;
4933 if (c
&& FRAME_WINDOW_P (c
->f
))
4935 #ifdef HAVE_WINDOW_SYSTEM
4937 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4939 struct face
*face
= c
->faces_by_id
[i
];
4940 if (face
&& face
->gc
)
4942 x_free_gc (c
->f
, face
->gc
);
4946 #endif /* HAVE_WINDOW_SYSTEM */
4951 /* Free all realized faces in face cache C, including basic faces. C
4952 may be null. If faces are freed, make sure the frame's current
4953 matrix is marked invalid, so that a display caused by an expose
4954 event doesn't try to use faces we destroyed. */
4957 free_realized_faces (c
)
4958 struct face_cache
*c
;
4963 struct frame
*f
= c
->f
;
4965 /* We must block input here because we can't process X events
4966 safely while only some faces are freed, or when the frame's
4967 current matrix still references freed faces. */
4970 for (i
= 0; i
< c
->used
; ++i
)
4972 free_realized_face (f
, c
->faces_by_id
[i
]);
4973 c
->faces_by_id
[i
] = NULL
;
4977 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4978 bzero (c
->buckets
, size
);
4980 /* Must do a thorough redisplay the next time. Mark current
4981 matrices as invalid because they will reference faces freed
4982 above. This function is also called when a frame is
4983 destroyed. In this case, the root window of F is nil. */
4984 if (WINDOWP (f
->root_window
))
4986 clear_current_matrices (f
);
4987 ++windows_or_buffers_changed
;
4995 /* Free all faces realized for multibyte characters on frame F that
4999 free_realized_multibyte_face (f
, fontset
)
5003 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5007 /* We must block input here because we can't process X events safely
5008 while only some faces are freed, or when the frame's current
5009 matrix still references freed faces. */
5012 for (i
= 0; i
< cache
->used
; i
++)
5014 face
= cache
->faces_by_id
[i
];
5016 && face
!= face
->ascii_face
5017 && face
->fontset
== fontset
)
5019 uncache_face (cache
, face
);
5020 free_realized_face (f
, face
);
5024 /* Must do a thorough redisplay the next time. Mark current
5025 matrices as invalid because they will reference faces freed
5026 above. This function is also called when a frame is destroyed.
5027 In this case, the root window of F is nil. */
5028 if (WINDOWP (f
->root_window
))
5030 clear_current_matrices (f
);
5031 ++windows_or_buffers_changed
;
5038 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5039 This is done after attributes of a named face have been changed,
5040 because we can't tell which realized faces depend on that face. */
5043 free_all_realized_faces (frame
)
5049 FOR_EACH_FRAME (rest
, frame
)
5050 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5053 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5057 /* Free face cache C and faces in it, including their X resources. */
5061 struct face_cache
*c
;
5065 free_realized_faces (c
);
5067 xfree (c
->faces_by_id
);
5073 /* Cache realized face FACE in face cache C. HASH is the hash value
5074 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5075 collision list of the face hash table of C. This is done because
5076 otherwise lookup_face would find FACE for every character, even if
5077 faces with the same attributes but for specific characters exist. */
5080 cache_face (c
, face
, hash
)
5081 struct face_cache
*c
;
5085 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5089 if (face
->fontset
>= 0)
5091 struct face
*last
= c
->buckets
[i
];
5102 c
->buckets
[i
] = face
;
5103 face
->prev
= face
->next
= NULL
;
5109 face
->next
= c
->buckets
[i
];
5111 face
->next
->prev
= face
;
5112 c
->buckets
[i
] = face
;
5115 /* Find a free slot in C->faces_by_id and use the index of the free
5116 slot as FACE->id. */
5117 for (i
= 0; i
< c
->used
; ++i
)
5118 if (c
->faces_by_id
[i
] == NULL
)
5122 /* Maybe enlarge C->faces_by_id. */
5123 if (i
== c
->used
&& c
->used
== c
->size
)
5125 int new_size
= 2 * c
->size
;
5126 int sz
= new_size
* sizeof *c
->faces_by_id
;
5127 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5132 /* Check that FACE got a unique id. */
5137 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5138 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5144 #endif /* GLYPH_DEBUG */
5146 c
->faces_by_id
[i
] = face
;
5152 /* Remove face FACE from cache C. */
5155 uncache_face (c
, face
)
5156 struct face_cache
*c
;
5159 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5162 face
->prev
->next
= face
->next
;
5164 c
->buckets
[i
] = face
->next
;
5167 face
->next
->prev
= face
->prev
;
5169 c
->faces_by_id
[face
->id
] = NULL
;
5170 if (face
->id
== c
->used
)
5175 /* Look up a realized face with face attributes ATTR in the face cache
5176 of frame F. The face will be used to display character C. Value
5177 is the ID of the face found. If no suitable face is found, realize
5178 a new one. In that case, if C is a multibyte character, BASE_FACE
5179 is a face that has the same attributes. */
5182 lookup_face (f
, attr
, c
, base_face
)
5186 struct face
*base_face
;
5188 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5193 xassert (cache
!= NULL
);
5194 check_lface_attrs (attr
);
5196 /* Look up ATTR in the face cache. */
5197 hash
= lface_hash (attr
);
5198 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5200 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5201 if (face
->hash
== hash
5202 && (!FRAME_WINDOW_P (f
)
5203 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5204 && lface_equal_p (face
->lface
, attr
))
5207 /* If not found, realize a new face. */
5209 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5212 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5214 /* When this function is called from face_for_char (in this case, C is
5215 a multibyte character), a fontset of a face returned by
5216 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5217 C) is not sutisfied. The fontset is set for this face by
5218 face_for_char later. */
5220 if (FRAME_WINDOW_P (f
))
5221 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5223 #endif /* GLYPH_DEBUG */
5229 /* Return the face id of the realized face for named face SYMBOL on
5230 frame F suitable for displaying character C. Value is -1 if the
5231 face couldn't be determined, which might happen if the default face
5232 isn't realized and cannot be realized. */
5235 lookup_named_face (f
, symbol
, c
)
5240 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5241 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5242 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5244 if (default_face
== NULL
)
5246 if (!realize_basic_faces (f
))
5248 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5251 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5252 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5253 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5254 return lookup_face (f
, attrs
, c
, NULL
);
5258 /* Return the ID of the realized ASCII face of Lisp face with ID
5259 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5262 ascii_face_of_lisp_face (f
, lface_id
)
5268 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5270 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5271 face_id
= lookup_named_face (f
, face_name
, 0);
5280 /* Return a face for charset ASCII that is like the face with id
5281 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5282 STEPS < 0 means larger. Value is the id of the face. */
5285 smaller_face (f
, face_id
, steps
)
5289 #ifdef HAVE_WINDOW_SYSTEM
5291 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5292 int pt
, last_pt
, last_height
;
5295 struct face
*new_face
;
5297 /* If not called for an X frame, just return the original face. */
5298 if (FRAME_TERMCAP_P (f
))
5301 /* Try in increments of 1/2 pt. */
5302 delta
= steps
< 0 ? 5 : -5;
5303 steps
= abs (steps
);
5305 face
= FACE_FROM_ID (f
, face_id
);
5306 bcopy (face
->lface
, attrs
, sizeof attrs
);
5307 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5308 new_face_id
= face_id
;
5309 last_height
= FONT_HEIGHT (face
->font
);
5313 /* Give up if we cannot find a font within 10pt. */
5314 && abs (last_pt
- pt
) < 100)
5316 /* Look up a face for a slightly smaller/larger font. */
5318 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5319 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5320 new_face
= FACE_FROM_ID (f
, new_face_id
);
5322 /* If height changes, count that as one step. */
5323 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5324 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5327 last_height
= FONT_HEIGHT (new_face
->font
);
5334 #else /* not HAVE_WINDOW_SYSTEM */
5338 #endif /* not HAVE_WINDOW_SYSTEM */
5342 /* Return a face for charset ASCII that is like the face with id
5343 FACE_ID on frame F, but has height HEIGHT. */
5346 face_with_height (f
, face_id
, height
)
5351 #ifdef HAVE_WINDOW_SYSTEM
5353 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5355 if (FRAME_TERMCAP_P (f
)
5359 face
= FACE_FROM_ID (f
, face_id
);
5360 bcopy (face
->lface
, attrs
, sizeof attrs
);
5361 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5362 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5363 #endif /* HAVE_WINDOW_SYSTEM */
5369 /* Return the face id of the realized face for named face SYMBOL on
5370 frame F suitable for displaying character C, and use attributes of
5371 the face FACE_ID for attributes that aren't completely specified by
5372 SYMBOL. This is like lookup_named_face, except that the default
5373 attributes come from FACE_ID, not from the default face. FACE_ID
5374 is assumed to be already realized. */
5377 lookup_derived_face (f
, symbol
, c
, face_id
)
5383 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5384 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5385 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5390 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5391 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5392 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5393 return lookup_face (f
, attrs
, c
, default_face
);
5398 /***********************************************************************
5400 ***********************************************************************/
5402 DEFUN ("internal-set-font-selection-order",
5403 Finternal_set_font_selection_order
,
5404 Sinternal_set_font_selection_order
, 1, 1, 0,
5405 "Set font selection order for face font selection to ORDER.\n\
5406 ORDER must be a list of length 4 containing the symbols `:width',\n\
5407 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5408 first in ORDER are matched first, e.g. if `:height' appears before\n\
5409 `:weight' in ORDER, font selection first tries to find a font with\n\
5410 a suitable height, and then tries to match the font weight.\n\
5417 int indices
[DIM (font_sort_order
)];
5419 CHECK_LIST (order
, 0);
5420 bzero (indices
, sizeof indices
);
5424 CONSP (list
) && i
< DIM (indices
);
5425 list
= XCDR (list
), ++i
)
5427 Lisp_Object attr
= XCAR (list
);
5430 if (EQ (attr
, QCwidth
))
5432 else if (EQ (attr
, QCheight
))
5433 xlfd
= XLFD_POINT_SIZE
;
5434 else if (EQ (attr
, QCweight
))
5436 else if (EQ (attr
, QCslant
))
5441 if (indices
[i
] != 0)
5446 if (!NILP (list
) || i
!= DIM (indices
))
5447 signal_error ("Invalid font sort order", order
);
5448 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5449 if (indices
[i
] == 0)
5450 signal_error ("Invalid font sort order", order
);
5452 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5454 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5455 free_all_realized_faces (Qnil
);
5462 DEFUN ("internal-set-alternative-font-family-alist",
5463 Finternal_set_alternative_font_family_alist
,
5464 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5465 "Define alternative font families to try in face font selection.\n\
5466 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5467 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5468 be found. Value is ALIST.")
5472 CHECK_LIST (alist
, 0);
5473 Vface_alternative_font_family_alist
= alist
;
5474 free_all_realized_faces (Qnil
);
5479 DEFUN ("internal-set-alternative-font-registry-alist",
5480 Finternal_set_alternative_font_registry_alist
,
5481 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5482 "Define alternative font registries to try in face font selection.\n\
5483 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5484 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5485 be found. Value is ALIST.")
5489 CHECK_LIST (alist
, 0);
5490 Vface_alternative_font_registry_alist
= alist
;
5491 free_all_realized_faces (Qnil
);
5496 #ifdef HAVE_WINDOW_SYSTEM
5498 /* Value is non-zero if FONT is the name of a scalable font. The
5499 X11R6 XLFD spec says that point size, pixel size, and average width
5500 are zero for scalable fonts. Intlfonts contain at least one
5501 scalable font ("*-muleindian-1") for which this isn't true, so we
5502 just test average width. */
5505 font_scalable_p (font
)
5506 struct font_name
*font
;
5508 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5509 return (*s
== '0' && *(s
+ 1) == '\0')
5511 /* Windows implementation of XLFD is slightly broken for backward
5512 compatibility with previous broken versions, so test for
5513 wildcards as well as 0. */
5520 /* Ignore the difference of font point size less than this value. */
5522 #define FONT_POINT_SIZE_QUANTUM 5
5524 /* Value is non-zero if FONT1 is a better match for font attributes
5525 VALUES than FONT2. VALUES is an array of face attribute values in
5526 font sort order. COMPARE_PT_P zero means don't compare point
5527 sizes. AVGWIDTH, if not zero, is a specified font average width
5531 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5533 struct font_name
*font1
, *font2
;
5534 int compare_pt_p
, avgwidth
;
5538 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5540 int xlfd_idx
= font_sort_order
[i
];
5542 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5544 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5545 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5547 if (xlfd_idx
== XLFD_POINT_SIZE
5548 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5550 if (delta1
> delta2
)
5552 else if (delta1
< delta2
)
5556 /* The difference may be equal because, e.g., the face
5557 specifies `italic' but we have only `regular' and
5558 `oblique'. Prefer `oblique' in this case. */
5559 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5560 && font1
->numeric
[xlfd_idx
] > values
[i
]
5561 && font2
->numeric
[xlfd_idx
] < values
[i
])
5569 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5570 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5571 if (delta1
> delta2
)
5573 else if (delta1
< delta2
)
5577 return font1
->registry_priority
< font2
->registry_priority
;
5581 /* Value is non-zero if FONT is an exact match for face attributes in
5582 SPECIFIED. SPECIFIED is an array of face attribute values in font
5583 sort order. AVGWIDTH, if non-zero, is an average width to compare
5587 exact_face_match_p (specified
, font
, avgwidth
)
5589 struct font_name
*font
;
5594 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5595 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5598 return (i
== DIM (font_sort_order
)
5600 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5604 /* Value is the name of a scaled font, generated from scalable font
5605 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5606 Value is allocated from heap. */
5609 build_scalable_font_name (f
, font
, specified_pt
)
5611 struct font_name
*font
;
5614 char point_size
[20], pixel_size
[20];
5616 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5619 /* If scalable font is for a specific resolution, compute
5620 the point size we must specify from the resolution of
5621 the display and the specified resolution of the font. */
5622 if (font
->numeric
[XLFD_RESY
] != 0)
5624 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5625 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5630 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5633 /* Set point size of the font. */
5634 sprintf (point_size
, "%d", (int) pt
);
5635 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5636 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5638 /* Set pixel size. */
5639 sprintf (pixel_size
, "%d", pixel_value
);
5640 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5641 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5643 /* If font doesn't specify its resolution, use the
5644 resolution of the display. */
5645 if (font
->numeric
[XLFD_RESY
] == 0)
5648 sprintf (buffer
, "%d", (int) resy
);
5649 font
->fields
[XLFD_RESY
] = buffer
;
5650 font
->numeric
[XLFD_RESY
] = resy
;
5653 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5656 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5657 sprintf (buffer
, "%d", resx
);
5658 font
->fields
[XLFD_RESX
] = buffer
;
5659 font
->numeric
[XLFD_RESX
] = resx
;
5662 return build_font_name (font
);
5666 /* Value is non-zero if we are allowed to use scalable font FONT. We
5667 can't run a Lisp function here since this function may be called
5668 with input blocked. */
5671 may_use_scalable_font_p (font
)
5674 if (EQ (Vscalable_fonts_allowed
, Qt
))
5676 else if (CONSP (Vscalable_fonts_allowed
))
5678 Lisp_Object tail
, regexp
;
5680 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5682 regexp
= XCAR (tail
);
5683 if (STRINGP (regexp
)
5684 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5694 /* Return the name of the best matching font for face attributes ATTRS
5695 in the array of font_name structures FONTS which contains NFONTS
5696 elements. WIDTH_RATIO is a factor with which to multiply average
5697 widths if ATTRS specifies such a width.
5699 Value is a font name which is allocated from the heap. FONTS is
5700 freed by this function. */
5703 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5706 struct font_name
*fonts
;
5711 struct font_name
*best
;
5714 int exact_p
, avgwidth
;
5719 /* Make specified font attributes available in `specified',
5720 indexed by sort order. */
5721 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5723 int xlfd_idx
= font_sort_order
[i
];
5725 if (xlfd_idx
== XLFD_SWIDTH
)
5726 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5727 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5728 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5729 else if (xlfd_idx
== XLFD_WEIGHT
)
5730 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5731 else if (xlfd_idx
== XLFD_SLANT
)
5732 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5737 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5739 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5743 /* Start with the first non-scalable font in the list. */
5744 for (i
= 0; i
< nfonts
; ++i
)
5745 if (!font_scalable_p (fonts
+ i
))
5748 /* Find the best match among the non-scalable fonts. */
5753 for (i
= 1; i
< nfonts
; ++i
)
5754 if (!font_scalable_p (fonts
+ i
)
5755 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5759 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5768 /* Unless we found an exact match among non-scalable fonts, see if
5769 we can find a better match among scalable fonts. */
5772 /* A scalable font is better if
5774 1. its weight, slant, swidth attributes are better, or.
5776 2. the best non-scalable font doesn't have the required
5777 point size, and the scalable fonts weight, slant, swidth
5780 int non_scalable_has_exact_height_p
;
5782 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5783 non_scalable_has_exact_height_p
= 1;
5785 non_scalable_has_exact_height_p
= 0;
5787 for (i
= 0; i
< nfonts
; ++i
)
5788 if (font_scalable_p (fonts
+ i
))
5791 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5792 || (!non_scalable_has_exact_height_p
5793 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5798 if (font_scalable_p (best
))
5799 font_name
= build_scalable_font_name (f
, best
, pt
);
5801 font_name
= build_font_name (best
);
5803 /* Free font_name structures. */
5804 free_font_names (fonts
, nfonts
);
5810 /* Get a list of matching fonts on frame F.
5812 FAMILY, if a string, specifies a font family. If nil, use
5813 the family specified in Lisp face attributes ATTRS instead.
5815 REGISTRY, if a string, specifies a font registry and encoding to
5816 match. A value of nil means include fonts of any registry and
5819 Return in *FONTS a pointer to a vector of font_name structures for
5820 the fonts matched. Value is the number of fonts found. */
5823 try_font_list (f
, attrs
, family
, registry
, fonts
)
5826 Lisp_Object family
, registry
;
5827 struct font_name
**fonts
;
5831 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5832 family
= attrs
[LFACE_FAMILY_INDEX
];
5834 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5835 if (nfonts
== 0 && !NILP (family
))
5839 /* Try alternative font families. */
5840 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5842 for (alter
= XCDR (alter
);
5843 CONSP (alter
) && nfonts
== 0;
5844 alter
= XCDR (alter
))
5846 if (STRINGP (XCAR (alter
)))
5847 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5850 /* Try font family of the default face or "fixed". */
5853 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5855 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5857 family
= build_string ("fixed");
5858 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5861 /* Try any family with the given registry. */
5863 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5870 /* Return the fontset id of the base fontset name or alias name given
5871 by the fontset attribute of ATTRS. Value is -1 if the fontset
5872 attribute of ATTRS doesn't name a fontset. */
5875 face_fontset (attrs
)
5880 name
= attrs
[LFACE_FONT_INDEX
];
5881 if (!STRINGP (name
))
5883 return fs_query_fontset (name
, 0);
5887 /* Choose a name of font to use on frame F to display character C with
5888 Lisp face attributes specified by ATTRS. The font name is
5889 determined by the font-related attributes in ATTRS and the name
5890 pattern for C in FONTSET. Value is the font name which is
5891 allocated from the heap and must be freed by the caller, or NULL if
5892 we can get no information about the font name of C. It is assured
5893 that we always get some information for a single byte
5897 choose_face_font (f
, attrs
, fontset
, c
)
5902 Lisp_Object pattern
;
5903 char *font_name
= NULL
;
5904 struct font_name
*fonts
;
5905 int nfonts
, width_ratio
;
5907 /* Get (foundry and) family name and registry (and encoding) name of
5909 pattern
= fontset_font_pattern (f
, fontset
, c
);
5912 xassert (!SINGLE_BYTE_CHAR_P (c
));
5915 /* If what we got is a name pattern, return it. */
5916 if (STRINGP (pattern
))
5917 return xstrdup (XSTRING (pattern
)->data
);
5919 /* Family name may be specified both in ATTRS and car part of
5920 PATTERN. The former has higher priority if C is a single byte
5922 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5923 && SINGLE_BYTE_CHAR_P (c
))
5924 XCAR (pattern
) = Qnil
;
5926 /* Get a list of fonts matching that pattern and choose the
5927 best match for the specified face attributes from it. */
5928 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
5929 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
5931 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
5932 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
5936 #endif /* HAVE_WINDOW_SYSTEM */
5940 /***********************************************************************
5942 ***********************************************************************/
5944 /* Realize basic faces on frame F. Value is zero if frame parameters
5945 of F don't contain enough information needed to realize the default
5949 realize_basic_faces (f
)
5954 /* Block input there so that we won't be surprised by an X expose
5955 event, for instance without having the faces set up. */
5957 realizing_basic_faces_p
= 1;
5959 if (realize_default_face (f
))
5961 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5962 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5963 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5964 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5965 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5966 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5967 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5968 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5969 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5971 /* Reflect changes in the `menu' face in menu bars. */
5972 if (menu_face_change_count
)
5974 --menu_face_change_count
;
5975 #ifdef USE_X_TOOLKIT
5976 x_update_menu_appearance (f
);
5983 realizing_basic_faces_p
= 0;
5989 /* Realize the default face on frame F. If the face is not fully
5990 specified, make it fully-specified. Attributes of the default face
5991 that are not explicitly specified are taken from frame parameters. */
5994 realize_default_face (f
)
5997 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5999 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6000 Lisp_Object frame_font
;
6003 /* If the `default' face is not yet known, create it. */
6004 lface
= lface_from_face_name (f
, Qdefault
, 0);
6008 XSETFRAME (frame
, f
);
6009 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6012 #ifdef HAVE_WINDOW_SYSTEM
6013 if (FRAME_WINDOW_P (f
))
6015 /* Set frame_font to the value of the `font' frame parameter. */
6016 frame_font
= Fassq (Qfont
, f
->param_alist
);
6017 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6018 frame_font
= XCDR (frame_font
);
6019 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6021 #endif /* HAVE_WINDOW_SYSTEM */
6023 if (!FRAME_WINDOW_P (f
))
6025 LFACE_FAMILY (lface
) = build_string ("default");
6026 LFACE_SWIDTH (lface
) = Qnormal
;
6027 LFACE_HEIGHT (lface
) = make_number (1);
6028 LFACE_WEIGHT (lface
) = Qnormal
;
6029 LFACE_SLANT (lface
) = Qnormal
;
6030 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6033 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6034 LFACE_UNDERLINE (lface
) = Qnil
;
6036 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6037 LFACE_OVERLINE (lface
) = Qnil
;
6039 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6040 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6042 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6043 LFACE_BOX (lface
) = Qnil
;
6045 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6046 LFACE_INVERSE (lface
) = Qnil
;
6048 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6050 /* This function is called so early that colors are not yet
6051 set in the frame parameter list. */
6052 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6054 if (CONSP (color
) && STRINGP (XCDR (color
)))
6055 LFACE_FOREGROUND (lface
) = XCDR (color
);
6056 else if (FRAME_WINDOW_P (f
))
6058 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6059 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6064 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6066 /* This function is called so early that colors are not yet
6067 set in the frame parameter list. */
6068 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6069 if (CONSP (color
) && STRINGP (XCDR (color
)))
6070 LFACE_BACKGROUND (lface
) = XCDR (color
);
6071 else if (FRAME_WINDOW_P (f
))
6073 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6074 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6079 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6080 LFACE_STIPPLE (lface
) = Qnil
;
6082 /* Realize the face; it must be fully-specified now. */
6083 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6084 check_lface (lface
);
6085 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6086 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6091 /* Realize basic faces other than the default face in face cache C.
6092 SYMBOL is the face name, ID is the face id the realized face must
6093 have. The default face must have been realized already. */
6096 realize_named_face (f
, symbol
, id
)
6101 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6102 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6103 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6104 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6105 struct face
*new_face
;
6107 /* The default face must exist and be fully specified. */
6108 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6109 check_lface_attrs (attrs
);
6110 xassert (lface_fully_specified_p (attrs
));
6112 /* If SYMBOL isn't know as a face, create it. */
6116 XSETFRAME (frame
, f
);
6117 lface
= Finternal_make_lisp_face (symbol
, frame
);
6120 /* Merge SYMBOL's face with the default face. */
6121 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6122 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6124 /* Realize the face. */
6125 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6129 /* Realize the fully-specified face with attributes ATTRS in face
6130 cache CACHE for character C. If C is a multibyte character,
6131 BASE_FACE is a face that has the same attributes. Otherwise,
6132 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6133 ID of face to remove before caching the new face. Value is a
6134 pointer to the newly created realized face. */
6136 static struct face
*
6137 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6138 struct face_cache
*cache
;
6141 struct face
*base_face
;
6146 /* LFACE must be fully specified. */
6147 xassert (cache
!= NULL
);
6148 check_lface_attrs (attrs
);
6150 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6152 /* Remove the former face. */
6153 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6154 uncache_face (cache
, former_face
);
6155 free_realized_face (cache
->f
, former_face
);
6158 if (FRAME_WINDOW_P (cache
->f
))
6159 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6160 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6161 face
= realize_tty_face (cache
, attrs
, c
);
6165 /* Insert the new face. */
6166 cache_face (cache
, face
, lface_hash (attrs
));
6167 #ifdef HAVE_WINDOW_SYSTEM
6168 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6169 load_face_font (cache
->f
, face
, c
);
6170 #endif /* HAVE_WINDOW_SYSTEM */
6175 /* Realize the fully-specified face with attributes ATTRS in face
6176 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6177 a multibyte character, BASE_FACE is a face that has the same
6178 attributes. Otherwise, BASE_FACE is ignored. If the new face
6179 doesn't share font with the default face, a fontname is allocated
6180 from the heap and set in `font_name' of the new face, but it is not
6181 yet loaded here. Value is a pointer to the newly created realized
6184 static struct face
*
6185 realize_x_face (cache
, attrs
, c
, base_face
)
6186 struct face_cache
*cache
;
6189 struct face
*base_face
;
6191 #ifdef HAVE_WINDOW_SYSTEM
6192 struct face
*face
, *default_face
;
6194 Lisp_Object stipple
, overline
, strike_through
, box
;
6196 xassert (FRAME_WINDOW_P (cache
->f
));
6197 xassert (SINGLE_BYTE_CHAR_P (c
)
6200 /* Allocate a new realized face. */
6201 face
= make_realized_face (attrs
);
6205 /* If C is a multibyte character, we share all face attirbutes with
6206 BASE_FACE including the realized fontset. But, we must load a
6208 if (!SINGLE_BYTE_CHAR_P (c
))
6210 bcopy (base_face
, face
, sizeof *face
);
6213 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6214 face
->foreground_defaulted_p
= 1;
6215 face
->background_defaulted_p
= 1;
6216 face
->underline_defaulted_p
= 1;
6217 face
->overline_color_defaulted_p
= 1;
6218 face
->strike_through_color_defaulted_p
= 1;
6219 face
->box_color_defaulted_p
= 1;
6221 /* to force realize_face to load font */
6226 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6228 /* Determine the font to use. Most of the time, the font will be
6229 the same as the font of the default face, so try that first. */
6230 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6232 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6233 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6235 face
->font
= default_face
->font
;
6236 face
->fontset
= default_face
->fontset
;
6237 face
->font_info_id
= default_face
->font_info_id
;
6238 face
->font_name
= default_face
->font_name
;
6239 face
->ascii_face
= face
;
6241 /* But, as we can't share the fontset, make a new realized
6242 fontset that has the same base fontset as of the default
6245 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6249 /* If the face attribute ATTRS specifies a fontset, use it as
6250 the base of a new realized fontset. Otherwise, use the same
6251 base fontset as of the default face. The base determines
6252 registry and encoding of a font. It may also determine
6253 foundry and family. The other fields of font name pattern
6254 are constructed from ATTRS. */
6255 int fontset
= face_fontset (attrs
);
6257 if ((fontset
== -1) && default_face
)
6258 fontset
= default_face
->fontset
;
6259 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6260 face
->font
= NULL
; /* to force realize_face to load font */
6263 /* Load the font if it is specified in ATTRS. This fixes
6264 changing frame font on the Mac. */
6265 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6267 struct font_info
*font_info
=
6268 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6270 face
->font
= font_info
->font
;
6275 /* Load colors, and set remaining attributes. */
6277 load_face_colors (f
, face
, attrs
);
6280 box
= attrs
[LFACE_BOX_INDEX
];
6283 /* A simple box of line width 1 drawn in color given by
6285 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6287 face
->box
= FACE_SIMPLE_BOX
;
6288 face
->box_line_width
= 1;
6290 else if (INTEGERP (box
))
6292 /* Simple box of specified line width in foreground color of the
6294 xassert (XINT (box
) != 0);
6295 face
->box
= FACE_SIMPLE_BOX
;
6296 face
->box_line_width
= XINT (box
);
6297 face
->box_color
= face
->foreground
;
6298 face
->box_color_defaulted_p
= 1;
6300 else if (CONSP (box
))
6302 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6303 being one of `raised' or `sunken'. */
6304 face
->box
= FACE_SIMPLE_BOX
;
6305 face
->box_color
= face
->foreground
;
6306 face
->box_color_defaulted_p
= 1;
6307 face
->box_line_width
= 1;
6311 Lisp_Object keyword
, value
;
6313 keyword
= XCAR (box
);
6321 if (EQ (keyword
, QCline_width
))
6323 if (INTEGERP (value
) && XINT (value
) != 0)
6324 face
->box_line_width
= XINT (value
);
6326 else if (EQ (keyword
, QCcolor
))
6328 if (STRINGP (value
))
6330 face
->box_color
= load_color (f
, face
, value
,
6332 face
->use_box_color_for_shadows_p
= 1;
6335 else if (EQ (keyword
, QCstyle
))
6337 if (EQ (value
, Qreleased_button
))
6338 face
->box
= FACE_RAISED_BOX
;
6339 else if (EQ (value
, Qpressed_button
))
6340 face
->box
= FACE_SUNKEN_BOX
;
6345 /* Text underline, overline, strike-through. */
6347 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6349 /* Use default color (same as foreground color). */
6350 face
->underline_p
= 1;
6351 face
->underline_defaulted_p
= 1;
6352 face
->underline_color
= 0;
6354 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6356 /* Use specified color. */
6357 face
->underline_p
= 1;
6358 face
->underline_defaulted_p
= 0;
6359 face
->underline_color
6360 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6361 LFACE_UNDERLINE_INDEX
);
6363 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6365 face
->underline_p
= 0;
6366 face
->underline_defaulted_p
= 0;
6367 face
->underline_color
= 0;
6370 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6371 if (STRINGP (overline
))
6373 face
->overline_color
6374 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6375 LFACE_OVERLINE_INDEX
);
6376 face
->overline_p
= 1;
6378 else if (EQ (overline
, Qt
))
6380 face
->overline_color
= face
->foreground
;
6381 face
->overline_color_defaulted_p
= 1;
6382 face
->overline_p
= 1;
6385 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6386 if (STRINGP (strike_through
))
6388 face
->strike_through_color
6389 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6390 LFACE_STRIKE_THROUGH_INDEX
);
6391 face
->strike_through_p
= 1;
6393 else if (EQ (strike_through
, Qt
))
6395 face
->strike_through_color
= face
->foreground
;
6396 face
->strike_through_color_defaulted_p
= 1;
6397 face
->strike_through_p
= 1;
6400 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6401 if (!NILP (stipple
))
6402 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6404 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6406 #endif /* HAVE_WINDOW_SYSTEM */
6410 /* Map a specified color of face FACE on frame F to a tty color index.
6411 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6412 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6413 default foreground/background colors. */
6416 map_tty_color (f
, face
, idx
, defaulted
)
6419 enum lface_attribute_index idx
;
6422 Lisp_Object frame
, color
, def
;
6423 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6424 unsigned long default_pixel
, default_other_pixel
, pixel
;
6426 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6430 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6431 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6435 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6436 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6439 XSETFRAME (frame
, f
);
6440 color
= face
->lface
[idx
];
6443 && XSTRING (color
)->size
6444 && CONSP (Vtty_defined_color_alist
)
6445 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6448 /* Associations in tty-defined-color-alist are of the form
6449 (NAME INDEX R G B). We need the INDEX part. */
6450 pixel
= XINT (XCAR (XCDR (def
)));
6453 if (pixel
== default_pixel
&& STRINGP (color
))
6455 pixel
= load_color (f
, face
, color
, idx
);
6457 #if defined (MSDOS) || defined (WINDOWSNT)
6458 /* If the foreground of the default face is the default color,
6459 use the foreground color defined by the frame. */
6461 if (FRAME_MSDOS_P (f
))
6464 if (pixel
== default_pixel
6465 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6468 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6470 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6471 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6474 else if (pixel
== default_other_pixel
)
6477 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6479 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6480 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6486 #endif /* MSDOS or WINDOWSNT */
6490 face
->foreground
= pixel
;
6492 face
->background
= pixel
;
6496 /* Realize the fully-specified face with attributes ATTRS in face
6497 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6498 pointer to the newly created realized face. */
6500 static struct face
*
6501 realize_tty_face (cache
, attrs
, c
)
6502 struct face_cache
*cache
;
6508 int face_colors_defaulted
= 0;
6509 struct frame
*f
= cache
->f
;
6511 /* Frame must be a termcap frame. */
6512 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6514 /* Allocate a new realized face. */
6515 face
= make_realized_face (attrs
);
6516 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6518 /* Map face attributes to TTY appearances. We map slant to
6519 dimmed text because we want italic text to appear differently
6520 and because dimmed text is probably used infrequently. */
6521 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6522 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6524 if (weight
> XLFD_WEIGHT_MEDIUM
)
6525 face
->tty_bold_p
= 1;
6526 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6527 face
->tty_dim_p
= 1;
6528 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6529 face
->tty_underline_p
= 1;
6530 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6531 face
->tty_reverse_p
= 1;
6533 /* Map color names to color indices. */
6534 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6535 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6537 /* Swap colors if face is inverse-video. If the colors are taken
6538 from the frame colors, they are already inverted, since the
6539 frame-creation function calls x-handle-reverse-video. */
6540 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6542 unsigned long tem
= face
->foreground
;
6543 face
->foreground
= face
->background
;
6544 face
->background
= tem
;
6547 if (tty_suppress_bold_inverse_default_colors_p
6549 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6550 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6551 face
->tty_bold_p
= 0;
6557 DEFUN ("tty-suppress-bold-inverse-default-colors",
6558 Ftty_suppress_bold_inverse_default_colors
,
6559 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6560 "Suppress/allow boldness of faces with inverse default colors.\n\
6561 SUPPRESS non-nil means suppress it.\n\
6562 This affects bold faces on TTYs whose foreground is the default background\n\
6563 color of the display and whose background is the default foreground color.\n\
6564 For such faces, the bold face attribute is ignored if this variable\n\
6567 Lisp_Object suppress
;
6569 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6570 ++face_change_count
;
6576 /***********************************************************************
6578 ***********************************************************************/
6580 /* Return the ID of the face to use to display character CH with face
6581 property PROP on frame F in current_buffer. */
6584 compute_char_face (f
, ch
, prop
)
6591 if (NILP (current_buffer
->enable_multibyte_characters
))
6596 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6597 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6601 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6602 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6603 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6604 merge_face_vector_with_property (f
, attrs
, prop
);
6605 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6612 /* Return the face ID associated with buffer position POS for
6613 displaying ASCII characters. Return in *ENDPTR the position at
6614 which a different face is needed, as far as text properties and
6615 overlays are concerned. W is a window displaying current_buffer.
6617 REGION_BEG, REGION_END delimit the region, so it can be
6620 LIMIT is a position not to scan beyond. That is to limit the time
6621 this function can take.
6623 If MOUSE is non-zero, use the character's mouse-face, not its face.
6625 The face returned is suitable for displaying ASCII characters. */
6628 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6629 endptr
, limit
, mouse
)
6632 int region_beg
, region_end
;
6637 struct frame
*f
= XFRAME (w
->frame
);
6638 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6639 Lisp_Object prop
, position
;
6641 Lisp_Object
*overlay_vec
;
6644 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6645 Lisp_Object limit1
, end
;
6646 struct face
*default_face
;
6648 /* W must display the current buffer. We could write this function
6649 to use the frame and buffer of W, but right now it doesn't. */
6650 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6652 XSETFRAME (frame
, f
);
6653 XSETFASTINT (position
, pos
);
6656 if (pos
< region_beg
&& region_beg
< endpos
)
6657 endpos
= region_beg
;
6659 /* Get the `face' or `mouse_face' text property at POS, and
6660 determine the next position at which the property changes. */
6661 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6662 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6663 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6665 endpos
= XINT (end
);
6667 /* Look at properties from overlays. */
6672 /* First try with room for 40 overlays. */
6674 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6675 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6676 &next_overlay
, NULL
, 0);
6678 /* If there are more than 40, make enough space for all, and try
6680 if (noverlays
> len
)
6683 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6684 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6685 &next_overlay
, NULL
, 0);
6688 if (next_overlay
< endpos
)
6689 endpos
= next_overlay
;
6694 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6696 /* Optimize common cases where we can use the default face. */
6699 && !(pos
>= region_beg
&& pos
< region_end
))
6700 return DEFAULT_FACE_ID
;
6702 /* Begin with attributes from the default face. */
6703 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6705 /* Merge in attributes specified via text properties. */
6707 merge_face_vector_with_property (f
, attrs
, prop
);
6709 /* Now merge the overlay data. */
6710 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6711 for (i
= 0; i
< noverlays
; i
++)
6716 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6718 merge_face_vector_with_property (f
, attrs
, prop
);
6720 oend
= OVERLAY_END (overlay_vec
[i
]);
6721 oendpos
= OVERLAY_POSITION (oend
);
6722 if (oendpos
< endpos
)
6726 /* If in the region, merge in the region face. */
6727 if (pos
>= region_beg
&& pos
< region_end
)
6729 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6730 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6732 if (region_end
< endpos
)
6733 endpos
= region_end
;
6738 /* Look up a realized face with the given face attributes,
6739 or realize a new one for ASCII characters. */
6740 return lookup_face (f
, attrs
, 0, NULL
);
6744 /* Compute the face at character position POS in Lisp string STRING on
6745 window W, for ASCII characters.
6747 If STRING is an overlay string, it comes from position BUFPOS in
6748 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6749 not an overlay string. W must display the current buffer.
6750 REGION_BEG and REGION_END give the start and end positions of the
6751 region; both are -1 if no region is visible.
6753 BASE_FACE_ID is the id of a face to merge with. For strings coming
6754 from overlays or the `display' property it is the face at BUFPOS.
6756 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6758 Set *ENDPTR to the next position where to check for faces in
6759 STRING; -1 if the face is constant from POS to the end of the
6762 Value is the id of the face to use. The face returned is suitable
6763 for displaying ASCII characters. */
6766 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6767 region_end
, endptr
, base_face_id
, mouse_p
)
6771 int region_beg
, region_end
;
6773 enum face_id base_face_id
;
6776 Lisp_Object prop
, position
, end
, limit
;
6777 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6778 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6779 struct face
*base_face
;
6780 int multibyte_p
= STRING_MULTIBYTE (string
);
6781 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6783 /* Get the value of the face property at the current position within
6784 STRING. Value is nil if there is no face property. */
6785 XSETFASTINT (position
, pos
);
6786 prop
= Fget_text_property (position
, prop_name
, string
);
6788 /* Get the next position at which to check for faces. Value of end
6789 is nil if face is constant all the way to the end of the string.
6790 Otherwise it is a string position where to check faces next.
6791 Limit is the maximum position up to which to check for property
6792 changes in Fnext_single_property_change. Strings are usually
6793 short, so set the limit to the end of the string. */
6794 XSETFASTINT (limit
, XSTRING (string
)->size
);
6795 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6797 *endptr
= XFASTINT (end
);
6801 base_face
= FACE_FROM_ID (f
, base_face_id
);
6802 xassert (base_face
);
6804 /* Optimize the default case that there is no face property and we
6805 are not in the region. */
6807 && (base_face_id
!= DEFAULT_FACE_ID
6808 /* BUFPOS <= 0 means STRING is not an overlay string, so
6809 that the region doesn't have to be taken into account. */
6811 || bufpos
< region_beg
6812 || bufpos
>= region_end
)
6814 /* We can't realize faces for different charsets differently
6815 if we don't have fonts, so we can stop here if not working
6816 on a window-system frame. */
6817 || !FRAME_WINDOW_P (f
)
6818 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6819 return base_face
->id
;
6821 /* Begin with attributes from the base face. */
6822 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6824 /* Merge in attributes specified via text properties. */
6826 merge_face_vector_with_property (f
, attrs
, prop
);
6828 /* If in the region, merge in the region face. */
6830 && bufpos
>= region_beg
6831 && bufpos
< region_end
)
6833 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6834 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6837 /* Look up a realized face with the given face attributes,
6838 or realize a new one for ASCII characters. */
6839 return lookup_face (f
, attrs
, 0, NULL
);
6844 /***********************************************************************
6846 ***********************************************************************/
6850 /* Print the contents of the realized face FACE to stderr. */
6853 dump_realized_face (face
)
6856 fprintf (stderr
, "ID: %d\n", face
->id
);
6857 #ifdef HAVE_X_WINDOWS
6858 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6860 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6862 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6863 fprintf (stderr
, "background: 0x%lx (%s)\n",
6865 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6866 fprintf (stderr
, "font_name: %s (%s)\n",
6868 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6869 #ifdef HAVE_X_WINDOWS
6870 fprintf (stderr
, "font = %p\n", face
->font
);
6872 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6873 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6874 fprintf (stderr
, "underline: %d (%s)\n",
6876 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6877 fprintf (stderr
, "hash: %d\n", face
->hash
);
6878 fprintf (stderr
, "charset: %d\n", face
->charset
);
6882 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6890 fprintf (stderr
, "font selection order: ");
6891 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6892 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6893 fprintf (stderr
, "\n");
6895 fprintf (stderr
, "alternative fonts: ");
6896 debug_print (Vface_alternative_font_family_alist
);
6897 fprintf (stderr
, "\n");
6899 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6900 Fdump_face (make_number (i
));
6905 CHECK_NUMBER (n
, 0);
6906 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6908 error ("Not a valid face");
6909 dump_realized_face (face
);
6916 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6920 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6921 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6922 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6926 #endif /* GLYPH_DEBUG != 0 */
6930 /***********************************************************************
6932 ***********************************************************************/
6937 Qface
= intern ("face");
6939 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6940 staticpro (&Qbitmap_spec_p
);
6941 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6942 staticpro (&Qframe_update_face_colors
);
6944 /* Lisp face attribute keywords. */
6945 QCfamily
= intern (":family");
6946 staticpro (&QCfamily
);
6947 QCheight
= intern (":height");
6948 staticpro (&QCheight
);
6949 QCweight
= intern (":weight");
6950 staticpro (&QCweight
);
6951 QCslant
= intern (":slant");
6952 staticpro (&QCslant
);
6953 QCunderline
= intern (":underline");
6954 staticpro (&QCunderline
);
6955 QCinverse_video
= intern (":inverse-video");
6956 staticpro (&QCinverse_video
);
6957 QCreverse_video
= intern (":reverse-video");
6958 staticpro (&QCreverse_video
);
6959 QCforeground
= intern (":foreground");
6960 staticpro (&QCforeground
);
6961 QCbackground
= intern (":background");
6962 staticpro (&QCbackground
);
6963 QCstipple
= intern (":stipple");;
6964 staticpro (&QCstipple
);
6965 QCwidth
= intern (":width");
6966 staticpro (&QCwidth
);
6967 QCfont
= intern (":font");
6968 staticpro (&QCfont
);
6969 QCbold
= intern (":bold");
6970 staticpro (&QCbold
);
6971 QCitalic
= intern (":italic");
6972 staticpro (&QCitalic
);
6973 QCoverline
= intern (":overline");
6974 staticpro (&QCoverline
);
6975 QCstrike_through
= intern (":strike-through");
6976 staticpro (&QCstrike_through
);
6977 QCbox
= intern (":box");
6979 QCinherit
= intern (":inherit");
6980 staticpro (&QCinherit
);
6982 /* Symbols used for Lisp face attribute values. */
6983 QCcolor
= intern (":color");
6984 staticpro (&QCcolor
);
6985 QCline_width
= intern (":line-width");
6986 staticpro (&QCline_width
);
6987 QCstyle
= intern (":style");
6988 staticpro (&QCstyle
);
6989 Qreleased_button
= intern ("released-button");
6990 staticpro (&Qreleased_button
);
6991 Qpressed_button
= intern ("pressed-button");
6992 staticpro (&Qpressed_button
);
6993 Qnormal
= intern ("normal");
6994 staticpro (&Qnormal
);
6995 Qultra_light
= intern ("ultra-light");
6996 staticpro (&Qultra_light
);
6997 Qextra_light
= intern ("extra-light");
6998 staticpro (&Qextra_light
);
6999 Qlight
= intern ("light");
7000 staticpro (&Qlight
);
7001 Qsemi_light
= intern ("semi-light");
7002 staticpro (&Qsemi_light
);
7003 Qsemi_bold
= intern ("semi-bold");
7004 staticpro (&Qsemi_bold
);
7005 Qbold
= intern ("bold");
7007 Qextra_bold
= intern ("extra-bold");
7008 staticpro (&Qextra_bold
);
7009 Qultra_bold
= intern ("ultra-bold");
7010 staticpro (&Qultra_bold
);
7011 Qoblique
= intern ("oblique");
7012 staticpro (&Qoblique
);
7013 Qitalic
= intern ("italic");
7014 staticpro (&Qitalic
);
7015 Qreverse_oblique
= intern ("reverse-oblique");
7016 staticpro (&Qreverse_oblique
);
7017 Qreverse_italic
= intern ("reverse-italic");
7018 staticpro (&Qreverse_italic
);
7019 Qultra_condensed
= intern ("ultra-condensed");
7020 staticpro (&Qultra_condensed
);
7021 Qextra_condensed
= intern ("extra-condensed");
7022 staticpro (&Qextra_condensed
);
7023 Qcondensed
= intern ("condensed");
7024 staticpro (&Qcondensed
);
7025 Qsemi_condensed
= intern ("semi-condensed");
7026 staticpro (&Qsemi_condensed
);
7027 Qsemi_expanded
= intern ("semi-expanded");
7028 staticpro (&Qsemi_expanded
);
7029 Qexpanded
= intern ("expanded");
7030 staticpro (&Qexpanded
);
7031 Qextra_expanded
= intern ("extra-expanded");
7032 staticpro (&Qextra_expanded
);
7033 Qultra_expanded
= intern ("ultra-expanded");
7034 staticpro (&Qultra_expanded
);
7035 Qbackground_color
= intern ("background-color");
7036 staticpro (&Qbackground_color
);
7037 Qforeground_color
= intern ("foreground-color");
7038 staticpro (&Qforeground_color
);
7039 Qunspecified
= intern ("unspecified");
7040 staticpro (&Qunspecified
);
7042 Qface_alias
= intern ("face-alias");
7043 staticpro (&Qface_alias
);
7044 Qdefault
= intern ("default");
7045 staticpro (&Qdefault
);
7046 Qtool_bar
= intern ("tool-bar");
7047 staticpro (&Qtool_bar
);
7048 Qregion
= intern ("region");
7049 staticpro (&Qregion
);
7050 Qfringe
= intern ("fringe");
7051 staticpro (&Qfringe
);
7052 Qheader_line
= intern ("header-line");
7053 staticpro (&Qheader_line
);
7054 Qscroll_bar
= intern ("scroll-bar");
7055 staticpro (&Qscroll_bar
);
7056 Qmenu
= intern ("menu");
7058 Qcursor
= intern ("cursor");
7059 staticpro (&Qcursor
);
7060 Qborder
= intern ("border");
7061 staticpro (&Qborder
);
7062 Qmouse
= intern ("mouse");
7063 staticpro (&Qmouse
);
7064 Qtty_color_desc
= intern ("tty-color-desc");
7065 staticpro (&Qtty_color_desc
);
7066 Qtty_color_by_index
= intern ("tty-color-by-index");
7067 staticpro (&Qtty_color_by_index
);
7068 Qtty_color_alist
= intern ("tty-color-alist");
7069 staticpro (&Qtty_color_alist
);
7071 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7072 staticpro (&Vparam_value_alist
);
7073 Vface_alternative_font_family_alist
= Qnil
;
7074 staticpro (&Vface_alternative_font_family_alist
);
7075 Vface_alternative_font_registry_alist
= Qnil
;
7076 staticpro (&Vface_alternative_font_registry_alist
);
7078 defsubr (&Sinternal_make_lisp_face
);
7079 defsubr (&Sinternal_lisp_face_p
);
7080 defsubr (&Sinternal_set_lisp_face_attribute
);
7081 #ifdef HAVE_WINDOW_SYSTEM
7082 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7084 defsubr (&Scolor_gray_p
);
7085 defsubr (&Scolor_supported_p
);
7086 defsubr (&Sinternal_get_lisp_face_attribute
);
7087 defsubr (&Sinternal_lisp_face_attribute_values
);
7088 defsubr (&Sinternal_lisp_face_equal_p
);
7089 defsubr (&Sinternal_lisp_face_empty_p
);
7090 defsubr (&Sinternal_copy_lisp_face
);
7091 defsubr (&Sinternal_merge_in_global_face
);
7092 defsubr (&Sface_font
);
7093 defsubr (&Sframe_face_alist
);
7094 defsubr (&Sinternal_set_font_selection_order
);
7095 defsubr (&Sinternal_set_alternative_font_family_alist
);
7096 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7098 defsubr (&Sdump_face
);
7099 defsubr (&Sshow_face_resources
);
7100 #endif /* GLYPH_DEBUG */
7101 defsubr (&Sclear_face_cache
);
7102 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7104 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7105 defsubr (&Sdump_colors
);
7108 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7109 "*Limit for font matching.\n\
7110 If an integer > 0, font matching functions won't load more than\n\
7111 that number of fonts when searching for a matching font.");
7112 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7114 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7115 "List of global face definitions (for internal use only.)");
7116 Vface_new_frame_defaults
= Qnil
;
7118 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7119 "*Default stipple pattern used on monochrome displays.\n\
7120 This stipple pattern is used on monochrome displays\n\
7121 instead of shades of gray for a face background color.\n\
7122 See `set-face-stipple' for possible values for this variable.");
7123 Vface_default_stipple
= build_string ("gray3");
7125 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7126 "An alist of defined terminal colors and their RGB values.");
7127 Vtty_defined_color_alist
= Qnil
;
7129 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7130 "Allowed scalable fonts.\n\
7131 A value of nil means don't allow any scalable fonts.\n\
7132 A value of t means allow any scalable font.\n\
7133 Otherwise, value must be a list of regular expressions. A font may be\n\
7134 scaled if its name matches a regular expression in the list.");
7135 #if defined (WINDOWSNT) || defined (macintosh)
7136 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7137 by default limits the fonts available severely. */
7138 Vscalable_fonts_allowed
= Qt
;
7140 Vscalable_fonts_allowed
= Qnil
;
7143 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7144 "List of ignored fonts.\n\
7145 Each element is a regular expression that matches names of fonts to ignore.");
7146 Vface_ignored_fonts
= Qnil
;
7148 #ifdef HAVE_WINDOW_SYSTEM
7149 defsubr (&Sbitmap_spec_p
);
7150 defsubr (&Sx_list_fonts
);
7151 defsubr (&Sinternal_face_x_get_resource
);
7152 defsubr (&Sx_family_fonts
);
7153 defsubr (&Sx_font_family_list
);
7154 #endif /* HAVE_WINDOW_SYSTEM */