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>
199 #include "keyboard.h"
202 #ifdef HAVE_WINDOW_SYSTEM
204 #endif /* HAVE_WINDOW_SYSTEM */
206 #ifdef HAVE_X_WINDOWS
210 #include <Xm/XmStrDefs.h>
211 #endif /* USE_MOTIF */
212 #endif /* HAVE_X_WINDOWS */
221 /* Redefine X specifics to W32 equivalents to avoid cluttering the
222 code with #ifdef blocks. */
223 #undef FRAME_X_DISPLAY_INFO
224 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
225 #define x_display_info w32_display_info
226 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
227 #define check_x check_w32
228 #define x_list_fonts w32_list_fonts
229 #define GCGraphicsExposures 0
230 /* For historic reasons, FONT_WIDTH refers to average width on W32,
231 not maximum as on X. Redefine here. */
233 #define FONT_WIDTH FONT_MAX_WIDTH
234 #endif /* WINDOWSNT */
238 #define x_display_info mac_display_info
239 #define check_x check_mac
241 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
244 x_create_gc (f
, mask
, xgcv
)
250 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
259 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
264 #include "dispextern.h"
265 #include "blockinput.h"
267 #include "intervals.h"
269 #ifdef HAVE_X_WINDOWS
271 /* Compensate for a bug in Xos.h on some systems, on which it requires
272 time.h. On some such systems, Xos.h tries to redefine struct
273 timeval and struct timezone if USG is #defined while it is
276 #ifdef XOS_NEEDS_TIME_H
282 #else /* not XOS_NEEDS_TIME_H */
284 #endif /* not XOS_NEEDS_TIME_H */
286 #endif /* HAVE_X_WINDOWS */
292 #define max(A, B) ((A) > (B) ? (A) : (B))
293 #define min(A, B) ((A) < (B) ? (A) : (B))
294 #define abs(X) ((X) < 0 ? -(X) : (X))
297 /* Number of pt per inch (from the TeXbook). */
299 #define PT_PER_INCH 72.27
301 /* Non-zero if face attribute ATTR is unspecified. */
303 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
305 /* Value is the number of elements of VECTOR. */
307 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
309 /* Make a copy of string S on the stack using alloca. Value is a pointer
312 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
314 /* Make a copy of the contents of Lisp string S on the stack using
315 alloca. Value is a pointer to the copy. */
317 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
319 /* Size of hash table of realized faces in face caches (should be a
322 #define FACE_CACHE_BUCKETS_SIZE 1001
324 /* A definition of XColor for non-X frames. */
326 #ifndef HAVE_X_WINDOWS
331 unsigned short red
, green
, blue
;
337 #endif /* not HAVE_X_WINDOWS */
339 /* Keyword symbols used for face attribute names. */
341 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
342 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
343 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
344 Lisp_Object QCreverse_video
;
345 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
347 /* Symbols used for attribute values. */
349 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
350 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
351 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
352 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
353 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
354 Lisp_Object Qultra_expanded
;
355 Lisp_Object Qreleased_button
, Qpressed_button
;
356 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
357 Lisp_Object Qunspecified
;
359 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
361 /* The name of the function to call when the background of the frame
362 has changed, frame_update_face_colors. */
364 Lisp_Object Qframe_update_face_colors
;
366 /* Names of basic faces. */
368 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
369 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
370 extern Lisp_Object Qmode_line
;
372 /* The symbol `face-alias'. A symbols having that property is an
373 alias for another face. Value of the property is the name of
376 Lisp_Object Qface_alias
;
378 /* Names of frame parameters related to faces. */
380 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
381 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
383 /* Default stipple pattern used on monochrome displays. This stipple
384 pattern is used on monochrome displays instead of shades of gray
385 for a face background color. See `set-face-stipple' for possible
386 values for this variable. */
388 Lisp_Object Vface_default_stipple
;
390 /* Alist of alternative font families. Each element is of the form
391 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
392 try FAMILY1, then FAMILY2, ... */
394 Lisp_Object Vface_alternative_font_family_alist
;
396 /* Alist of alternative font registries. Each element is of the form
397 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
398 loaded, try REGISTRY1, then REGISTRY2, ... */
400 Lisp_Object Vface_alternative_font_registry_alist
;
402 /* Allowed scalable fonts. A value of nil means don't allow any
403 scalable fonts. A value of t means allow the use of any scalable
404 font. Otherwise, value must be a list of regular expressions. A
405 font may be scaled if its name matches a regular expression in the
408 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
410 /* List of regular expressions that matches names of fonts to ignore. */
412 Lisp_Object Vface_ignored_fonts
;
414 /* Maximum number of fonts to consider in font_list. If not an
415 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
417 Lisp_Object Vfont_list_limit
;
418 #define DEFAULT_FONT_LIST_LIMIT 100
420 /* The symbols `foreground-color' and `background-color' which can be
421 used as part of a `face' property. This is for compatibility with
424 Lisp_Object Qforeground_color
, Qbackground_color
;
426 /* The symbols `face' and `mouse-face' used as text properties. */
429 extern Lisp_Object Qmouse_face
;
431 /* Error symbol for wrong_type_argument in load_pixmap. */
433 Lisp_Object Qbitmap_spec_p
;
435 /* Alist of global face definitions. Each element is of the form
436 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
437 is a Lisp vector of face attributes. These faces are used
438 to initialize faces for new frames. */
440 Lisp_Object Vface_new_frame_defaults
;
442 /* The next ID to assign to Lisp faces. */
444 static int next_lface_id
;
446 /* A vector mapping Lisp face Id's to face names. */
448 static Lisp_Object
*lface_id_to_name
;
449 static int lface_id_to_name_size
;
451 /* TTY color-related functions (defined in tty-colors.el). */
453 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
455 /* The name of the function used to compute colors on TTYs. */
457 Lisp_Object Qtty_color_alist
;
459 /* An alist of defined terminal colors and their RGB values. */
461 Lisp_Object Vtty_defined_color_alist
;
463 /* Counter for calls to clear_face_cache. If this counter reaches
464 CLEAR_FONT_TABLE_COUNT, and a frame has more than
465 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
467 static int clear_font_table_count
;
468 #define CLEAR_FONT_TABLE_COUNT 100
469 #define CLEAR_FONT_TABLE_NFONTS 10
471 /* Non-zero means face attributes have been changed since the last
472 redisplay. Used in redisplay_internal. */
474 int face_change_count
;
476 /* Incremented for every change in the `menu' face. */
478 int menu_face_change_count
;
480 /* Non-zero means don't display bold text if a face's foreground
481 and background colors are the inverse of the default colors of the
482 display. This is a kluge to suppress `bold black' foreground text
483 which is hard to read on an LCD monitor. */
485 int tty_suppress_bold_inverse_default_colors_p
;
487 /* A list of the form `((x . y))' used to avoid consing in
488 Finternal_set_lisp_face_attribute. */
490 static Lisp_Object Vparam_value_alist
;
492 /* The total number of colors currently allocated. */
495 static int ncolors_allocated
;
496 static int npixmaps_allocated
;
502 /* Function prototypes. */
507 static void map_tty_color
P_ ((struct frame
*, struct face
*,
508 enum lface_attribute_index
, int *));
509 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
510 static int may_use_scalable_font_p
P_ ((char *));
511 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
512 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
514 static int x_face_list_fonts
P_ ((struct frame
*, char *,
515 struct font_name
*, int, int));
516 static int font_scalable_p
P_ ((struct font_name
*));
517 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
518 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
519 static unsigned char *xstrlwr
P_ ((unsigned char *));
520 static void signal_error
P_ ((char *, Lisp_Object
));
521 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
522 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
523 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
524 static void free_face_colors
P_ ((struct frame
*, struct face
*));
525 static int face_color_gray_p
P_ ((struct frame
*, char *));
526 static char *build_font_name
P_ ((struct font_name
*));
527 static void free_font_names
P_ ((struct font_name
*, int));
528 static int sorted_font_list
P_ ((struct frame
*, char *,
529 int (*cmpfn
) P_ ((const void *, const void *)),
530 struct font_name
**));
531 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
532 Lisp_Object
, struct font_name
**));
533 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
534 Lisp_Object
, struct font_name
**));
535 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
536 Lisp_Object
, Lisp_Object
, struct font_name
**));
537 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
538 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 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2129 if (*pixel_field
== '[')
2131 /* The pixel size field is `[A B C D]' which specifies
2132 a transformation matrix.
2138 by which all glyphs of the font are transformed. The spec
2139 says that s scalar value N for the pixel size is equivalent
2140 to A = N * resx/resy, B = C = 0, D = N. */
2141 char *start
= pixel_field
+ 1, *end
;
2145 for (i
= 0; i
< 4; ++i
)
2147 matrix
[i
] = strtod (start
, &end
);
2151 pixel
= matrix
[3] / 10.0;
2154 pixel
= atoi (pixel_field
);
2159 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2165 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2166 of frame F. This function is used to guess a point size of font
2167 when only the pixel height of the font is available. */
2170 pixel_point_size (f
, pixel
)
2174 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2178 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2179 point size of one dot. */
2180 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2181 int_pt
= real_pt
+ 0.5;
2187 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2188 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2189 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2190 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2191 zero if the font name doesn't have the format we expect. The
2192 expected format is a font name that starts with a `-' and has
2193 XLFD_LAST fields separated by `-'. */
2196 split_font_name (f
, font
, numeric_p
)
2198 struct font_name
*font
;
2204 if (*font
->name
== '-')
2206 char *p
= xstrlwr (font
->name
) + 1;
2208 for (; i
< XLFD_LAST
; ++i
)
2210 font
->fields
[i
] = p
;
2212 /* Pixel and point size may be of the form `[....]'. For
2213 BNF, see XLFD spec, chapter 4. Negative values are
2214 indicated by tilde characters which we replace with
2215 `-' characters, here. */
2217 && (i
== XLFD_PIXEL_SIZE
2218 || i
== XLFD_POINT_SIZE
))
2223 for (++p
; *p
&& *p
!= ']'; ++p
)
2227 /* Check that the matrix contains 4 floating point
2229 for (j
= 0, start
= font
->fields
[i
] + 1;
2232 if (strtod (start
, &end
) == 0 && start
== end
)
2239 while (*p
&& *p
!= '-')
2249 success_p
= i
== XLFD_LAST
;
2251 /* If requested, and font name was in the expected format,
2252 compute numeric values for some fields. */
2253 if (numeric_p
&& success_p
)
2255 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2256 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2257 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2258 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2259 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2260 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2263 /* Initialize it to zero. It will be overridden by font_list while
2264 trying alternate registries. */
2265 font
->registry_priority
= 0;
2271 /* Build an XLFD font name from font name fields in FONT. Value is a
2272 pointer to the font name, which is allocated via xmalloc. */
2275 build_font_name (font
)
2276 struct font_name
*font
;
2280 char *font_name
= (char *) xmalloc (size
);
2281 int total_length
= 0;
2283 for (i
= 0; i
< XLFD_LAST
; ++i
)
2285 /* Add 1 because of the leading `-'. */
2286 int len
= strlen (font
->fields
[i
]) + 1;
2288 /* Reallocate font_name if necessary. Add 1 for the final
2290 if (total_length
+ len
+ 1 >= size
)
2292 int new_size
= max (2 * size
, size
+ len
+ 1);
2293 int sz
= new_size
* sizeof *font_name
;
2294 font_name
= (char *) xrealloc (font_name
, sz
);
2298 font_name
[total_length
] = '-';
2299 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2300 total_length
+= len
;
2303 font_name
[total_length
] = 0;
2308 /* Free an array FONTS of N font_name structures. This frees FONTS
2309 itself and all `name' fields in its elements. */
2312 free_font_names (fonts
, n
)
2313 struct font_name
*fonts
;
2317 xfree (fonts
[--n
].name
);
2322 /* Sort vector FONTS of font_name structures which contains NFONTS
2323 elements using qsort and comparison function CMPFN. F is the frame
2324 on which the fonts will be used. The global variable font_frame
2325 is temporarily set to F to make it available in CMPFN. */
2328 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2330 struct font_name
*fonts
;
2332 int (*cmpfn
) P_ ((const void *, const void *));
2335 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2340 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2341 display in x_display_list. FONTS is a pointer to a vector of
2342 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2343 alternative patterns from Valternate_fontname_alist if no fonts are
2344 found matching PATTERN.
2346 For all fonts found, set FONTS[i].name to the name of the font,
2347 allocated via xmalloc, and split font names into fields. Ignore
2348 fonts that we can't parse. Value is the number of fonts found. */
2351 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2354 struct font_name
*fonts
;
2355 int nfonts
, try_alternatives_p
;
2359 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2360 better to do it the other way around. */
2362 Lisp_Object lpattern
, tem
;
2364 lpattern
= build_string (pattern
);
2366 /* Get the list of fonts matching PATTERN. */
2369 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2372 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2375 /* Make a copy of the font names we got from X, and
2376 split them into fields. */
2378 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2380 Lisp_Object elt
, tail
;
2381 char *name
= XSTRING (XCAR (tem
))->data
;
2383 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2384 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2388 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2397 /* Make a copy of the font name. */
2398 fonts
[n
].name
= xstrdup (name
);
2400 if (split_font_name (f
, fonts
+ n
, 1))
2402 if (font_scalable_p (fonts
+ n
)
2403 && !may_use_scalable_font_p (name
))
2406 xfree (fonts
[n
].name
);
2412 xfree (fonts
[n
].name
);
2415 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2416 if (n
== 0 && try_alternatives_p
)
2418 Lisp_Object list
= Valternate_fontname_alist
;
2420 while (CONSP (list
))
2422 Lisp_Object entry
= XCAR (list
);
2424 && STRINGP (XCAR (entry
))
2425 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2432 Lisp_Object patterns
= XCAR (list
);
2435 while (CONSP (patterns
)
2436 /* If list is screwed up, give up. */
2437 && (name
= XCAR (patterns
),
2439 /* Ignore patterns equal to PATTERN because we tried that
2440 already with no success. */
2441 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2442 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2445 patterns
= XCDR (patterns
);
2453 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2454 using comparison function CMPFN. Value is the number of fonts
2455 found. If value is non-zero, *FONTS is set to a vector of
2456 font_name structures allocated from the heap containing matching
2457 fonts. Each element of *FONTS contains a name member that is also
2458 allocated from the heap. Font names in these structures are split
2459 into fields. Use free_font_names to free such an array. */
2462 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2465 int (*cmpfn
) P_ ((const void *, const void *));
2466 struct font_name
**fonts
;
2470 /* Get the list of fonts matching pattern. 100 should suffice. */
2471 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2472 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2473 nfonts
= XFASTINT (Vfont_list_limit
);
2475 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2476 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2478 /* Sort the resulting array and return it in *FONTS. If no
2479 fonts were found, make sure to set *FONTS to null. */
2481 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2492 /* Compare two font_name structures *A and *B. Value is analogous to
2493 strcmp. Sort order is given by the global variable
2494 font_sort_order. Font names are sorted so that, everything else
2495 being equal, fonts with a resolution closer to that of the frame on
2496 which they are used are listed first. The global variable
2497 font_frame is the frame on which we operate. */
2500 cmp_font_names (a
, b
)
2503 struct font_name
*x
= (struct font_name
*) a
;
2504 struct font_name
*y
= (struct font_name
*) b
;
2507 /* All strings have been converted to lower-case by split_font_name,
2508 so we can use strcmp here. */
2509 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2514 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2516 int j
= font_sort_order
[i
];
2517 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2522 /* Everything else being equal, we prefer fonts with an
2523 y-resolution closer to that of the frame. */
2524 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2525 int x_resy
= x
->numeric
[XLFD_RESY
];
2526 int y_resy
= y
->numeric
[XLFD_RESY
];
2527 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2535 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2536 is non-nil list fonts matching that pattern. Otherwise, if
2537 REGISTRY is non-nil return only fonts with that registry, otherwise
2538 return fonts of any registry. Set *FONTS to a vector of font_name
2539 structures allocated from the heap containing the fonts found.
2540 Value is the number of fonts found. */
2543 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2545 Lisp_Object pattern
, family
, registry
;
2546 struct font_name
**fonts
;
2548 char *pattern_str
, *family_str
, *registry_str
;
2552 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2553 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2555 pattern_str
= (char *) alloca (strlen (family_str
)
2556 + strlen (registry_str
)
2558 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2559 strcat (pattern_str
, family_str
);
2560 strcat (pattern_str
, "-*-");
2561 strcat (pattern_str
, registry_str
);
2562 if (!index (registry_str
, '-'))
2564 if (registry_str
[strlen (registry_str
) - 1] == '*')
2565 strcat (pattern_str
, "-*");
2567 strcat (pattern_str
, "*-*");
2571 pattern_str
= (char *) XSTRING (pattern
)->data
;
2573 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2577 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2578 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2579 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2582 static struct font_name
*
2583 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2584 struct font_name
*fonts1
, *fonts2
;
2585 int nfonts1
, nfonts2
;
2587 int new_nfonts
= nfonts1
+ nfonts2
;
2588 struct font_name
*new_fonts
;
2590 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2591 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2592 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2599 /* Get a sorted list of fonts of family FAMILY on frame F.
2601 If PATTERN is non-nil list fonts matching that pattern.
2603 If REGISTRY is non-nil, return fonts with that registry and the
2604 alternative registries from Vface_alternative_font_registry_alist.
2606 If REGISTRY is nil return fonts of any registry.
2608 Set *FONTS to a vector of font_name structures allocated from the
2609 heap containing the fonts found. Value is the number of fonts
2613 font_list (f
, pattern
, family
, registry
, fonts
)
2615 Lisp_Object pattern
, family
, registry
;
2616 struct font_name
**fonts
;
2618 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2620 if (!NILP (registry
)
2621 && CONSP (Vface_alternative_font_registry_alist
))
2625 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2630 for (alter
= XCDR (alter
), reg_prio
= 1;
2632 alter
= XCDR (alter
), reg_prio
++)
2633 if (STRINGP (XCAR (alter
)))
2636 struct font_name
*fonts2
;
2638 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2640 for (i
= 0; i
< nfonts2
; i
++)
2641 fonts2
[i
].registry_priority
= reg_prio
;
2642 *fonts
= (nfonts
> 0
2643 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2654 /* Remove elements from LIST whose cars are `equal'. Called from
2655 x-family-fonts and x-font-family-list to remove duplicate font
2659 remove_duplicates (list
)
2662 Lisp_Object tail
= list
;
2664 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2666 Lisp_Object next
= XCDR (tail
);
2667 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2668 XCDR (tail
) = XCDR (next
);
2675 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2676 "Return a list of available fonts of family FAMILY on FRAME.\n\
2677 If FAMILY is omitted or nil, list all families.\n\
2678 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2680 If FRAME is omitted or nil, use the selected frame.\n\
2681 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2682 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2683 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2684 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2685 width, weight and slant of the font. These symbols are the same as for\n\
2686 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2687 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2688 giving the registry and encoding of the font.\n\
2689 The result list is sorted according to the current setting of\n\
2690 the face font sort order.")
2692 Lisp_Object family
, frame
;
2694 struct frame
*f
= check_x_frame (frame
);
2695 struct font_name
*fonts
;
2698 struct gcpro gcpro1
;
2701 CHECK_STRING (family
, 1);
2705 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2706 for (i
= nfonts
- 1; i
>= 0; --i
)
2708 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2711 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2712 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2713 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2714 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2715 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2716 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2717 tem
= build_font_name (fonts
+ i
);
2718 ASET (v
, 6, build_string (tem
));
2719 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2720 fonts
[i
].fields
[XLFD_ENCODING
]);
2721 ASET (v
, 7, build_string (tem
));
2724 result
= Fcons (v
, result
);
2727 remove_duplicates (result
);
2728 free_font_names (fonts
, nfonts
);
2734 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2736 "Return a list of available font families on FRAME.\n\
2737 If FRAME is omitted or nil, use the selected frame.\n\
2738 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2739 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2744 struct frame
*f
= check_x_frame (frame
);
2746 struct font_name
*fonts
;
2748 struct gcpro gcpro1
;
2749 int count
= specpdl_ptr
- specpdl
;
2752 /* Let's consider all fonts. Increase the limit for matching
2753 fonts until we have them all. */
2756 specbind (intern ("font-list-limit"), make_number (limit
));
2757 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2759 if (nfonts
== limit
)
2761 free_font_names (fonts
, nfonts
);
2770 for (i
= nfonts
- 1; i
>= 0; --i
)
2771 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2772 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2775 remove_duplicates (result
);
2776 free_font_names (fonts
, nfonts
);
2778 return unbind_to (count
, result
);
2782 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2783 "Return a list of the names of available fonts matching PATTERN.\n\
2784 If optional arguments FACE and FRAME are specified, return only fonts\n\
2785 the same size as FACE on FRAME.\n\
2786 PATTERN is a string, perhaps with wildcard characters;\n\
2787 the * character matches any substring, and\n\
2788 the ? character matches any single character.\n\
2789 PATTERN is case-insensitive.\n\
2790 FACE is a face name--a symbol.\n\
2792 The return value is a list of strings, suitable as arguments to\n\
2795 Fonts Emacs can't use may or may not be excluded\n\
2796 even if they match PATTERN and FACE.\n\
2797 The optional fourth argument MAXIMUM sets a limit on how many\n\
2798 fonts to match. The first MAXIMUM fonts are reported.\n\
2799 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2800 occupied by a character of a font. In that case, return only fonts\n\
2801 the WIDTH times as wide as FACE on FRAME.")
2802 (pattern
, face
, frame
, maximum
, width
)
2803 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2810 CHECK_STRING (pattern
, 0);
2816 CHECK_NATNUM (maximum
, 0);
2817 maxnames
= XINT (maximum
);
2821 CHECK_NUMBER (width
, 4);
2823 /* We can't simply call check_x_frame because this function may be
2824 called before any frame is created. */
2825 f
= frame_or_selected_frame (frame
, 2);
2826 if (!FRAME_WINDOW_P (f
))
2828 /* Perhaps we have not yet created any frame. */
2833 /* Determine the width standard for comparison with the fonts we find. */
2839 /* This is of limited utility since it works with character
2840 widths. Keep it for compatibility. --gerd. */
2841 int face_id
= lookup_named_face (f
, face
, 0);
2842 struct face
*face
= (face_id
< 0
2844 : FACE_FROM_ID (f
, face_id
));
2846 if (face
&& face
->font
)
2847 size
= FONT_WIDTH (face
->font
);
2849 size
= FONT_WIDTH (FRAME_FONT (f
));
2852 size
*= XINT (width
);
2856 Lisp_Object args
[2];
2858 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2860 /* We don't have to check fontsets. */
2862 args
[1] = list_fontsets (f
, pattern
, size
);
2863 return Fnconc (2, args
);
2867 #endif /* HAVE_WINDOW_SYSTEM */
2871 /***********************************************************************
2873 ***********************************************************************/
2875 /* Access face attributes of face LFACE, a Lisp vector. */
2877 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2878 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2879 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2880 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2881 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2882 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2883 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2884 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2885 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2886 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2887 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2888 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2889 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2890 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2891 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2892 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2894 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2895 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2897 #define LFACEP(LFACE) \
2899 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2900 && EQ (AREF (LFACE, 0), Qface))
2905 /* Check consistency of Lisp face attribute vector ATTRS. */
2908 check_lface_attrs (attrs
)
2911 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2912 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2913 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2914 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2915 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2916 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2917 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2918 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2919 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2920 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2921 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2922 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2923 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2924 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2925 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2926 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2927 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2928 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2929 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2930 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2931 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2932 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2933 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2934 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2935 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2936 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2937 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2938 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2939 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2940 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2941 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2942 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2943 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2944 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2945 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2946 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2947 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2948 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2949 #ifdef HAVE_WINDOW_SYSTEM
2950 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2952 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2953 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2954 || NILP (attrs
[LFACE_FONT_INDEX
])
2955 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2960 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2968 xassert (LFACEP (lface
));
2969 check_lface_attrs (XVECTOR (lface
)->contents
);
2973 #else /* GLYPH_DEBUG == 0 */
2975 #define check_lface_attrs(attrs) (void) 0
2976 #define check_lface(lface) (void) 0
2978 #endif /* GLYPH_DEBUG == 0 */
2981 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2982 to make it a symvol. If FACE_NAME is an alias for another face,
2983 return that face's name. */
2986 resolve_face_name (face_name
)
2987 Lisp_Object face_name
;
2989 Lisp_Object aliased
;
2991 if (STRINGP (face_name
))
2992 face_name
= intern (XSTRING (face_name
)->data
);
2994 while (SYMBOLP (face_name
))
2996 aliased
= Fget (face_name
, Qface_alias
);
3000 face_name
= aliased
;
3007 /* Return the face definition of FACE_NAME on frame F. F null means
3008 return the definition for new frames. FACE_NAME may be a string or
3009 a symbol (apparently Emacs 20.2 allowed strings as face names in
3010 face text properties; Ediff uses that). If FACE_NAME is an alias
3011 for another face, return that face's definition. If SIGNAL_P is
3012 non-zero, signal an error if FACE_NAME is not a valid face name.
3013 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3016 static INLINE Lisp_Object
3017 lface_from_face_name (f
, face_name
, signal_p
)
3019 Lisp_Object face_name
;
3024 face_name
= resolve_face_name (face_name
);
3027 lface
= assq_no_quit (face_name
, f
->face_alist
);
3029 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3032 lface
= XCDR (lface
);
3034 signal_error ("Invalid face", face_name
);
3036 check_lface (lface
);
3041 /* Get face attributes of face FACE_NAME from frame-local faces on
3042 frame F. Store the resulting attributes in ATTRS which must point
3043 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3044 is non-zero, signal an error if FACE_NAME does not name a face.
3045 Otherwise, value is zero if FACE_NAME is not a face. */
3048 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3050 Lisp_Object face_name
;
3057 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3060 bcopy (XVECTOR (lface
)->contents
, attrs
,
3061 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3071 /* Non-zero if all attributes in face attribute vector ATTRS are
3072 specified, i.e. are non-nil. */
3075 lface_fully_specified_p (attrs
)
3080 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3081 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3082 && i
!= LFACE_AVGWIDTH_INDEX
)
3083 if (UNSPECIFIEDP (attrs
[i
]))
3086 return i
== LFACE_VECTOR_SIZE
;
3089 #ifdef HAVE_WINDOW_SYSTEM
3091 /* Set font-related attributes of Lisp face LFACE from the fullname of
3092 the font opened by FONTNAME. If FORCE_P is zero, set only
3093 unspecified attributes of LFACE. The exception is `font'
3094 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3096 If FONTNAME is not available on frame F,
3097 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3098 If the fullname is not in a valid XLFD format,
3099 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3100 in LFACE and return 1.
3101 Otherwise, return 1. */
3104 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3107 Lisp_Object fontname
;
3108 int force_p
, may_fail_p
;
3110 struct font_name font
;
3115 char *font_name
= XSTRING (fontname
)->data
;
3116 struct font_info
*font_info
;
3118 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3119 fontset
= fs_query_fontset (fontname
, 0);
3121 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3123 /* Check if FONT_NAME is surely available on the system. Usually
3124 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3125 returns quickly. But, even if FONT_NAME is not yet cached,
3126 caching it now is not futail because we anyway load the font
3129 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3139 font
.name
= STRDUPA (font_info
->full_name
);
3140 have_xlfd_p
= split_font_name (f
, &font
, 1);
3142 /* Set attributes only if unspecified, otherwise face defaults for
3143 new frames would never take effect. If we couldn't get a font
3144 name conforming to XLFD, set normal values. */
3146 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3151 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3152 + strlen (font
.fields
[XLFD_FOUNDRY
])
3154 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3155 font
.fields
[XLFD_FAMILY
]);
3156 val
= build_string (buffer
);
3159 val
= build_string ("*");
3160 LFACE_FAMILY (lface
) = val
;
3163 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3166 pt
= xlfd_point_size (f
, &font
);
3168 pt
= pixel_point_size (f
, font_info
->height
* 10);
3170 LFACE_HEIGHT (lface
) = make_number (pt
);
3173 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3174 LFACE_SWIDTH (lface
)
3175 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3177 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3178 LFACE_AVGWIDTH (lface
)
3180 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3183 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3184 LFACE_WEIGHT (lface
)
3185 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3187 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3189 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3191 LFACE_FONT (lface
) = fontname
;
3196 #endif /* HAVE_WINDOW_SYSTEM */
3199 /* Merges the face height FROM with the face height TO, and returns the
3200 merged height. If FROM is an invalid height, then INVALID is
3201 returned instead. FROM may be a either an absolute face height or a
3202 `relative' height, and TO must be an absolute height. The returned
3203 value is always an absolute height. GCPRO is a lisp value that will
3204 be protected from garbage-collection if this function makes a call
3208 merge_face_heights (from
, to
, invalid
, gcpro
)
3209 Lisp_Object from
, to
, invalid
, gcpro
;
3213 if (INTEGERP (from
))
3214 result
= XINT (from
);
3215 else if (NUMBERP (from
))
3216 result
= XFLOATINT (from
) * XINT (to
);
3217 #if 0 /* Probably not so useful. */
3218 else if (CONSP (from
) && CONSP (XCDR (from
)))
3220 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3222 if (INTEGERP (XCAR (XCDR (from
))))
3224 int inc
= XINT (XCAR (XCDR (from
)));
3225 if (EQ (XCAR (from
), Qminus
))
3228 result
= XFASTINT (to
);
3229 if (result
+ inc
> 0)
3230 /* Note that `underflows' don't mean FROM is invalid, so
3231 we just pin the result at TO if it would otherwise be
3238 else if (FUNCTIONP (from
))
3240 /* Call function with current height as argument.
3241 From is the new height. */
3242 Lisp_Object args
[2], height
;
3243 struct gcpro gcpro1
;
3249 height
= safe_call (2, args
);
3253 if (NUMBERP (height
))
3254 result
= XFLOATINT (height
);
3258 return make_number (result
);
3264 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3265 store the resulting attributes in TO, which must be already be
3266 completely specified and contain only absolute attributes. Every
3267 specified attribute of FROM overrides the corresponding attribute of
3268 TO; relative attributes in FROM are merged with the absolute value in
3269 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3270 face inheritance; it should be Qnil when called from other places. */
3273 merge_face_vectors (f
, from
, to
, cycle_check
)
3275 Lisp_Object
*from
, *to
;
3276 Lisp_Object cycle_check
;
3280 /* If FROM inherits from some other faces, merge their attributes into
3281 TO before merging FROM's direct attributes. Note that an :inherit
3282 attribute of `unspecified' is the same as one of nil; we never
3283 merge :inherit attributes, so nil is more correct, but lots of
3284 other code uses `unspecified' as a generic value for face attributes. */
3285 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3286 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3287 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3289 /* If TO specifies a :font attribute, and FROM specifies some
3290 font-related attribute, we need to clear TO's :font attribute
3291 (because it will be inconsistent with whatever FROM specifies, and
3292 FROM takes precedence). */
3293 if (!NILP (to
[LFACE_FONT_INDEX
])
3294 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3295 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3296 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3297 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3298 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3299 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3300 to
[LFACE_FONT_INDEX
] = Qnil
;
3302 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3303 if (!UNSPECIFIEDP (from
[i
]))
3304 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3305 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3309 /* TO is always an absolute face, which should inherit from nothing.
3310 We blindly copy the :inherit attribute above and fix it up here. */
3311 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3315 /* Checks the `cycle check' variable CHECK to see if it indicates that
3316 EL is part of a cycle; CHECK must be either Qnil or a value returned
3317 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3318 elements after which a cycle might be suspected; after that many
3319 elements, this macro begins consing in order to keep more precise
3322 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3325 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3326 the caller should make sure that's ok. */
3328 #define CYCLE_CHECK(check, el, suspicious) \
3331 : (INTEGERP (check) \
3332 ? (XFASTINT (check) < (suspicious) \
3333 ? make_number (XFASTINT (check) + 1) \
3334 : Fcons (el, Qnil)) \
3335 : (!NILP (Fmemq ((el), (check))) \
3337 : Fcons ((el), (check)))))
3340 /* Merge face attributes from the face on frame F whose name is
3341 INHERITS, into the vector of face attributes TO; INHERITS may also be
3342 a list of face names, in which case they are applied in order.
3343 CYCLE_CHECK is used to detect loops in face inheritance.
3344 Returns true if any of the inherited attributes are `font-related'. */
3347 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3349 Lisp_Object inherit
;
3351 Lisp_Object cycle_check
;
3353 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3354 /* Inherit from the named face INHERIT. */
3358 /* Make sure we're not in an inheritance loop. */
3359 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3360 if (NILP (cycle_check
))
3361 /* Cycle detected, ignore any further inheritance. */
3364 lface
= lface_from_face_name (f
, inherit
, 0);
3366 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3368 else if (CONSP (inherit
))
3369 /* Handle a list of inherited faces by calling ourselves recursively
3370 on each element. Note that we only do so for symbol elements, so
3371 it's not possible to infinitely recurse. */
3373 while (CONSP (inherit
))
3375 if (SYMBOLP (XCAR (inherit
)))
3376 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3378 /* Check for a circular inheritance list. */
3379 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3380 if (NILP (cycle_check
))
3381 /* Cycle detected. */
3384 inherit
= XCDR (inherit
);
3390 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3391 is a face property, determine the resulting face attributes on
3392 frame F, and store them in TO. PROP may be a single face
3393 specification or a list of such specifications. Each face
3394 specification can be
3396 1. A symbol or string naming a Lisp face.
3398 2. A property list of the form (KEYWORD VALUE ...) where each
3399 KEYWORD is a face attribute name, and value is an appropriate value
3402 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3403 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3404 for compatibility with 20.2.
3406 Face specifications earlier in lists take precedence over later
3410 merge_face_vector_with_property (f
, to
, prop
)
3417 Lisp_Object first
= XCAR (prop
);
3419 if (EQ (first
, Qforeground_color
)
3420 || EQ (first
, Qbackground_color
))
3422 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3423 . COLOR). COLOR must be a string. */
3424 Lisp_Object color_name
= XCDR (prop
);
3425 Lisp_Object color
= first
;
3427 if (STRINGP (color_name
))
3429 if (EQ (color
, Qforeground_color
))
3430 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3432 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3435 add_to_log ("Invalid face color", color_name
, Qnil
);
3437 else if (SYMBOLP (first
)
3438 && *XSYMBOL (first
)->name
->data
== ':')
3440 /* Assume this is the property list form. */
3441 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3443 Lisp_Object keyword
= XCAR (prop
);
3444 Lisp_Object value
= XCAR (XCDR (prop
));
3446 if (EQ (keyword
, QCfamily
))
3448 if (STRINGP (value
))
3449 to
[LFACE_FAMILY_INDEX
] = value
;
3451 add_to_log ("Invalid face font family", value
, Qnil
);
3453 else if (EQ (keyword
, QCheight
))
3455 Lisp_Object new_height
=
3456 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3459 if (NILP (new_height
))
3460 add_to_log ("Invalid face font height", value
, Qnil
);
3462 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3464 else if (EQ (keyword
, QCweight
))
3467 && face_numeric_weight (value
) >= 0)
3468 to
[LFACE_WEIGHT_INDEX
] = value
;
3470 add_to_log ("Invalid face weight", value
, Qnil
);
3472 else if (EQ (keyword
, QCslant
))
3475 && face_numeric_slant (value
) >= 0)
3476 to
[LFACE_SLANT_INDEX
] = value
;
3478 add_to_log ("Invalid face slant", value
, Qnil
);
3480 else if (EQ (keyword
, QCunderline
))
3485 to
[LFACE_UNDERLINE_INDEX
] = value
;
3487 add_to_log ("Invalid face underline", value
, Qnil
);
3489 else if (EQ (keyword
, QCoverline
))
3494 to
[LFACE_OVERLINE_INDEX
] = value
;
3496 add_to_log ("Invalid face overline", value
, Qnil
);
3498 else if (EQ (keyword
, QCstrike_through
))
3503 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3505 add_to_log ("Invalid face strike-through", value
, Qnil
);
3507 else if (EQ (keyword
, QCbox
))
3510 value
= make_number (1);
3511 if (INTEGERP (value
)
3515 to
[LFACE_BOX_INDEX
] = value
;
3517 add_to_log ("Invalid face box", value
, Qnil
);
3519 else if (EQ (keyword
, QCinverse_video
)
3520 || EQ (keyword
, QCreverse_video
))
3522 if (EQ (value
, Qt
) || NILP (value
))
3523 to
[LFACE_INVERSE_INDEX
] = value
;
3525 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3527 else if (EQ (keyword
, QCforeground
))
3529 if (STRINGP (value
))
3530 to
[LFACE_FOREGROUND_INDEX
] = value
;
3532 add_to_log ("Invalid face foreground", value
, Qnil
);
3534 else if (EQ (keyword
, QCbackground
))
3536 if (STRINGP (value
))
3537 to
[LFACE_BACKGROUND_INDEX
] = value
;
3539 add_to_log ("Invalid face background", value
, Qnil
);
3541 else if (EQ (keyword
, QCstipple
))
3543 #ifdef HAVE_X_WINDOWS
3544 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3545 if (!NILP (pixmap_p
))
3546 to
[LFACE_STIPPLE_INDEX
] = value
;
3548 add_to_log ("Invalid face stipple", value
, Qnil
);
3551 else if (EQ (keyword
, QCwidth
))
3554 && face_numeric_swidth (value
) >= 0)
3555 to
[LFACE_SWIDTH_INDEX
] = value
;
3557 add_to_log ("Invalid face width", value
, Qnil
);
3559 else if (EQ (keyword
, QCinherit
))
3561 if (SYMBOLP (value
))
3562 to
[LFACE_INHERIT_INDEX
] = value
;
3566 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3567 if (!SYMBOLP (XCAR (tail
)))
3570 to
[LFACE_INHERIT_INDEX
] = value
;
3572 add_to_log ("Invalid face inherit", value
, Qnil
);
3576 add_to_log ("Invalid attribute %s in face property",
3579 prop
= XCDR (XCDR (prop
));
3584 /* This is a list of face specs. Specifications at the
3585 beginning of the list take precedence over later
3586 specifications, so we have to merge starting with the
3587 last specification. */
3588 Lisp_Object next
= XCDR (prop
);
3590 merge_face_vector_with_property (f
, to
, next
);
3591 merge_face_vector_with_property (f
, to
, first
);
3596 /* PROP ought to be a face name. */
3597 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3599 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3601 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3606 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3607 Sinternal_make_lisp_face
, 1, 2, 0,
3608 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3609 If FACE was not known as a face before, create a new one.\n\
3610 If optional argument FRAME is specified, make a frame-local face\n\
3611 for that frame. Otherwise operate on the global face definition.\n\
3612 Value is a vector of face attributes.")
3614 Lisp_Object face
, frame
;
3616 Lisp_Object global_lface
, lface
;
3620 CHECK_SYMBOL (face
, 0);
3621 global_lface
= lface_from_face_name (NULL
, face
, 0);
3625 CHECK_LIVE_FRAME (frame
, 1);
3627 lface
= lface_from_face_name (f
, face
, 0);
3630 f
= NULL
, lface
= Qnil
;
3632 /* Add a global definition if there is none. */
3633 if (NILP (global_lface
))
3635 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3637 AREF (global_lface
, 0) = Qface
;
3638 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3639 Vface_new_frame_defaults
);
3641 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3642 face id to Lisp face is given by the vector lface_id_to_name.
3643 The mapping from Lisp face to Lisp face id is given by the
3644 property `face' of the Lisp face name. */
3645 if (next_lface_id
== lface_id_to_name_size
)
3647 int new_size
= max (50, 2 * lface_id_to_name_size
);
3648 int sz
= new_size
* sizeof *lface_id_to_name
;
3649 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3650 lface_id_to_name_size
= new_size
;
3653 lface_id_to_name
[next_lface_id
] = face
;
3654 Fput (face
, Qface
, make_number (next_lface_id
));
3658 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3659 AREF (global_lface
, i
) = Qunspecified
;
3661 /* Add a frame-local definition. */
3666 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3668 AREF (lface
, 0) = Qface
;
3669 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3672 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3673 AREF (lface
, i
) = Qunspecified
;
3676 lface
= global_lface
;
3678 xassert (LFACEP (lface
));
3679 check_lface (lface
);
3684 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3685 Sinternal_lisp_face_p
, 1, 2, 0,
3686 "Return non-nil if FACE names a face.\n\
3687 If optional second parameter FRAME is non-nil, check for the\n\
3688 existence of a frame-local face with name FACE on that frame.\n\
3689 Otherwise check for the existence of a global face.")
3691 Lisp_Object face
, frame
;
3697 CHECK_LIVE_FRAME (frame
, 1);
3698 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3701 lface
= lface_from_face_name (NULL
, face
, 0);
3707 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3708 Sinternal_copy_lisp_face
, 4, 4, 0,
3709 "Copy face FROM to TO.\n\
3710 If FRAME it t, copy the global face definition of FROM to the\n\
3711 global face definition of TO. Otherwise, copy the frame-local\n\
3712 definition of FROM on FRAME to the frame-local definition of TO\n\
3713 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3716 (from
, to
, frame
, new_frame
)
3717 Lisp_Object from
, to
, frame
, new_frame
;
3719 Lisp_Object lface
, copy
;
3721 CHECK_SYMBOL (from
, 0);
3722 CHECK_SYMBOL (to
, 1);
3723 if (NILP (new_frame
))
3728 /* Copy global definition of FROM. We don't make copies of
3729 strings etc. because 20.2 didn't do it either. */
3730 lface
= lface_from_face_name (NULL
, from
, 1);
3731 copy
= Finternal_make_lisp_face (to
, Qnil
);
3735 /* Copy frame-local definition of FROM. */
3736 CHECK_LIVE_FRAME (frame
, 2);
3737 CHECK_LIVE_FRAME (new_frame
, 3);
3738 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3739 copy
= Finternal_make_lisp_face (to
, new_frame
);
3742 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3743 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3749 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3750 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3751 "Set attribute ATTR of FACE to VALUE.\n\
3752 FRAME being a frame means change the face on that frame.\n\
3753 FRAME nil means change change the face of the selected frame.\n\
3754 FRAME t means change the default for new frames.\n\
3755 FRAME 0 means change the face on all frames, and change the default\n\
3757 (face
, attr
, value
, frame
)
3758 Lisp_Object face
, attr
, value
, frame
;
3761 Lisp_Object old_value
= Qnil
;
3762 /* Set 1 if ATTR is QCfont. */
3763 int font_attr_p
= 0;
3764 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3765 int font_related_attr_p
= 0;
3767 CHECK_SYMBOL (face
, 0);
3768 CHECK_SYMBOL (attr
, 1);
3770 face
= resolve_face_name (face
);
3772 /* If FRAME is 0, change face on all frames, and change the
3773 default for new frames. */
3774 if (INTEGERP (frame
) && XINT (frame
) == 0)
3777 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3778 FOR_EACH_FRAME (tail
, frame
)
3779 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3783 /* Set lface to the Lisp attribute vector of FACE. */
3785 lface
= lface_from_face_name (NULL
, face
, 1);
3789 frame
= selected_frame
;
3791 CHECK_LIVE_FRAME (frame
, 3);
3792 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3794 /* If a frame-local face doesn't exist yet, create one. */
3796 lface
= Finternal_make_lisp_face (face
, frame
);
3799 if (EQ (attr
, QCfamily
))
3801 if (!UNSPECIFIEDP (value
))
3803 CHECK_STRING (value
, 3);
3804 if (XSTRING (value
)->size
== 0)
3805 signal_error ("Invalid face family", value
);
3807 old_value
= LFACE_FAMILY (lface
);
3808 LFACE_FAMILY (lface
) = value
;
3809 font_related_attr_p
= 1;
3811 else if (EQ (attr
, QCheight
))
3813 if (!UNSPECIFIEDP (value
))
3816 (EQ (face
, Qdefault
) ? value
:
3817 /* The default face must have an absolute size, otherwise, we do
3818 a test merge with a random height to see if VALUE's ok. */
3819 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3821 if (!INTEGERP(test
) || XINT(test
) <= 0)
3822 signal_error ("Invalid face height", value
);
3825 old_value
= LFACE_HEIGHT (lface
);
3826 LFACE_HEIGHT (lface
) = value
;
3827 font_related_attr_p
= 1;
3829 else if (EQ (attr
, QCweight
))
3831 if (!UNSPECIFIEDP (value
))
3833 CHECK_SYMBOL (value
, 3);
3834 if (face_numeric_weight (value
) < 0)
3835 signal_error ("Invalid face weight", value
);
3837 old_value
= LFACE_WEIGHT (lface
);
3838 LFACE_WEIGHT (lface
) = value
;
3839 font_related_attr_p
= 1;
3841 else if (EQ (attr
, QCslant
))
3843 if (!UNSPECIFIEDP (value
))
3845 CHECK_SYMBOL (value
, 3);
3846 if (face_numeric_slant (value
) < 0)
3847 signal_error ("Invalid face slant", value
);
3849 old_value
= LFACE_SLANT (lface
);
3850 LFACE_SLANT (lface
) = value
;
3851 font_related_attr_p
= 1;
3853 else if (EQ (attr
, QCunderline
))
3855 if (!UNSPECIFIEDP (value
))
3856 if ((SYMBOLP (value
)
3858 && !EQ (value
, Qnil
))
3859 /* Underline color. */
3861 && XSTRING (value
)->size
== 0))
3862 signal_error ("Invalid face underline", value
);
3864 old_value
= LFACE_UNDERLINE (lface
);
3865 LFACE_UNDERLINE (lface
) = value
;
3867 else if (EQ (attr
, QCoverline
))
3869 if (!UNSPECIFIEDP (value
))
3870 if ((SYMBOLP (value
)
3872 && !EQ (value
, Qnil
))
3873 /* Overline color. */
3875 && XSTRING (value
)->size
== 0))
3876 signal_error ("Invalid face overline", value
);
3878 old_value
= LFACE_OVERLINE (lface
);
3879 LFACE_OVERLINE (lface
) = value
;
3881 else if (EQ (attr
, QCstrike_through
))
3883 if (!UNSPECIFIEDP (value
))
3884 if ((SYMBOLP (value
)
3886 && !EQ (value
, Qnil
))
3887 /* Strike-through color. */
3889 && XSTRING (value
)->size
== 0))
3890 signal_error ("Invalid face strike-through", value
);
3892 old_value
= LFACE_STRIKE_THROUGH (lface
);
3893 LFACE_STRIKE_THROUGH (lface
) = value
;
3895 else if (EQ (attr
, QCbox
))
3899 /* Allow t meaning a simple box of width 1 in foreground color
3902 value
= make_number (1);
3904 if (UNSPECIFIEDP (value
))
3906 else if (NILP (value
))
3908 else if (INTEGERP (value
))
3909 valid_p
= XINT (value
) != 0;
3910 else if (STRINGP (value
))
3911 valid_p
= XSTRING (value
)->size
> 0;
3912 else if (CONSP (value
))
3928 if (EQ (k
, QCline_width
))
3930 if (!INTEGERP (v
) || XINT (v
) == 0)
3933 else if (EQ (k
, QCcolor
))
3935 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3938 else if (EQ (k
, QCstyle
))
3940 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3947 valid_p
= NILP (tem
);
3953 signal_error ("Invalid face box", value
);
3955 old_value
= LFACE_BOX (lface
);
3956 LFACE_BOX (lface
) = value
;
3958 else if (EQ (attr
, QCinverse_video
)
3959 || EQ (attr
, QCreverse_video
))
3961 if (!UNSPECIFIEDP (value
))
3963 CHECK_SYMBOL (value
, 3);
3964 if (!EQ (value
, Qt
) && !NILP (value
))
3965 signal_error ("Invalid inverse-video face attribute value", value
);
3967 old_value
= LFACE_INVERSE (lface
);
3968 LFACE_INVERSE (lface
) = value
;
3970 else if (EQ (attr
, QCforeground
))
3972 if (!UNSPECIFIEDP (value
))
3974 /* Don't check for valid color names here because it depends
3975 on the frame (display) whether the color will be valid
3976 when the face is realized. */
3977 CHECK_STRING (value
, 3);
3978 if (XSTRING (value
)->size
== 0)
3979 signal_error ("Empty foreground color value", value
);
3981 old_value
= LFACE_FOREGROUND (lface
);
3982 LFACE_FOREGROUND (lface
) = value
;
3984 else if (EQ (attr
, QCbackground
))
3986 if (!UNSPECIFIEDP (value
))
3988 /* Don't check for valid color names here because it depends
3989 on the frame (display) whether the color will be valid
3990 when the face is realized. */
3991 CHECK_STRING (value
, 3);
3992 if (XSTRING (value
)->size
== 0)
3993 signal_error ("Empty background color value", value
);
3995 old_value
= LFACE_BACKGROUND (lface
);
3996 LFACE_BACKGROUND (lface
) = value
;
3998 else if (EQ (attr
, QCstipple
))
4000 #ifdef HAVE_X_WINDOWS
4001 if (!UNSPECIFIEDP (value
)
4003 && NILP (Fbitmap_spec_p (value
)))
4004 signal_error ("Invalid stipple attribute", value
);
4005 old_value
= LFACE_STIPPLE (lface
);
4006 LFACE_STIPPLE (lface
) = value
;
4007 #endif /* HAVE_X_WINDOWS */
4009 else if (EQ (attr
, QCwidth
))
4011 if (!UNSPECIFIEDP (value
))
4013 CHECK_SYMBOL (value
, 3);
4014 if (face_numeric_swidth (value
) < 0)
4015 signal_error ("Invalid face width", value
);
4017 old_value
= LFACE_SWIDTH (lface
);
4018 LFACE_SWIDTH (lface
) = value
;
4019 font_related_attr_p
= 1;
4021 else if (EQ (attr
, QCfont
))
4023 #ifdef HAVE_WINDOW_SYSTEM
4024 /* Set font-related attributes of the Lisp face from an
4029 CHECK_STRING (value
, 3);
4031 f
= SELECTED_FRAME ();
4033 f
= check_x_frame (frame
);
4035 /* VALUE may be a fontset name or an alias of fontset. In such
4036 a case, use the base fontset name. */
4037 tmp
= Fquery_fontset (value
, Qnil
);
4041 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4042 signal_error ("Invalid font or fontset name", value
);
4045 #endif /* HAVE_WINDOW_SYSTEM */
4047 else if (EQ (attr
, QCinherit
))
4050 if (SYMBOLP (value
))
4053 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4054 if (!SYMBOLP (XCAR (tail
)))
4057 LFACE_INHERIT (lface
) = value
;
4059 signal_error ("Invalid face inheritance", value
);
4061 else if (EQ (attr
, QCbold
))
4063 old_value
= LFACE_WEIGHT (lface
);
4064 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4065 font_related_attr_p
= 1;
4067 else if (EQ (attr
, QCitalic
))
4069 old_value
= LFACE_SLANT (lface
);
4070 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4071 font_related_attr_p
= 1;
4074 signal_error ("Invalid face attribute name", attr
);
4076 if (font_related_attr_p
4077 && !UNSPECIFIEDP (value
))
4078 /* If a font-related attribute other than QCfont is specified, the
4079 original `font' attribute nor that of default face is useless
4080 to determine a new font. Thus, we set it to nil so that font
4081 selection mechanism doesn't use it. */
4082 LFACE_FONT (lface
) = Qnil
;
4084 /* Changing a named face means that all realized faces depending on
4085 that face are invalid. Since we cannot tell which realized faces
4086 depend on the face, make sure they are all removed. This is done
4087 by incrementing face_change_count. The next call to
4088 init_iterator will then free realized faces. */
4090 && (EQ (attr
, QCfont
)
4091 || NILP (Fequal (old_value
, value
))))
4093 ++face_change_count
;
4094 ++windows_or_buffers_changed
;
4097 if (!UNSPECIFIEDP (value
)
4098 && NILP (Fequal (old_value
, value
)))
4104 if (EQ (face
, Qdefault
))
4106 #ifdef HAVE_WINDOW_SYSTEM
4107 /* Changed font-related attributes of the `default' face are
4108 reflected in changed `font' frame parameters. */
4109 if ((font_related_attr_p
|| font_attr_p
)
4110 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4111 set_font_frame_param (frame
, lface
);
4113 #endif /* HAVE_WINDOW_SYSTEM */
4115 if (EQ (attr
, QCforeground
))
4116 param
= Qforeground_color
;
4117 else if (EQ (attr
, QCbackground
))
4118 param
= Qbackground_color
;
4120 #ifdef HAVE_WINDOW_SYSTEM
4122 else if (EQ (face
, Qscroll_bar
))
4124 /* Changing the colors of `scroll-bar' sets frame parameters
4125 `scroll-bar-foreground' and `scroll-bar-background'. */
4126 if (EQ (attr
, QCforeground
))
4127 param
= Qscroll_bar_foreground
;
4128 else if (EQ (attr
, QCbackground
))
4129 param
= Qscroll_bar_background
;
4131 #endif /* not WINDOWSNT */
4132 else if (EQ (face
, Qborder
))
4134 /* Changing background color of `border' sets frame parameter
4136 if (EQ (attr
, QCbackground
))
4137 param
= Qborder_color
;
4139 else if (EQ (face
, Qcursor
))
4141 /* Changing background color of `cursor' sets frame parameter
4143 if (EQ (attr
, QCbackground
))
4144 param
= Qcursor_color
;
4146 else if (EQ (face
, Qmouse
))
4148 /* Changing background color of `mouse' sets frame parameter
4150 if (EQ (attr
, QCbackground
))
4151 param
= Qmouse_color
;
4153 #endif /* HAVE_WINDOW_SYSTEM */
4154 else if (EQ (face
, Qmenu
))
4155 ++menu_face_change_count
;
4159 /* Update `default-frame-alist', which is used for new frames. */
4161 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4164 /* Update the current frame's parameters. */
4167 cons
= XCAR (Vparam_value_alist
);
4168 XCAR (cons
) = param
;
4169 XCDR (cons
) = value
;
4170 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4178 #ifdef HAVE_WINDOW_SYSTEM
4180 /* Set the `font' frame parameter of FRAME determined from `default'
4181 face attributes LFACE. If a face or fontset name is explicitely
4182 specfied in LFACE, use it as is. Otherwise, determine a font name
4183 from the other font-related atrributes of LFACE. In that case, if
4184 there's no matching font, signals an error. */
4187 set_font_frame_param (frame
, lface
)
4188 Lisp_Object frame
, lface
;
4190 struct frame
*f
= XFRAME (frame
);
4192 if (FRAME_WINDOW_P (f
))
4194 Lisp_Object font_name
;
4197 if (STRINGP (LFACE_FONT (lface
)))
4198 font_name
= LFACE_FONT (lface
);
4201 /* Choose a font name that reflects LFACE's attributes and has
4202 the registry and encoding pattern specified in the default
4203 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4204 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4206 error ("No font matches the specified attribute");
4207 font_name
= build_string (font
);
4211 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4216 /* Update the corresponding face when frame parameter PARAM on frame F
4217 has been assigned the value NEW_VALUE. */
4220 update_face_from_frame_parameter (f
, param
, new_value
)
4222 Lisp_Object param
, new_value
;
4226 /* If there are no faces yet, give up. This is the case when called
4227 from Fx_create_frame, and we do the necessary things later in
4228 face-set-after-frame-defaults. */
4229 if (NILP (f
->face_alist
))
4232 if (EQ (param
, Qforeground_color
))
4234 lface
= lface_from_face_name (f
, Qdefault
, 1);
4235 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4236 ? new_value
: Qunspecified
);
4237 realize_basic_faces (f
);
4239 else if (EQ (param
, Qbackground_color
))
4243 /* Changing the background color might change the background
4244 mode, so that we have to load new defface specs. Call
4245 frame-update-face-colors to do that. */
4246 XSETFRAME (frame
, f
);
4247 call1 (Qframe_update_face_colors
, frame
);
4249 lface
= lface_from_face_name (f
, Qdefault
, 1);
4250 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4251 ? new_value
: Qunspecified
);
4252 realize_basic_faces (f
);
4254 if (EQ (param
, Qborder_color
))
4256 lface
= lface_from_face_name (f
, Qborder
, 1);
4257 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4258 ? new_value
: Qunspecified
);
4260 else if (EQ (param
, Qcursor_color
))
4262 lface
= lface_from_face_name (f
, Qcursor
, 1);
4263 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4264 ? new_value
: Qunspecified
);
4266 else if (EQ (param
, Qmouse_color
))
4268 lface
= lface_from_face_name (f
, Qmouse
, 1);
4269 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4270 ? new_value
: Qunspecified
);
4275 /* Get the value of X resource RESOURCE, class CLASS for the display
4276 of frame FRAME. This is here because ordinary `x-get-resource'
4277 doesn't take a frame argument. */
4279 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4280 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4281 (resource
, class, frame
)
4282 Lisp_Object resource
, class, frame
;
4284 Lisp_Object value
= Qnil
;
4287 CHECK_STRING (resource
, 0);
4288 CHECK_STRING (class, 1);
4289 CHECK_LIVE_FRAME (frame
, 2);
4291 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4292 resource
, class, Qnil
, Qnil
);
4294 #endif /* not macintosh */
4295 #endif /* not WINDOWSNT */
4300 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4301 If VALUE is "on" or "true", return t. If VALUE is "off" or
4302 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4303 error; if SIGNAL_P is zero, return 0. */
4306 face_boolean_x_resource_value (value
, signal_p
)
4310 Lisp_Object result
= make_number (0);
4312 xassert (STRINGP (value
));
4314 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4315 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4317 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4318 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4320 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4321 result
= Qunspecified
;
4323 signal_error ("Invalid face attribute value from X resource", value
);
4329 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4330 Finternal_set_lisp_face_attribute_from_resource
,
4331 Sinternal_set_lisp_face_attribute_from_resource
,
4333 (face
, attr
, value
, frame
)
4334 Lisp_Object face
, attr
, value
, frame
;
4336 CHECK_SYMBOL (face
, 0);
4337 CHECK_SYMBOL (attr
, 1);
4338 CHECK_STRING (value
, 2);
4340 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4341 value
= Qunspecified
;
4342 else if (EQ (attr
, QCheight
))
4344 value
= Fstring_to_number (value
, make_number (10));
4345 if (XINT (value
) <= 0)
4346 signal_error ("Invalid face height from X resource", value
);
4348 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4349 value
= face_boolean_x_resource_value (value
, 1);
4350 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4351 value
= intern (XSTRING (value
)->data
);
4352 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4353 value
= face_boolean_x_resource_value (value
, 1);
4354 else if (EQ (attr
, QCunderline
)
4355 || EQ (attr
, QCoverline
)
4356 || EQ (attr
, QCstrike_through
)
4357 || EQ (attr
, QCbox
))
4359 Lisp_Object boolean_value
;
4361 /* If the result of face_boolean_x_resource_value is t or nil,
4362 VALUE does NOT specify a color. */
4363 boolean_value
= face_boolean_x_resource_value (value
, 0);
4364 if (SYMBOLP (boolean_value
))
4365 value
= boolean_value
;
4368 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4371 #endif /* HAVE_WINDOW_SYSTEM */
4374 /***********************************************************************
4376 ***********************************************************************/
4378 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4380 /* Make menus on frame F appear as specified by the `menu' face. */
4383 x_update_menu_appearance (f
)
4386 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4390 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4394 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4395 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4396 char *myname
= XSTRING (Vx_resource_name
)->data
;
4399 const char *popup_path
= "popup_menu";
4401 const char *popup_path
= "menu.popup";
4404 if (STRINGP (LFACE_FOREGROUND (lface
)))
4406 sprintf (line
, "%s.%s*foreground: %s",
4408 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4409 XrmPutLineResource (&rdb
, line
);
4410 sprintf (line
, "%s.pane.menubar*foreground: %s",
4411 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4412 XrmPutLineResource (&rdb
, line
);
4416 if (STRINGP (LFACE_BACKGROUND (lface
)))
4418 sprintf (line
, "%s.%s*background: %s",
4420 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4421 XrmPutLineResource (&rdb
, line
);
4422 sprintf (line
, "%s.pane.menubar*background: %s",
4423 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4424 XrmPutLineResource (&rdb
, line
);
4429 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4430 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4431 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4432 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4433 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4434 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4437 const char *suffix
= "List";
4439 const char *suffix
= "";
4441 sprintf (line
, "%s.pane.menubar*font%s: %s",
4442 myname
, suffix
, face
->font_name
);
4443 XrmPutLineResource (&rdb
, line
);
4444 sprintf (line
, "%s.%s*font%s: %s",
4445 myname
, popup_path
, suffix
, face
->font_name
);
4446 XrmPutLineResource (&rdb
, line
);
4450 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4452 free_frame_menubar (f
);
4453 set_frame_menubar (f
, 1, 1);
4458 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4462 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4463 Sinternal_get_lisp_face_attribute
,
4465 "Return face attribute KEYWORD of face SYMBOL.\n\
4466 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4467 face attribute name, signal an error.\n\
4468 If the optional argument FRAME is given, report on face FACE in that\n\
4469 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4470 frames). If FRAME is omitted or nil, use the selected frame.")
4471 (symbol
, keyword
, frame
)
4472 Lisp_Object symbol
, keyword
, frame
;
4474 Lisp_Object lface
, value
= Qnil
;
4476 CHECK_SYMBOL (symbol
, 0);
4477 CHECK_SYMBOL (keyword
, 1);
4480 lface
= lface_from_face_name (NULL
, symbol
, 1);
4484 frame
= selected_frame
;
4485 CHECK_LIVE_FRAME (frame
, 2);
4486 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4489 if (EQ (keyword
, QCfamily
))
4490 value
= LFACE_FAMILY (lface
);
4491 else if (EQ (keyword
, QCheight
))
4492 value
= LFACE_HEIGHT (lface
);
4493 else if (EQ (keyword
, QCweight
))
4494 value
= LFACE_WEIGHT (lface
);
4495 else if (EQ (keyword
, QCslant
))
4496 value
= LFACE_SLANT (lface
);
4497 else if (EQ (keyword
, QCunderline
))
4498 value
= LFACE_UNDERLINE (lface
);
4499 else if (EQ (keyword
, QCoverline
))
4500 value
= LFACE_OVERLINE (lface
);
4501 else if (EQ (keyword
, QCstrike_through
))
4502 value
= LFACE_STRIKE_THROUGH (lface
);
4503 else if (EQ (keyword
, QCbox
))
4504 value
= LFACE_BOX (lface
);
4505 else if (EQ (keyword
, QCinverse_video
)
4506 || EQ (keyword
, QCreverse_video
))
4507 value
= LFACE_INVERSE (lface
);
4508 else if (EQ (keyword
, QCforeground
))
4509 value
= LFACE_FOREGROUND (lface
);
4510 else if (EQ (keyword
, QCbackground
))
4511 value
= LFACE_BACKGROUND (lface
);
4512 else if (EQ (keyword
, QCstipple
))
4513 value
= LFACE_STIPPLE (lface
);
4514 else if (EQ (keyword
, QCwidth
))
4515 value
= LFACE_SWIDTH (lface
);
4516 else if (EQ (keyword
, QCinherit
))
4517 value
= LFACE_INHERIT (lface
);
4518 else if (EQ (keyword
, QCfont
))
4519 value
= LFACE_FONT (lface
);
4521 signal_error ("Invalid face attribute name", keyword
);
4527 DEFUN ("internal-lisp-face-attribute-values",
4528 Finternal_lisp_face_attribute_values
,
4529 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4530 "Return a list of valid discrete values for face attribute ATTR.\n\
4531 Value is nil if ATTR doesn't have a discrete set of valid values.")
4535 Lisp_Object result
= Qnil
;
4537 CHECK_SYMBOL (attr
, 0);
4539 if (EQ (attr
, QCweight
)
4540 || EQ (attr
, QCslant
)
4541 || EQ (attr
, QCwidth
))
4543 /* Extract permissible symbols from tables. */
4544 struct table_entry
*table
;
4547 if (EQ (attr
, QCweight
))
4548 table
= weight_table
, dim
= DIM (weight_table
);
4549 else if (EQ (attr
, QCslant
))
4550 table
= slant_table
, dim
= DIM (slant_table
);
4552 table
= swidth_table
, dim
= DIM (swidth_table
);
4554 for (i
= 0; i
< dim
; ++i
)
4556 Lisp_Object symbol
= *table
[i
].symbol
;
4557 Lisp_Object tail
= result
;
4560 && !EQ (XCAR (tail
), symbol
))
4564 result
= Fcons (symbol
, result
);
4567 else if (EQ (attr
, QCunderline
))
4568 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4569 else if (EQ (attr
, QCoverline
))
4570 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4571 else if (EQ (attr
, QCstrike_through
))
4572 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4573 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4574 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4580 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4581 Sinternal_merge_in_global_face
, 2, 2, 0,
4582 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4583 Default face attributes override any local face attributes.")
4585 Lisp_Object face
, frame
;
4588 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4590 CHECK_LIVE_FRAME (frame
, 1);
4591 global_lface
= lface_from_face_name (NULL
, face
, 1);
4592 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4593 if (NILP (local_lface
))
4594 local_lface
= Finternal_make_lisp_face (face
, frame
);
4596 /* Make every specified global attribute override the local one.
4597 BEWARE!! This is only used from `face-set-after-frame-default' where
4598 the local frame is defined from default specs in `face-defface-spec'
4599 and those should be overridden by global settings. Hence the strange
4600 "global before local" priority. */
4601 lvec
= XVECTOR (local_lface
)->contents
;
4602 gvec
= XVECTOR (global_lface
)->contents
;
4603 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4604 if (! UNSPECIFIEDP (gvec
[i
]))
4611 /* The following function is implemented for compatibility with 20.2.
4612 The function is used in x-resolve-fonts when it is asked to
4613 return fonts with the same size as the font of a face. This is
4614 done in fontset.el. */
4616 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4617 "Return the font name of face FACE, or nil if it is unspecified.\n\
4618 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4619 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4620 The font default for a face is either nil, or a list\n\
4621 of the form (bold), (italic) or (bold italic).\n\
4622 If FRAME is omitted or nil, use the selected frame.")
4624 Lisp_Object face
, frame
;
4628 Lisp_Object result
= Qnil
;
4629 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4631 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4632 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4633 result
= Fcons (Qbold
, result
);
4635 if (!NILP (LFACE_SLANT (lface
))
4636 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4637 result
= Fcons (Qitalic
, result
);
4643 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4644 int face_id
= lookup_named_face (f
, face
, 0);
4645 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4646 return face
? build_string (face
->font_name
) : Qnil
;
4651 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4652 all attributes are `equal'. Tries to be fast because this function
4653 is called quite often. */
4656 lface_equal_p (v1
, v2
)
4657 Lisp_Object
*v1
, *v2
;
4661 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4663 Lisp_Object a
= v1
[i
];
4664 Lisp_Object b
= v2
[i
];
4666 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4667 and the other is specified. */
4668 equal_p
= XTYPE (a
) == XTYPE (b
);
4677 equal_p
= ((STRING_BYTES (XSTRING (a
))
4678 == STRING_BYTES (XSTRING (b
)))
4679 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4680 STRING_BYTES (XSTRING (a
))) == 0);
4689 equal_p
= !NILP (Fequal (a
, b
));
4699 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4700 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4701 "True if FACE1 and FACE2 are equal.\n\
4702 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4703 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4704 If FRAME is omitted or nil, use the selected frame.")
4705 (face1
, face2
, frame
)
4706 Lisp_Object face1
, face2
, frame
;
4710 Lisp_Object lface1
, lface2
;
4715 /* Don't use check_x_frame here because this function is called
4716 before X frames exist. At that time, if FRAME is nil,
4717 selected_frame will be used which is the frame dumped with
4718 Emacs. That frame is not an X frame. */
4719 f
= frame_or_selected_frame (frame
, 2);
4721 lface1
= lface_from_face_name (NULL
, face1
, 1);
4722 lface2
= lface_from_face_name (NULL
, face2
, 1);
4723 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4724 XVECTOR (lface2
)->contents
);
4725 return equal_p
? Qt
: Qnil
;
4729 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4730 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4731 "True if FACE has no attribute specified.\n\
4732 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4733 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4734 If FRAME is omitted or nil, use the selected frame.")
4736 Lisp_Object face
, frame
;
4743 frame
= selected_frame
;
4744 CHECK_LIVE_FRAME (frame
, 0);
4748 lface
= lface_from_face_name (NULL
, face
, 1);
4750 lface
= lface_from_face_name (f
, face
, 1);
4752 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4753 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4756 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4760 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4762 "Return an alist of frame-local faces defined on FRAME.\n\
4763 For internal use only.")
4767 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4768 return f
->face_alist
;
4772 /* Return a hash code for Lisp string STRING with case ignored. Used
4773 below in computing a hash value for a Lisp face. */
4775 static INLINE
unsigned
4776 hash_string_case_insensitive (string
)
4781 xassert (STRINGP (string
));
4782 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4783 hash
= (hash
<< 1) ^ tolower (*s
);
4788 /* Return a hash code for face attribute vector V. */
4790 static INLINE
unsigned
4794 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4795 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4796 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4797 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4798 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4799 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4800 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4804 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4805 considering charsets/registries). They do if they specify the same
4806 family, point size, weight, width, slant, and fontset. Both LFACE1
4807 and LFACE2 must be fully-specified. */
4810 lface_same_font_attributes_p (lface1
, lface2
)
4811 Lisp_Object
*lface1
, *lface2
;
4813 xassert (lface_fully_specified_p (lface1
)
4814 && lface_fully_specified_p (lface2
));
4815 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4816 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4817 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4818 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4819 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4820 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4821 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4822 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4823 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4824 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4825 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4826 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4831 /***********************************************************************
4833 ***********************************************************************/
4835 /* Allocate and return a new realized face for Lisp face attribute
4838 static struct face
*
4839 make_realized_face (attr
)
4842 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4843 bzero (face
, sizeof *face
);
4844 face
->ascii_face
= face
;
4845 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4850 /* Free realized face FACE, including its X resources. FACE may
4854 free_realized_face (f
, face
)
4860 #ifdef HAVE_WINDOW_SYSTEM
4861 if (FRAME_WINDOW_P (f
))
4863 /* Free fontset of FACE if it is ASCII face. */
4864 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4865 free_face_fontset (f
, face
);
4868 x_free_gc (f
, face
->gc
);
4872 free_face_colors (f
, face
);
4873 x_destroy_bitmap (f
, face
->stipple
);
4875 #endif /* HAVE_WINDOW_SYSTEM */
4882 /* Prepare face FACE for subsequent display on frame F. This
4883 allocated GCs if they haven't been allocated yet or have been freed
4884 by clearing the face cache. */
4887 prepare_face_for_display (f
, face
)
4891 #ifdef HAVE_WINDOW_SYSTEM
4892 xassert (FRAME_WINDOW_P (f
));
4897 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4899 xgcv
.foreground
= face
->foreground
;
4900 xgcv
.background
= face
->background
;
4901 #ifdef HAVE_X_WINDOWS
4902 xgcv
.graphics_exposures
= False
;
4904 /* The font of FACE may be null if we couldn't load it. */
4907 #ifdef HAVE_X_WINDOWS
4908 xgcv
.font
= face
->font
->fid
;
4911 xgcv
.font
= face
->font
;
4914 xgcv
.font
= face
->font
;
4920 #ifdef HAVE_X_WINDOWS
4923 xgcv
.fill_style
= FillOpaqueStippled
;
4924 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4925 mask
|= GCFillStyle
| GCStipple
;
4928 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4931 #endif /* HAVE_WINDOW_SYSTEM */
4935 /***********************************************************************
4937 ***********************************************************************/
4939 /* Return a new face cache for frame F. */
4941 static struct face_cache
*
4945 struct face_cache
*c
;
4948 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4949 bzero (c
, sizeof *c
);
4950 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4951 c
->buckets
= (struct face
**) xmalloc (size
);
4952 bzero (c
->buckets
, size
);
4954 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4960 /* Clear out all graphics contexts for all realized faces, except for
4961 the basic faces. This should be done from time to time just to avoid
4962 keeping too many graphics contexts that are no longer needed. */
4966 struct face_cache
*c
;
4968 if (c
&& FRAME_WINDOW_P (c
->f
))
4970 #ifdef HAVE_WINDOW_SYSTEM
4972 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4974 struct face
*face
= c
->faces_by_id
[i
];
4975 if (face
&& face
->gc
)
4977 x_free_gc (c
->f
, face
->gc
);
4981 #endif /* HAVE_WINDOW_SYSTEM */
4986 /* Free all realized faces in face cache C, including basic faces. C
4987 may be null. If faces are freed, make sure the frame's current
4988 matrix is marked invalid, so that a display caused by an expose
4989 event doesn't try to use faces we destroyed. */
4992 free_realized_faces (c
)
4993 struct face_cache
*c
;
4998 struct frame
*f
= c
->f
;
5000 /* We must block input here because we can't process X events
5001 safely while only some faces are freed, or when the frame's
5002 current matrix still references freed faces. */
5005 for (i
= 0; i
< c
->used
; ++i
)
5007 free_realized_face (f
, c
->faces_by_id
[i
]);
5008 c
->faces_by_id
[i
] = NULL
;
5012 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5013 bzero (c
->buckets
, size
);
5015 /* Must do a thorough redisplay the next time. Mark current
5016 matrices as invalid because they will reference faces freed
5017 above. This function is also called when a frame is
5018 destroyed. In this case, the root window of F is nil. */
5019 if (WINDOWP (f
->root_window
))
5021 clear_current_matrices (f
);
5022 ++windows_or_buffers_changed
;
5030 /* Free all faces realized for multibyte characters on frame F that
5034 free_realized_multibyte_face (f
, fontset
)
5038 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5042 /* We must block input here because we can't process X events safely
5043 while only some faces are freed, or when the frame's current
5044 matrix still references freed faces. */
5047 for (i
= 0; i
< cache
->used
; i
++)
5049 face
= cache
->faces_by_id
[i
];
5051 && face
!= face
->ascii_face
5052 && face
->fontset
== fontset
)
5054 uncache_face (cache
, face
);
5055 free_realized_face (f
, face
);
5059 /* Must do a thorough redisplay the next time. Mark current
5060 matrices as invalid because they will reference faces freed
5061 above. This function is also called when a frame is destroyed.
5062 In this case, the root window of F is nil. */
5063 if (WINDOWP (f
->root_window
))
5065 clear_current_matrices (f
);
5066 ++windows_or_buffers_changed
;
5073 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5074 This is done after attributes of a named face have been changed,
5075 because we can't tell which realized faces depend on that face. */
5078 free_all_realized_faces (frame
)
5084 FOR_EACH_FRAME (rest
, frame
)
5085 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5088 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5092 /* Free face cache C and faces in it, including their X resources. */
5096 struct face_cache
*c
;
5100 free_realized_faces (c
);
5102 xfree (c
->faces_by_id
);
5108 /* Cache realized face FACE in face cache C. HASH is the hash value
5109 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5110 collision list of the face hash table of C. This is done because
5111 otherwise lookup_face would find FACE for every character, even if
5112 faces with the same attributes but for specific characters exist. */
5115 cache_face (c
, face
, hash
)
5116 struct face_cache
*c
;
5120 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5124 if (face
->fontset
>= 0)
5126 struct face
*last
= c
->buckets
[i
];
5137 c
->buckets
[i
] = face
;
5138 face
->prev
= face
->next
= NULL
;
5144 face
->next
= c
->buckets
[i
];
5146 face
->next
->prev
= face
;
5147 c
->buckets
[i
] = face
;
5150 /* Find a free slot in C->faces_by_id and use the index of the free
5151 slot as FACE->id. */
5152 for (i
= 0; i
< c
->used
; ++i
)
5153 if (c
->faces_by_id
[i
] == NULL
)
5157 /* Maybe enlarge C->faces_by_id. */
5158 if (i
== c
->used
&& c
->used
== c
->size
)
5160 int new_size
= 2 * c
->size
;
5161 int sz
= new_size
* sizeof *c
->faces_by_id
;
5162 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5167 /* Check that FACE got a unique id. */
5172 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5173 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5179 #endif /* GLYPH_DEBUG */
5181 c
->faces_by_id
[i
] = face
;
5187 /* Remove face FACE from cache C. */
5190 uncache_face (c
, face
)
5191 struct face_cache
*c
;
5194 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5197 face
->prev
->next
= face
->next
;
5199 c
->buckets
[i
] = face
->next
;
5202 face
->next
->prev
= face
->prev
;
5204 c
->faces_by_id
[face
->id
] = NULL
;
5205 if (face
->id
== c
->used
)
5210 /* Look up a realized face with face attributes ATTR in the face cache
5211 of frame F. The face will be used to display character C. Value
5212 is the ID of the face found. If no suitable face is found, realize
5213 a new one. In that case, if C is a multibyte character, BASE_FACE
5214 is a face that has the same attributes. */
5217 lookup_face (f
, attr
, c
, base_face
)
5221 struct face
*base_face
;
5223 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5228 xassert (cache
!= NULL
);
5229 check_lface_attrs (attr
);
5231 /* Look up ATTR in the face cache. */
5232 hash
= lface_hash (attr
);
5233 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5235 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5236 if (face
->hash
== hash
5237 && (!FRAME_WINDOW_P (f
)
5238 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5239 && lface_equal_p (face
->lface
, attr
))
5242 /* If not found, realize a new face. */
5244 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5247 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5249 /* When this function is called from face_for_char (in this case, C is
5250 a multibyte character), a fontset of a face returned by
5251 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5252 C) is not sutisfied. The fontset is set for this face by
5253 face_for_char later. */
5255 if (FRAME_WINDOW_P (f
))
5256 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5258 #endif /* GLYPH_DEBUG */
5264 /* Return the face id of the realized face for named face SYMBOL on
5265 frame F suitable for displaying character C. Value is -1 if the
5266 face couldn't be determined, which might happen if the default face
5267 isn't realized and cannot be realized. */
5270 lookup_named_face (f
, symbol
, c
)
5275 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5276 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5277 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5279 if (default_face
== NULL
)
5281 if (!realize_basic_faces (f
))
5283 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5286 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5287 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5288 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5289 return lookup_face (f
, attrs
, c
, NULL
);
5293 /* Return the ID of the realized ASCII face of Lisp face with ID
5294 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5297 ascii_face_of_lisp_face (f
, lface_id
)
5303 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5305 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5306 face_id
= lookup_named_face (f
, face_name
, 0);
5315 /* Return a face for charset ASCII that is like the face with id
5316 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5317 STEPS < 0 means larger. Value is the id of the face. */
5320 smaller_face (f
, face_id
, steps
)
5324 #ifdef HAVE_WINDOW_SYSTEM
5326 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5327 int pt
, last_pt
, last_height
;
5330 struct face
*new_face
;
5332 /* If not called for an X frame, just return the original face. */
5333 if (FRAME_TERMCAP_P (f
))
5336 /* Try in increments of 1/2 pt. */
5337 delta
= steps
< 0 ? 5 : -5;
5338 steps
= abs (steps
);
5340 face
= FACE_FROM_ID (f
, face_id
);
5341 bcopy (face
->lface
, attrs
, sizeof attrs
);
5342 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5343 new_face_id
= face_id
;
5344 last_height
= FONT_HEIGHT (face
->font
);
5348 /* Give up if we cannot find a font within 10pt. */
5349 && abs (last_pt
- pt
) < 100)
5351 /* Look up a face for a slightly smaller/larger font. */
5353 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5354 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5355 new_face
= FACE_FROM_ID (f
, new_face_id
);
5357 /* If height changes, count that as one step. */
5358 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5359 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5362 last_height
= FONT_HEIGHT (new_face
->font
);
5369 #else /* not HAVE_WINDOW_SYSTEM */
5373 #endif /* not HAVE_WINDOW_SYSTEM */
5377 /* Return a face for charset ASCII that is like the face with id
5378 FACE_ID on frame F, but has height HEIGHT. */
5381 face_with_height (f
, face_id
, height
)
5386 #ifdef HAVE_WINDOW_SYSTEM
5388 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5390 if (FRAME_TERMCAP_P (f
)
5394 face
= FACE_FROM_ID (f
, face_id
);
5395 bcopy (face
->lface
, attrs
, sizeof attrs
);
5396 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5397 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5398 #endif /* HAVE_WINDOW_SYSTEM */
5404 /* Return the face id of the realized face for named face SYMBOL on
5405 frame F suitable for displaying character C, and use attributes of
5406 the face FACE_ID for attributes that aren't completely specified by
5407 SYMBOL. This is like lookup_named_face, except that the default
5408 attributes come from FACE_ID, not from the default face. FACE_ID
5409 is assumed to be already realized. */
5412 lookup_derived_face (f
, symbol
, c
, face_id
)
5418 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5419 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5420 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5425 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5426 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5427 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5428 return lookup_face (f
, attrs
, c
, default_face
);
5433 /***********************************************************************
5435 ***********************************************************************/
5437 DEFUN ("internal-set-font-selection-order",
5438 Finternal_set_font_selection_order
,
5439 Sinternal_set_font_selection_order
, 1, 1, 0,
5440 "Set font selection order for face font selection to ORDER.\n\
5441 ORDER must be a list of length 4 containing the symbols `:width',\n\
5442 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5443 first in ORDER are matched first, e.g. if `:height' appears before\n\
5444 `:weight' in ORDER, font selection first tries to find a font with\n\
5445 a suitable height, and then tries to match the font weight.\n\
5452 int indices
[DIM (font_sort_order
)];
5454 CHECK_LIST (order
, 0);
5455 bzero (indices
, sizeof indices
);
5459 CONSP (list
) && i
< DIM (indices
);
5460 list
= XCDR (list
), ++i
)
5462 Lisp_Object attr
= XCAR (list
);
5465 if (EQ (attr
, QCwidth
))
5467 else if (EQ (attr
, QCheight
))
5468 xlfd
= XLFD_POINT_SIZE
;
5469 else if (EQ (attr
, QCweight
))
5471 else if (EQ (attr
, QCslant
))
5476 if (indices
[i
] != 0)
5481 if (!NILP (list
) || i
!= DIM (indices
))
5482 signal_error ("Invalid font sort order", order
);
5483 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5484 if (indices
[i
] == 0)
5485 signal_error ("Invalid font sort order", order
);
5487 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5489 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5490 free_all_realized_faces (Qnil
);
5497 DEFUN ("internal-set-alternative-font-family-alist",
5498 Finternal_set_alternative_font_family_alist
,
5499 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5500 "Define alternative font families to try in face font selection.\n\
5501 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5502 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5503 be found. Value is ALIST.")
5507 CHECK_LIST (alist
, 0);
5508 Vface_alternative_font_family_alist
= alist
;
5509 free_all_realized_faces (Qnil
);
5514 DEFUN ("internal-set-alternative-font-registry-alist",
5515 Finternal_set_alternative_font_registry_alist
,
5516 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5517 "Define alternative font registries to try in face font selection.\n\
5518 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5519 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5520 be found. Value is ALIST.")
5524 CHECK_LIST (alist
, 0);
5525 Vface_alternative_font_registry_alist
= alist
;
5526 free_all_realized_faces (Qnil
);
5531 #ifdef HAVE_WINDOW_SYSTEM
5533 /* Value is non-zero if FONT is the name of a scalable font. The
5534 X11R6 XLFD spec says that point size, pixel size, and average width
5535 are zero for scalable fonts. Intlfonts contain at least one
5536 scalable font ("*-muleindian-1") for which this isn't true, so we
5537 just test average width. */
5540 font_scalable_p (font
)
5541 struct font_name
*font
;
5543 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5544 return (*s
== '0' && *(s
+ 1) == '\0')
5546 /* Windows implementation of XLFD is slightly broken for backward
5547 compatibility with previous broken versions, so test for
5548 wildcards as well as 0. */
5555 /* Ignore the difference of font point size less than this value. */
5557 #define FONT_POINT_SIZE_QUANTUM 5
5559 /* Value is non-zero if FONT1 is a better match for font attributes
5560 VALUES than FONT2. VALUES is an array of face attribute values in
5561 font sort order. COMPARE_PT_P zero means don't compare point
5562 sizes. AVGWIDTH, if not zero, is a specified font average width
5566 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5568 struct font_name
*font1
, *font2
;
5569 int compare_pt_p
, avgwidth
;
5573 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5575 int xlfd_idx
= font_sort_order
[i
];
5577 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5579 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5580 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5582 if (xlfd_idx
== XLFD_POINT_SIZE
5583 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5585 if (delta1
> delta2
)
5587 else if (delta1
< delta2
)
5591 /* The difference may be equal because, e.g., the face
5592 specifies `italic' but we have only `regular' and
5593 `oblique'. Prefer `oblique' in this case. */
5594 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5595 && font1
->numeric
[xlfd_idx
] > values
[i
]
5596 && font2
->numeric
[xlfd_idx
] < values
[i
])
5604 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5605 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5606 if (delta1
> delta2
)
5608 else if (delta1
< delta2
)
5612 return font1
->registry_priority
< font2
->registry_priority
;
5616 /* Value is non-zero if FONT is an exact match for face attributes in
5617 SPECIFIED. SPECIFIED is an array of face attribute values in font
5618 sort order. AVGWIDTH, if non-zero, is an average width to compare
5622 exact_face_match_p (specified
, font
, avgwidth
)
5624 struct font_name
*font
;
5629 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5630 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5633 return (i
== DIM (font_sort_order
)
5635 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5639 /* Value is the name of a scaled font, generated from scalable font
5640 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5641 Value is allocated from heap. */
5644 build_scalable_font_name (f
, font
, specified_pt
)
5646 struct font_name
*font
;
5649 char point_size
[20], pixel_size
[20];
5651 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5654 /* If scalable font is for a specific resolution, compute
5655 the point size we must specify from the resolution of
5656 the display and the specified resolution of the font. */
5657 if (font
->numeric
[XLFD_RESY
] != 0)
5659 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5660 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5665 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5668 /* Set point size of the font. */
5669 sprintf (point_size
, "%d", (int) pt
);
5670 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5671 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5673 /* Set pixel size. */
5674 sprintf (pixel_size
, "%d", pixel_value
);
5675 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5676 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5678 /* If font doesn't specify its resolution, use the
5679 resolution of the display. */
5680 if (font
->numeric
[XLFD_RESY
] == 0)
5683 sprintf (buffer
, "%d", (int) resy
);
5684 font
->fields
[XLFD_RESY
] = buffer
;
5685 font
->numeric
[XLFD_RESY
] = resy
;
5688 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5691 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5692 sprintf (buffer
, "%d", resx
);
5693 font
->fields
[XLFD_RESX
] = buffer
;
5694 font
->numeric
[XLFD_RESX
] = resx
;
5697 return build_font_name (font
);
5701 /* Value is non-zero if we are allowed to use scalable font FONT. We
5702 can't run a Lisp function here since this function may be called
5703 with input blocked. */
5706 may_use_scalable_font_p (font
)
5709 if (EQ (Vscalable_fonts_allowed
, Qt
))
5711 else if (CONSP (Vscalable_fonts_allowed
))
5713 Lisp_Object tail
, regexp
;
5715 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5717 regexp
= XCAR (tail
);
5718 if (STRINGP (regexp
)
5719 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5729 /* Return the name of the best matching font for face attributes ATTRS
5730 in the array of font_name structures FONTS which contains NFONTS
5731 elements. WIDTH_RATIO is a factor with which to multiply average
5732 widths if ATTRS specifies such a width.
5734 Value is a font name which is allocated from the heap. FONTS is
5735 freed by this function. */
5738 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5741 struct font_name
*fonts
;
5746 struct font_name
*best
;
5749 int exact_p
, avgwidth
;
5754 /* Make specified font attributes available in `specified',
5755 indexed by sort order. */
5756 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5758 int xlfd_idx
= font_sort_order
[i
];
5760 if (xlfd_idx
== XLFD_SWIDTH
)
5761 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5762 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5763 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5764 else if (xlfd_idx
== XLFD_WEIGHT
)
5765 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5766 else if (xlfd_idx
== XLFD_SLANT
)
5767 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5772 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5774 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5778 /* Start with the first non-scalable font in the list. */
5779 for (i
= 0; i
< nfonts
; ++i
)
5780 if (!font_scalable_p (fonts
+ i
))
5783 /* Find the best match among the non-scalable fonts. */
5788 for (i
= 1; i
< nfonts
; ++i
)
5789 if (!font_scalable_p (fonts
+ i
)
5790 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5794 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5803 /* Unless we found an exact match among non-scalable fonts, see if
5804 we can find a better match among scalable fonts. */
5807 /* A scalable font is better if
5809 1. its weight, slant, swidth attributes are better, or.
5811 2. the best non-scalable font doesn't have the required
5812 point size, and the scalable fonts weight, slant, swidth
5815 int non_scalable_has_exact_height_p
;
5817 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5818 non_scalable_has_exact_height_p
= 1;
5820 non_scalable_has_exact_height_p
= 0;
5822 for (i
= 0; i
< nfonts
; ++i
)
5823 if (font_scalable_p (fonts
+ i
))
5826 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5827 || (!non_scalable_has_exact_height_p
5828 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5833 if (font_scalable_p (best
))
5834 font_name
= build_scalable_font_name (f
, best
, pt
);
5836 font_name
= build_font_name (best
);
5838 /* Free font_name structures. */
5839 free_font_names (fonts
, nfonts
);
5845 /* Get a list of matching fonts on frame F, considering alterntive
5846 font families from Vface_alternative_font_registry_alist.
5848 FAMILY is the font family whose alternatives are considered.
5850 REGISTRY, if a string, specifies a font registry and encoding to
5851 match. A value of nil means include fonts of any registry and
5854 Return in *FONTS a pointer to a vector of font_name structures for
5855 the fonts matched. Value is the number of fonts found. */
5858 try_alternative_families (f
, family
, registry
, fonts
)
5860 Lisp_Object family
, registry
;
5861 struct font_name
**fonts
;
5866 /* Try alternative font families. */
5867 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5870 for (alter
= XCDR (alter
);
5871 CONSP (alter
) && nfonts
== 0;
5872 alter
= XCDR (alter
))
5874 if (STRINGP (XCAR (alter
)))
5875 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5883 /* Get a list of matching fonts on frame F.
5885 FAMILY, if a string, specifies a font family. If nil, use
5886 the family specified in Lisp face attributes ATTRS instead.
5888 REGISTRY, if a string, specifies a font registry and encoding to
5889 match. A value of nil means include fonts of any registry and
5892 Return in *FONTS a pointer to a vector of font_name structures for
5893 the fonts matched. Value is the number of fonts found. */
5896 try_font_list (f
, attrs
, family
, registry
, fonts
)
5899 Lisp_Object family
, registry
;
5900 struct font_name
**fonts
;
5904 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5906 Lisp_Object face_family
;
5907 face_family
= attrs
[LFACE_FAMILY_INDEX
];
5908 nfonts
= font_list (f
, Qnil
, face_family
, registry
, fonts
);
5910 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
5915 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5916 if (nfonts
== 0 && !NILP (family
))
5918 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5920 /* Try font family of the default face or "fixed". */
5923 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5925 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
5927 family
= build_string ("fixed");
5928 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5931 /* Try any family with the given registry. */
5933 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5941 /* Return the fontset id of the base fontset name or alias name given
5942 by the fontset attribute of ATTRS. Value is -1 if the fontset
5943 attribute of ATTRS doesn't name a fontset. */
5946 face_fontset (attrs
)
5951 name
= attrs
[LFACE_FONT_INDEX
];
5952 if (!STRINGP (name
))
5954 return fs_query_fontset (name
, 0);
5958 /* Choose a name of font to use on frame F to display character C with
5959 Lisp face attributes specified by ATTRS. The font name is
5960 determined by the font-related attributes in ATTRS and the name
5961 pattern for C in FONTSET. Value is the font name which is
5962 allocated from the heap and must be freed by the caller, or NULL if
5963 we can get no information about the font name of C. It is assured
5964 that we always get some information for a single byte
5968 choose_face_font (f
, attrs
, fontset
, c
)
5973 Lisp_Object pattern
;
5974 char *font_name
= NULL
;
5975 struct font_name
*fonts
;
5976 int nfonts
, width_ratio
;
5978 /* Get (foundry and) family name and registry (and encoding) name of
5980 pattern
= fontset_font_pattern (f
, fontset
, c
);
5983 xassert (!SINGLE_BYTE_CHAR_P (c
));
5987 /* If what we got is a name pattern, return it. */
5988 if (STRINGP (pattern
))
5989 return xstrdup (XSTRING (pattern
)->data
);
5991 /* Get a list of fonts matching that pattern and choose the
5992 best match for the specified face attributes from it. */
5993 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
5994 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
5996 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
5997 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6001 #endif /* HAVE_WINDOW_SYSTEM */
6005 /***********************************************************************
6007 ***********************************************************************/
6009 /* Realize basic faces on frame F. Value is zero if frame parameters
6010 of F don't contain enough information needed to realize the default
6014 realize_basic_faces (f
)
6018 int count
= BINDING_STACK_SIZE ();
6020 /* Block input there so that we won't be surprised by an X expose
6021 event, for instance without having the faces set up. */
6023 specbind (Qscalable_fonts_allowed
, Qt
);
6025 if (realize_default_face (f
))
6027 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6028 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6029 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6030 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6031 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6032 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6033 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6034 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6035 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6037 /* Reflect changes in the `menu' face in menu bars. */
6038 if (menu_face_change_count
)
6040 --menu_face_change_count
;
6041 #ifdef USE_X_TOOLKIT
6042 x_update_menu_appearance (f
);
6049 unbind_to (count
, Qnil
);
6055 /* Realize the default face on frame F. If the face is not fully
6056 specified, make it fully-specified. Attributes of the default face
6057 that are not explicitly specified are taken from frame parameters. */
6060 realize_default_face (f
)
6063 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6065 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6066 Lisp_Object frame_font
;
6069 /* If the `default' face is not yet known, create it. */
6070 lface
= lface_from_face_name (f
, Qdefault
, 0);
6074 XSETFRAME (frame
, f
);
6075 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6078 #ifdef HAVE_WINDOW_SYSTEM
6079 if (FRAME_WINDOW_P (f
))
6081 /* Set frame_font to the value of the `font' frame parameter. */
6082 frame_font
= Fassq (Qfont
, f
->param_alist
);
6083 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6084 frame_font
= XCDR (frame_font
);
6085 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6087 #endif /* HAVE_WINDOW_SYSTEM */
6089 if (!FRAME_WINDOW_P (f
))
6091 LFACE_FAMILY (lface
) = build_string ("default");
6092 LFACE_SWIDTH (lface
) = Qnormal
;
6093 LFACE_HEIGHT (lface
) = make_number (1);
6094 LFACE_WEIGHT (lface
) = Qnormal
;
6095 LFACE_SLANT (lface
) = Qnormal
;
6096 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6099 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6100 LFACE_UNDERLINE (lface
) = Qnil
;
6102 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6103 LFACE_OVERLINE (lface
) = Qnil
;
6105 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6106 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6108 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6109 LFACE_BOX (lface
) = Qnil
;
6111 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6112 LFACE_INVERSE (lface
) = Qnil
;
6114 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6116 /* This function is called so early that colors are not yet
6117 set in the frame parameter list. */
6118 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6120 if (CONSP (color
) && STRINGP (XCDR (color
)))
6121 LFACE_FOREGROUND (lface
) = XCDR (color
);
6122 else if (FRAME_WINDOW_P (f
))
6124 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6125 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6130 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6132 /* This function is called so early that colors are not yet
6133 set in the frame parameter list. */
6134 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6135 if (CONSP (color
) && STRINGP (XCDR (color
)))
6136 LFACE_BACKGROUND (lface
) = XCDR (color
);
6137 else if (FRAME_WINDOW_P (f
))
6139 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6140 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6145 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6146 LFACE_STIPPLE (lface
) = Qnil
;
6148 /* Realize the face; it must be fully-specified now. */
6149 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6150 check_lface (lface
);
6151 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6152 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6157 /* Realize basic faces other than the default face in face cache C.
6158 SYMBOL is the face name, ID is the face id the realized face must
6159 have. The default face must have been realized already. */
6162 realize_named_face (f
, symbol
, id
)
6167 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6168 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6169 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6170 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6171 struct face
*new_face
;
6173 /* The default face must exist and be fully specified. */
6174 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6175 check_lface_attrs (attrs
);
6176 xassert (lface_fully_specified_p (attrs
));
6178 /* If SYMBOL isn't know as a face, create it. */
6182 XSETFRAME (frame
, f
);
6183 lface
= Finternal_make_lisp_face (symbol
, frame
);
6186 /* Merge SYMBOL's face with the default face. */
6187 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6188 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6190 /* Realize the face. */
6191 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6195 /* Realize the fully-specified face with attributes ATTRS in face
6196 cache CACHE for character C. If C is a multibyte character,
6197 BASE_FACE is a face that has the same attributes. Otherwise,
6198 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6199 ID of face to remove before caching the new face. Value is a
6200 pointer to the newly created realized face. */
6202 static struct face
*
6203 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6204 struct face_cache
*cache
;
6207 struct face
*base_face
;
6212 /* LFACE must be fully specified. */
6213 xassert (cache
!= NULL
);
6214 check_lface_attrs (attrs
);
6216 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6218 /* Remove the former face. */
6219 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6220 uncache_face (cache
, former_face
);
6221 free_realized_face (cache
->f
, former_face
);
6224 if (FRAME_WINDOW_P (cache
->f
))
6225 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6226 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6227 face
= realize_tty_face (cache
, attrs
, c
);
6231 /* Insert the new face. */
6232 cache_face (cache
, face
, lface_hash (attrs
));
6233 #ifdef HAVE_WINDOW_SYSTEM
6234 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6235 load_face_font (cache
->f
, face
, c
);
6236 #endif /* HAVE_WINDOW_SYSTEM */
6241 /* Realize the fully-specified face with attributes ATTRS in face
6242 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6243 a multibyte character, BASE_FACE is a face that has the same
6244 attributes. Otherwise, BASE_FACE is ignored. If the new face
6245 doesn't share font with the default face, a fontname is allocated
6246 from the heap and set in `font_name' of the new face, but it is not
6247 yet loaded here. Value is a pointer to the newly created realized
6250 static struct face
*
6251 realize_x_face (cache
, attrs
, c
, base_face
)
6252 struct face_cache
*cache
;
6255 struct face
*base_face
;
6257 #ifdef HAVE_WINDOW_SYSTEM
6258 struct face
*face
, *default_face
;
6260 Lisp_Object stipple
, overline
, strike_through
, box
;
6262 xassert (FRAME_WINDOW_P (cache
->f
));
6263 xassert (SINGLE_BYTE_CHAR_P (c
)
6266 /* Allocate a new realized face. */
6267 face
= make_realized_face (attrs
);
6271 /* If C is a multibyte character, we share all face attirbutes with
6272 BASE_FACE including the realized fontset. But, we must load a
6274 if (!SINGLE_BYTE_CHAR_P (c
))
6276 bcopy (base_face
, face
, sizeof *face
);
6279 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6280 face
->foreground_defaulted_p
= 1;
6281 face
->background_defaulted_p
= 1;
6282 face
->underline_defaulted_p
= 1;
6283 face
->overline_color_defaulted_p
= 1;
6284 face
->strike_through_color_defaulted_p
= 1;
6285 face
->box_color_defaulted_p
= 1;
6287 /* to force realize_face to load font */
6292 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6294 /* Determine the font to use. Most of the time, the font will be
6295 the same as the font of the default face, so try that first. */
6296 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6298 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6299 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6301 face
->font
= default_face
->font
;
6302 face
->fontset
= default_face
->fontset
;
6303 face
->font_info_id
= default_face
->font_info_id
;
6304 face
->font_name
= default_face
->font_name
;
6305 face
->ascii_face
= face
;
6307 /* But, as we can't share the fontset, make a new realized
6308 fontset that has the same base fontset as of the default
6311 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6315 /* If the face attribute ATTRS specifies a fontset, use it as
6316 the base of a new realized fontset. Otherwise, use the same
6317 base fontset as of the default face. The base determines
6318 registry and encoding of a font. It may also determine
6319 foundry and family. The other fields of font name pattern
6320 are constructed from ATTRS. */
6321 int fontset
= face_fontset (attrs
);
6323 if ((fontset
== -1) && default_face
)
6324 fontset
= default_face
->fontset
;
6325 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6326 face
->font
= NULL
; /* to force realize_face to load font */
6329 /* Load the font if it is specified in ATTRS. This fixes
6330 changing frame font on the Mac. */
6331 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6333 struct font_info
*font_info
=
6334 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6336 face
->font
= font_info
->font
;
6341 /* Load colors, and set remaining attributes. */
6343 load_face_colors (f
, face
, attrs
);
6346 box
= attrs
[LFACE_BOX_INDEX
];
6349 /* A simple box of line width 1 drawn in color given by
6351 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6353 face
->box
= FACE_SIMPLE_BOX
;
6354 face
->box_line_width
= 1;
6356 else if (INTEGERP (box
))
6358 /* Simple box of specified line width in foreground color of the
6360 xassert (XINT (box
) != 0);
6361 face
->box
= FACE_SIMPLE_BOX
;
6362 face
->box_line_width
= XINT (box
);
6363 face
->box_color
= face
->foreground
;
6364 face
->box_color_defaulted_p
= 1;
6366 else if (CONSP (box
))
6368 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6369 being one of `raised' or `sunken'. */
6370 face
->box
= FACE_SIMPLE_BOX
;
6371 face
->box_color
= face
->foreground
;
6372 face
->box_color_defaulted_p
= 1;
6373 face
->box_line_width
= 1;
6377 Lisp_Object keyword
, value
;
6379 keyword
= XCAR (box
);
6387 if (EQ (keyword
, QCline_width
))
6389 if (INTEGERP (value
) && XINT (value
) != 0)
6390 face
->box_line_width
= XINT (value
);
6392 else if (EQ (keyword
, QCcolor
))
6394 if (STRINGP (value
))
6396 face
->box_color
= load_color (f
, face
, value
,
6398 face
->use_box_color_for_shadows_p
= 1;
6401 else if (EQ (keyword
, QCstyle
))
6403 if (EQ (value
, Qreleased_button
))
6404 face
->box
= FACE_RAISED_BOX
;
6405 else if (EQ (value
, Qpressed_button
))
6406 face
->box
= FACE_SUNKEN_BOX
;
6411 /* Text underline, overline, strike-through. */
6413 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6415 /* Use default color (same as foreground color). */
6416 face
->underline_p
= 1;
6417 face
->underline_defaulted_p
= 1;
6418 face
->underline_color
= 0;
6420 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6422 /* Use specified color. */
6423 face
->underline_p
= 1;
6424 face
->underline_defaulted_p
= 0;
6425 face
->underline_color
6426 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6427 LFACE_UNDERLINE_INDEX
);
6429 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6431 face
->underline_p
= 0;
6432 face
->underline_defaulted_p
= 0;
6433 face
->underline_color
= 0;
6436 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6437 if (STRINGP (overline
))
6439 face
->overline_color
6440 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6441 LFACE_OVERLINE_INDEX
);
6442 face
->overline_p
= 1;
6444 else if (EQ (overline
, Qt
))
6446 face
->overline_color
= face
->foreground
;
6447 face
->overline_color_defaulted_p
= 1;
6448 face
->overline_p
= 1;
6451 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6452 if (STRINGP (strike_through
))
6454 face
->strike_through_color
6455 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6456 LFACE_STRIKE_THROUGH_INDEX
);
6457 face
->strike_through_p
= 1;
6459 else if (EQ (strike_through
, Qt
))
6461 face
->strike_through_color
= face
->foreground
;
6462 face
->strike_through_color_defaulted_p
= 1;
6463 face
->strike_through_p
= 1;
6466 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6467 if (!NILP (stipple
))
6468 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6470 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6472 #endif /* HAVE_WINDOW_SYSTEM */
6476 /* Map a specified color of face FACE on frame F to a tty color index.
6477 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6478 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6479 default foreground/background colors. */
6482 map_tty_color (f
, face
, idx
, defaulted
)
6485 enum lface_attribute_index idx
;
6488 Lisp_Object frame
, color
, def
;
6489 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6490 unsigned long default_pixel
, default_other_pixel
, pixel
;
6492 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6496 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6497 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6501 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6502 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6505 XSETFRAME (frame
, f
);
6506 color
= face
->lface
[idx
];
6509 && XSTRING (color
)->size
6510 && CONSP (Vtty_defined_color_alist
)
6511 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6514 /* Associations in tty-defined-color-alist are of the form
6515 (NAME INDEX R G B). We need the INDEX part. */
6516 pixel
= XINT (XCAR (XCDR (def
)));
6519 if (pixel
== default_pixel
&& STRINGP (color
))
6521 pixel
= load_color (f
, face
, color
, idx
);
6523 #if defined (MSDOS) || defined (WINDOWSNT)
6524 /* If the foreground of the default face is the default color,
6525 use the foreground color defined by the frame. */
6527 if (FRAME_MSDOS_P (f
))
6530 if (pixel
== default_pixel
6531 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6534 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6536 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6537 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6540 else if (pixel
== default_other_pixel
)
6543 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6545 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6546 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6552 #endif /* MSDOS or WINDOWSNT */
6556 face
->foreground
= pixel
;
6558 face
->background
= pixel
;
6562 /* Realize the fully-specified face with attributes ATTRS in face
6563 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6564 pointer to the newly created realized face. */
6566 static struct face
*
6567 realize_tty_face (cache
, attrs
, c
)
6568 struct face_cache
*cache
;
6574 int face_colors_defaulted
= 0;
6575 struct frame
*f
= cache
->f
;
6577 /* Frame must be a termcap frame. */
6578 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6580 /* Allocate a new realized face. */
6581 face
= make_realized_face (attrs
);
6582 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6584 /* Map face attributes to TTY appearances. We map slant to
6585 dimmed text because we want italic text to appear differently
6586 and because dimmed text is probably used infrequently. */
6587 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6588 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6590 if (weight
> XLFD_WEIGHT_MEDIUM
)
6591 face
->tty_bold_p
= 1;
6592 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6593 face
->tty_dim_p
= 1;
6594 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6595 face
->tty_underline_p
= 1;
6596 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6597 face
->tty_reverse_p
= 1;
6599 /* Map color names to color indices. */
6600 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6601 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6603 /* Swap colors if face is inverse-video. If the colors are taken
6604 from the frame colors, they are already inverted, since the
6605 frame-creation function calls x-handle-reverse-video. */
6606 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6608 unsigned long tem
= face
->foreground
;
6609 face
->foreground
= face
->background
;
6610 face
->background
= tem
;
6613 if (tty_suppress_bold_inverse_default_colors_p
6615 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6616 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6617 face
->tty_bold_p
= 0;
6623 DEFUN ("tty-suppress-bold-inverse-default-colors",
6624 Ftty_suppress_bold_inverse_default_colors
,
6625 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6626 "Suppress/allow boldness of faces with inverse default colors.\n\
6627 SUPPRESS non-nil means suppress it.\n\
6628 This affects bold faces on TTYs whose foreground is the default background\n\
6629 color of the display and whose background is the default foreground color.\n\
6630 For such faces, the bold face attribute is ignored if this variable\n\
6633 Lisp_Object suppress
;
6635 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6636 ++face_change_count
;
6642 /***********************************************************************
6644 ***********************************************************************/
6646 /* Return the ID of the face to use to display character CH with face
6647 property PROP on frame F in current_buffer. */
6650 compute_char_face (f
, ch
, prop
)
6657 if (NILP (current_buffer
->enable_multibyte_characters
))
6662 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6663 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6667 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6668 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6669 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6670 merge_face_vector_with_property (f
, attrs
, prop
);
6671 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6678 /* Return the face ID associated with buffer position POS for
6679 displaying ASCII characters. Return in *ENDPTR the position at
6680 which a different face is needed, as far as text properties and
6681 overlays are concerned. W is a window displaying current_buffer.
6683 REGION_BEG, REGION_END delimit the region, so it can be
6686 LIMIT is a position not to scan beyond. That is to limit the time
6687 this function can take.
6689 If MOUSE is non-zero, use the character's mouse-face, not its face.
6691 The face returned is suitable for displaying ASCII characters. */
6694 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6695 endptr
, limit
, mouse
)
6698 int region_beg
, region_end
;
6703 struct frame
*f
= XFRAME (w
->frame
);
6704 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6705 Lisp_Object prop
, position
;
6707 Lisp_Object
*overlay_vec
;
6710 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6711 Lisp_Object limit1
, end
;
6712 struct face
*default_face
;
6714 /* W must display the current buffer. We could write this function
6715 to use the frame and buffer of W, but right now it doesn't. */
6716 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6718 XSETFRAME (frame
, f
);
6719 XSETFASTINT (position
, pos
);
6722 if (pos
< region_beg
&& region_beg
< endpos
)
6723 endpos
= region_beg
;
6725 /* Get the `face' or `mouse_face' text property at POS, and
6726 determine the next position at which the property changes. */
6727 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6728 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6729 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6731 endpos
= XINT (end
);
6733 /* Look at properties from overlays. */
6738 /* First try with room for 40 overlays. */
6740 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6741 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6742 &next_overlay
, NULL
, 0);
6744 /* If there are more than 40, make enough space for all, and try
6746 if (noverlays
> len
)
6749 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6750 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6751 &next_overlay
, NULL
, 0);
6754 if (next_overlay
< endpos
)
6755 endpos
= next_overlay
;
6760 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6762 /* Optimize common cases where we can use the default face. */
6765 && !(pos
>= region_beg
&& pos
< region_end
))
6766 return DEFAULT_FACE_ID
;
6768 /* Begin with attributes from the default face. */
6769 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6771 /* Merge in attributes specified via text properties. */
6773 merge_face_vector_with_property (f
, attrs
, prop
);
6775 /* Now merge the overlay data. */
6776 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6777 for (i
= 0; i
< noverlays
; i
++)
6782 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6784 merge_face_vector_with_property (f
, attrs
, prop
);
6786 oend
= OVERLAY_END (overlay_vec
[i
]);
6787 oendpos
= OVERLAY_POSITION (oend
);
6788 if (oendpos
< endpos
)
6792 /* If in the region, merge in the region face. */
6793 if (pos
>= region_beg
&& pos
< region_end
)
6795 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6796 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6798 if (region_end
< endpos
)
6799 endpos
= region_end
;
6804 /* Look up a realized face with the given face attributes,
6805 or realize a new one for ASCII characters. */
6806 return lookup_face (f
, attrs
, 0, NULL
);
6810 /* Compute the face at character position POS in Lisp string STRING on
6811 window W, for ASCII characters.
6813 If STRING is an overlay string, it comes from position BUFPOS in
6814 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6815 not an overlay string. W must display the current buffer.
6816 REGION_BEG and REGION_END give the start and end positions of the
6817 region; both are -1 if no region is visible.
6819 BASE_FACE_ID is the id of a face to merge with. For strings coming
6820 from overlays or the `display' property it is the face at BUFPOS.
6822 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6824 Set *ENDPTR to the next position where to check for faces in
6825 STRING; -1 if the face is constant from POS to the end of the
6828 Value is the id of the face to use. The face returned is suitable
6829 for displaying ASCII characters. */
6832 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6833 region_end
, endptr
, base_face_id
, mouse_p
)
6837 int region_beg
, region_end
;
6839 enum face_id base_face_id
;
6842 Lisp_Object prop
, position
, end
, limit
;
6843 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6844 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6845 struct face
*base_face
;
6846 int multibyte_p
= STRING_MULTIBYTE (string
);
6847 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6849 /* Get the value of the face property at the current position within
6850 STRING. Value is nil if there is no face property. */
6851 XSETFASTINT (position
, pos
);
6852 prop
= Fget_text_property (position
, prop_name
, string
);
6854 /* Get the next position at which to check for faces. Value of end
6855 is nil if face is constant all the way to the end of the string.
6856 Otherwise it is a string position where to check faces next.
6857 Limit is the maximum position up to which to check for property
6858 changes in Fnext_single_property_change. Strings are usually
6859 short, so set the limit to the end of the string. */
6860 XSETFASTINT (limit
, XSTRING (string
)->size
);
6861 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6863 *endptr
= XFASTINT (end
);
6867 base_face
= FACE_FROM_ID (f
, base_face_id
);
6868 xassert (base_face
);
6870 /* Optimize the default case that there is no face property and we
6871 are not in the region. */
6873 && (base_face_id
!= DEFAULT_FACE_ID
6874 /* BUFPOS <= 0 means STRING is not an overlay string, so
6875 that the region doesn't have to be taken into account. */
6877 || bufpos
< region_beg
6878 || bufpos
>= region_end
)
6880 /* We can't realize faces for different charsets differently
6881 if we don't have fonts, so we can stop here if not working
6882 on a window-system frame. */
6883 || !FRAME_WINDOW_P (f
)
6884 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6885 return base_face
->id
;
6887 /* Begin with attributes from the base face. */
6888 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6890 /* Merge in attributes specified via text properties. */
6892 merge_face_vector_with_property (f
, attrs
, prop
);
6894 /* If in the region, merge in the region face. */
6896 && bufpos
>= region_beg
6897 && bufpos
< region_end
)
6899 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6900 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6903 /* Look up a realized face with the given face attributes,
6904 or realize a new one for ASCII characters. */
6905 return lookup_face (f
, attrs
, 0, NULL
);
6910 /***********************************************************************
6912 ***********************************************************************/
6916 /* Print the contents of the realized face FACE to stderr. */
6919 dump_realized_face (face
)
6922 fprintf (stderr
, "ID: %d\n", face
->id
);
6923 #ifdef HAVE_X_WINDOWS
6924 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6926 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6928 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6929 fprintf (stderr
, "background: 0x%lx (%s)\n",
6931 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6932 fprintf (stderr
, "font_name: %s (%s)\n",
6934 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6935 #ifdef HAVE_X_WINDOWS
6936 fprintf (stderr
, "font = %p\n", face
->font
);
6938 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6939 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6940 fprintf (stderr
, "underline: %d (%s)\n",
6942 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6943 fprintf (stderr
, "hash: %d\n", face
->hash
);
6944 fprintf (stderr
, "charset: %d\n", face
->charset
);
6948 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6956 fprintf (stderr
, "font selection order: ");
6957 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6958 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6959 fprintf (stderr
, "\n");
6961 fprintf (stderr
, "alternative fonts: ");
6962 debug_print (Vface_alternative_font_family_alist
);
6963 fprintf (stderr
, "\n");
6965 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6966 Fdump_face (make_number (i
));
6971 CHECK_NUMBER (n
, 0);
6972 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6974 error ("Not a valid face");
6975 dump_realized_face (face
);
6982 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6986 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6987 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6988 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6992 #endif /* GLYPH_DEBUG != 0 */
6996 /***********************************************************************
6998 ***********************************************************************/
7003 Qface
= intern ("face");
7005 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7006 staticpro (&Qbitmap_spec_p
);
7007 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7008 staticpro (&Qframe_update_face_colors
);
7010 /* Lisp face attribute keywords. */
7011 QCfamily
= intern (":family");
7012 staticpro (&QCfamily
);
7013 QCheight
= intern (":height");
7014 staticpro (&QCheight
);
7015 QCweight
= intern (":weight");
7016 staticpro (&QCweight
);
7017 QCslant
= intern (":slant");
7018 staticpro (&QCslant
);
7019 QCunderline
= intern (":underline");
7020 staticpro (&QCunderline
);
7021 QCinverse_video
= intern (":inverse-video");
7022 staticpro (&QCinverse_video
);
7023 QCreverse_video
= intern (":reverse-video");
7024 staticpro (&QCreverse_video
);
7025 QCforeground
= intern (":foreground");
7026 staticpro (&QCforeground
);
7027 QCbackground
= intern (":background");
7028 staticpro (&QCbackground
);
7029 QCstipple
= intern (":stipple");;
7030 staticpro (&QCstipple
);
7031 QCwidth
= intern (":width");
7032 staticpro (&QCwidth
);
7033 QCfont
= intern (":font");
7034 staticpro (&QCfont
);
7035 QCbold
= intern (":bold");
7036 staticpro (&QCbold
);
7037 QCitalic
= intern (":italic");
7038 staticpro (&QCitalic
);
7039 QCoverline
= intern (":overline");
7040 staticpro (&QCoverline
);
7041 QCstrike_through
= intern (":strike-through");
7042 staticpro (&QCstrike_through
);
7043 QCbox
= intern (":box");
7045 QCinherit
= intern (":inherit");
7046 staticpro (&QCinherit
);
7048 /* Symbols used for Lisp face attribute values. */
7049 QCcolor
= intern (":color");
7050 staticpro (&QCcolor
);
7051 QCline_width
= intern (":line-width");
7052 staticpro (&QCline_width
);
7053 QCstyle
= intern (":style");
7054 staticpro (&QCstyle
);
7055 Qreleased_button
= intern ("released-button");
7056 staticpro (&Qreleased_button
);
7057 Qpressed_button
= intern ("pressed-button");
7058 staticpro (&Qpressed_button
);
7059 Qnormal
= intern ("normal");
7060 staticpro (&Qnormal
);
7061 Qultra_light
= intern ("ultra-light");
7062 staticpro (&Qultra_light
);
7063 Qextra_light
= intern ("extra-light");
7064 staticpro (&Qextra_light
);
7065 Qlight
= intern ("light");
7066 staticpro (&Qlight
);
7067 Qsemi_light
= intern ("semi-light");
7068 staticpro (&Qsemi_light
);
7069 Qsemi_bold
= intern ("semi-bold");
7070 staticpro (&Qsemi_bold
);
7071 Qbold
= intern ("bold");
7073 Qextra_bold
= intern ("extra-bold");
7074 staticpro (&Qextra_bold
);
7075 Qultra_bold
= intern ("ultra-bold");
7076 staticpro (&Qultra_bold
);
7077 Qoblique
= intern ("oblique");
7078 staticpro (&Qoblique
);
7079 Qitalic
= intern ("italic");
7080 staticpro (&Qitalic
);
7081 Qreverse_oblique
= intern ("reverse-oblique");
7082 staticpro (&Qreverse_oblique
);
7083 Qreverse_italic
= intern ("reverse-italic");
7084 staticpro (&Qreverse_italic
);
7085 Qultra_condensed
= intern ("ultra-condensed");
7086 staticpro (&Qultra_condensed
);
7087 Qextra_condensed
= intern ("extra-condensed");
7088 staticpro (&Qextra_condensed
);
7089 Qcondensed
= intern ("condensed");
7090 staticpro (&Qcondensed
);
7091 Qsemi_condensed
= intern ("semi-condensed");
7092 staticpro (&Qsemi_condensed
);
7093 Qsemi_expanded
= intern ("semi-expanded");
7094 staticpro (&Qsemi_expanded
);
7095 Qexpanded
= intern ("expanded");
7096 staticpro (&Qexpanded
);
7097 Qextra_expanded
= intern ("extra-expanded");
7098 staticpro (&Qextra_expanded
);
7099 Qultra_expanded
= intern ("ultra-expanded");
7100 staticpro (&Qultra_expanded
);
7101 Qbackground_color
= intern ("background-color");
7102 staticpro (&Qbackground_color
);
7103 Qforeground_color
= intern ("foreground-color");
7104 staticpro (&Qforeground_color
);
7105 Qunspecified
= intern ("unspecified");
7106 staticpro (&Qunspecified
);
7108 Qface_alias
= intern ("face-alias");
7109 staticpro (&Qface_alias
);
7110 Qdefault
= intern ("default");
7111 staticpro (&Qdefault
);
7112 Qtool_bar
= intern ("tool-bar");
7113 staticpro (&Qtool_bar
);
7114 Qregion
= intern ("region");
7115 staticpro (&Qregion
);
7116 Qfringe
= intern ("fringe");
7117 staticpro (&Qfringe
);
7118 Qheader_line
= intern ("header-line");
7119 staticpro (&Qheader_line
);
7120 Qscroll_bar
= intern ("scroll-bar");
7121 staticpro (&Qscroll_bar
);
7122 Qmenu
= intern ("menu");
7124 Qcursor
= intern ("cursor");
7125 staticpro (&Qcursor
);
7126 Qborder
= intern ("border");
7127 staticpro (&Qborder
);
7128 Qmouse
= intern ("mouse");
7129 staticpro (&Qmouse
);
7130 Qtty_color_desc
= intern ("tty-color-desc");
7131 staticpro (&Qtty_color_desc
);
7132 Qtty_color_by_index
= intern ("tty-color-by-index");
7133 staticpro (&Qtty_color_by_index
);
7134 Qtty_color_alist
= intern ("tty-color-alist");
7135 staticpro (&Qtty_color_alist
);
7136 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7137 staticpro (&Qscalable_fonts_allowed
);
7139 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7140 staticpro (&Vparam_value_alist
);
7141 Vface_alternative_font_family_alist
= Qnil
;
7142 staticpro (&Vface_alternative_font_family_alist
);
7143 Vface_alternative_font_registry_alist
= Qnil
;
7144 staticpro (&Vface_alternative_font_registry_alist
);
7146 defsubr (&Sinternal_make_lisp_face
);
7147 defsubr (&Sinternal_lisp_face_p
);
7148 defsubr (&Sinternal_set_lisp_face_attribute
);
7149 #ifdef HAVE_WINDOW_SYSTEM
7150 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7152 defsubr (&Scolor_gray_p
);
7153 defsubr (&Scolor_supported_p
);
7154 defsubr (&Sinternal_get_lisp_face_attribute
);
7155 defsubr (&Sinternal_lisp_face_attribute_values
);
7156 defsubr (&Sinternal_lisp_face_equal_p
);
7157 defsubr (&Sinternal_lisp_face_empty_p
);
7158 defsubr (&Sinternal_copy_lisp_face
);
7159 defsubr (&Sinternal_merge_in_global_face
);
7160 defsubr (&Sface_font
);
7161 defsubr (&Sframe_face_alist
);
7162 defsubr (&Sinternal_set_font_selection_order
);
7163 defsubr (&Sinternal_set_alternative_font_family_alist
);
7164 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7166 defsubr (&Sdump_face
);
7167 defsubr (&Sshow_face_resources
);
7168 #endif /* GLYPH_DEBUG */
7169 defsubr (&Sclear_face_cache
);
7170 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7172 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7173 defsubr (&Sdump_colors
);
7176 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7177 "*Limit for font matching.\n\
7178 If an integer > 0, font matching functions won't load more than\n\
7179 that number of fonts when searching for a matching font.");
7180 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7182 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7183 "List of global face definitions (for internal use only.)");
7184 Vface_new_frame_defaults
= Qnil
;
7186 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7187 "*Default stipple pattern used on monochrome displays.\n\
7188 This stipple pattern is used on monochrome displays\n\
7189 instead of shades of gray for a face background color.\n\
7190 See `set-face-stipple' for possible values for this variable.");
7191 Vface_default_stipple
= build_string ("gray3");
7193 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7194 "An alist of defined terminal colors and their RGB values.");
7195 Vtty_defined_color_alist
= Qnil
;
7197 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7198 "Allowed scalable fonts.\n\
7199 A value of nil means don't allow any scalable fonts.\n\
7200 A value of t means allow any scalable font.\n\
7201 Otherwise, value must be a list of regular expressions. A font may be\n\
7202 scaled if its name matches a regular expression in the list.");
7203 Vscalable_fonts_allowed
= Qt
;
7205 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7206 "List of ignored fonts.\n\
7207 Each element is a regular expression that matches names of fonts to ignore.");
7208 Vface_ignored_fonts
= Qnil
;
7210 #ifdef HAVE_WINDOW_SYSTEM
7211 defsubr (&Sbitmap_spec_p
);
7212 defsubr (&Sx_list_fonts
);
7213 defsubr (&Sinternal_face_x_get_resource
);
7214 defsubr (&Sx_family_fonts
);
7215 defsubr (&Sx_font_family_list
);
7216 #endif /* HAVE_WINDOW_SYSTEM */