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
1637 x_free_colors (f
, &pixel
, 1);
1644 /* Free colors allocated for FACE. */
1647 free_face_colors (f
, face
)
1651 #ifdef HAVE_X_WINDOWS
1654 if (!face
->foreground_defaulted_p
)
1656 x_free_colors (f
, &face
->foreground
, 1);
1657 IF_DEBUG (--ncolors_allocated
);
1660 if (!face
->background_defaulted_p
)
1662 x_free_colors (f
, &face
->background
, 1);
1663 IF_DEBUG (--ncolors_allocated
);
1666 if (face
->underline_p
1667 && !face
->underline_defaulted_p
)
1669 x_free_colors (f
, &face
->underline_color
, 1);
1670 IF_DEBUG (--ncolors_allocated
);
1673 if (face
->overline_p
1674 && !face
->overline_color_defaulted_p
)
1676 x_free_colors (f
, &face
->overline_color
, 1);
1677 IF_DEBUG (--ncolors_allocated
);
1680 if (face
->strike_through_p
1681 && !face
->strike_through_color_defaulted_p
)
1683 x_free_colors (f
, &face
->strike_through_color
, 1);
1684 IF_DEBUG (--ncolors_allocated
);
1687 if (face
->box
!= FACE_NO_BOX
1688 && !face
->box_color_defaulted_p
)
1690 x_free_colors (f
, &face
->box_color
, 1);
1691 IF_DEBUG (--ncolors_allocated
);
1695 #endif /* HAVE_X_WINDOWS */
1698 #endif /* HAVE_WINDOW_SYSTEM */
1702 /***********************************************************************
1704 ***********************************************************************/
1706 /* An enumerator for each field of an XLFD font name. */
1727 /* An enumerator for each possible slant value of a font. Taken from
1728 the XLFD specification. */
1736 XLFD_SLANT_REVERSE_ITALIC
,
1737 XLFD_SLANT_REVERSE_OBLIQUE
,
1741 /* Relative font weight according to XLFD documentation. */
1745 XLFD_WEIGHT_UNKNOWN
,
1746 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1747 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1748 XLFD_WEIGHT_LIGHT
, /* 30 */
1749 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1750 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1751 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1752 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1753 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1754 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1757 /* Relative proportionate width. */
1761 XLFD_SWIDTH_UNKNOWN
,
1762 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1763 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1764 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1765 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1766 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1767 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1768 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1769 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1770 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1773 /* Structure used for tables mapping XLFD weight, slant, and width
1774 names to numeric and symbolic values. */
1780 Lisp_Object
*symbol
;
1783 /* Table of XLFD slant names and their numeric and symbolic
1784 representations. This table must be sorted by slant names in
1787 static struct table_entry slant_table
[] =
1789 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1790 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1791 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1792 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1793 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1794 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1797 /* Table of XLFD weight names. This table must be sorted by weight
1798 names in ascending order. */
1800 static struct table_entry weight_table
[] =
1802 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1803 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1804 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1805 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1806 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1807 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1808 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1809 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1810 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1811 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1812 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1813 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1814 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1815 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1816 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1817 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1820 /* Table of XLFD width names. This table must be sorted by width
1821 names in ascending order. */
1823 static struct table_entry swidth_table
[] =
1825 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1826 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1827 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1828 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1829 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1830 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1831 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1832 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1833 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1834 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1835 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1836 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1837 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1838 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1839 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1842 /* Structure used to hold the result of splitting font names in XLFD
1843 format into their fields. */
1847 /* The original name which is modified destructively by
1848 split_font_name. The pointer is kept here to be able to free it
1849 if it was allocated from the heap. */
1852 /* Font name fields. Each vector element points into `name' above.
1853 Fields are NUL-terminated. */
1854 char *fields
[XLFD_LAST
];
1856 /* Numeric values for those fields that interest us. See
1857 split_font_name for which these are. */
1858 int numeric
[XLFD_LAST
];
1860 /* Lower value mean higher priority. */
1861 int registry_priority
;
1864 /* The frame in effect when sorting font names. Set temporarily in
1865 sort_fonts so that it is available in font comparison functions. */
1867 static struct frame
*font_frame
;
1869 /* Order by which font selection chooses fonts. The default values
1870 mean `first, find a best match for the font width, then for the
1871 font height, then for weight, then for slant.' This variable can be
1872 set via set-face-font-sort-order. */
1875 static int font_sort_order
[4] = {
1876 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1879 static int font_sort_order
[4];
1882 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1883 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1884 is a pointer to the matching table entry or null if no table entry
1887 static struct table_entry
*
1888 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1889 struct table_entry
*table
;
1891 struct font_name
*font
;
1894 /* Function split_font_name converts fields to lower-case, so there
1895 is no need to use xstrlwr or xstricmp here. */
1896 char *s
= font
->fields
[field_index
];
1897 int low
, mid
, high
, cmp
;
1904 mid
= (low
+ high
) / 2;
1905 cmp
= strcmp (table
[mid
].name
, s
);
1919 /* Return a numeric representation for font name field
1920 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1921 has DIM entries. Value is the numeric value found or DFLT if no
1922 table entry matches. This function is used to translate weight,
1923 slant, and swidth names of XLFD font names to numeric values. */
1926 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1927 struct table_entry
*table
;
1929 struct font_name
*font
;
1933 struct table_entry
*p
;
1934 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1935 return p
? p
->numeric
: dflt
;
1939 /* Return a symbolic representation for font name field
1940 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1941 has DIM entries. Value is the symbolic value found or DFLT if no
1942 table entry matches. This function is used to translate weight,
1943 slant, and swidth names of XLFD font names to symbols. */
1945 static INLINE Lisp_Object
1946 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1947 struct table_entry
*table
;
1949 struct font_name
*font
;
1953 struct table_entry
*p
;
1954 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1955 return p
? *p
->symbol
: dflt
;
1959 /* Return a numeric value for the slant of the font given by FONT. */
1962 xlfd_numeric_slant (font
)
1963 struct font_name
*font
;
1965 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1966 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1970 /* Return a symbol representing the weight of the font given by FONT. */
1972 static INLINE Lisp_Object
1973 xlfd_symbolic_slant (font
)
1974 struct font_name
*font
;
1976 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1977 font
, XLFD_SLANT
, Qnormal
);
1981 /* Return a numeric value for the weight of the font given by FONT. */
1984 xlfd_numeric_weight (font
)
1985 struct font_name
*font
;
1987 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1988 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1992 /* Return a symbol representing the slant of the font given by FONT. */
1994 static INLINE Lisp_Object
1995 xlfd_symbolic_weight (font
)
1996 struct font_name
*font
;
1998 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1999 font
, XLFD_WEIGHT
, Qnormal
);
2003 /* Return a numeric value for the swidth of the font whose XLFD font
2004 name fields are found in FONT. */
2007 xlfd_numeric_swidth (font
)
2008 struct font_name
*font
;
2010 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2011 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2015 /* Return a symbolic value for the swidth of FONT. */
2017 static INLINE Lisp_Object
2018 xlfd_symbolic_swidth (font
)
2019 struct font_name
*font
;
2021 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2022 font
, XLFD_SWIDTH
, Qnormal
);
2026 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2027 entries. Value is a pointer to the matching table entry or null if
2028 no element of TABLE contains SYMBOL. */
2030 static struct table_entry
*
2031 face_value (table
, dim
, symbol
)
2032 struct table_entry
*table
;
2038 xassert (SYMBOLP (symbol
));
2040 for (i
= 0; i
< dim
; ++i
)
2041 if (EQ (*table
[i
].symbol
, symbol
))
2044 return i
< dim
? table
+ i
: NULL
;
2048 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2049 entries. Value is -1 if SYMBOL is not found in TABLE. */
2052 face_numeric_value (table
, dim
, symbol
)
2053 struct table_entry
*table
;
2057 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2058 return p
? p
->numeric
: -1;
2062 /* Return a numeric value representing the weight specified by Lisp
2063 symbol WEIGHT. Value is one of the enumerators of enum
2067 face_numeric_weight (weight
)
2070 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2074 /* Return a numeric value representing the slant specified by Lisp
2075 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2078 face_numeric_slant (slant
)
2081 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2085 /* Return a numeric value representing the swidth specified by Lisp
2086 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2089 face_numeric_swidth (width
)
2092 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2096 #ifdef HAVE_WINDOW_SYSTEM
2098 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2102 struct font_name
*font
;
2104 /* Function split_font_name converts fields to lower-case, so there
2105 is no need to use tolower here. */
2106 return *font
->fields
[XLFD_SPACING
] != 'p';
2110 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2112 The actual height of the font when displayed on F depends on the
2113 resolution of both the font and frame. For example, a 10pt font
2114 designed for a 100dpi display will display larger than 10pt on a
2115 75dpi display. (It's not unusual to use fonts not designed for the
2116 display one is using. For example, some intlfonts are available in
2117 72dpi versions, only.)
2119 Value is the real point size of FONT on frame F, or 0 if it cannot
2123 xlfd_point_size (f
, font
)
2125 struct font_name
*font
;
2127 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2128 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2132 if (*pixel_field
== '[')
2134 /* The pixel size field is `[A B C D]' which specifies
2135 a transformation matrix.
2141 by which all glyphs of the font are transformed. The spec
2142 says that s scalar value N for the pixel size is equivalent
2143 to A = N * resx/resy, B = C = 0, D = N. */
2144 char *start
= pixel_field
+ 1, *end
;
2148 for (i
= 0; i
< 4; ++i
)
2150 matrix
[i
] = strtod (start
, &end
);
2157 pixel
= atoi (pixel_field
);
2162 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2168 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2169 of frame F. This function is used to guess a point size of font
2170 when only the pixel height of the font is available. */
2173 pixel_point_size (f
, pixel
)
2177 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2181 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2182 point size of one dot. */
2183 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2184 int_pt
= real_pt
+ 0.5;
2190 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2191 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2192 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2193 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2194 zero if the font name doesn't have the format we expect. The
2195 expected format is a font name that starts with a `-' and has
2196 XLFD_LAST fields separated by `-'. */
2199 split_font_name (f
, font
, numeric_p
)
2201 struct font_name
*font
;
2207 if (*font
->name
== '-')
2209 char *p
= xstrlwr (font
->name
) + 1;
2211 while (i
< XLFD_LAST
)
2213 font
->fields
[i
] = p
;
2216 /* Pixel and point size may be of the form `[....]'. For
2217 BNF, see XLFD spec, chapter 4. Negative values are
2218 indicated by tilde characters which we replace with
2219 `-' characters, here. */
2221 && (i
- 1 == XLFD_PIXEL_SIZE
2222 || i
- 1 == XLFD_POINT_SIZE
))
2227 for (++p
; *p
&& *p
!= ']'; ++p
)
2231 /* Check that the matrix contains 4 floating point
2233 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2236 if (strtod (start
, &end
) == 0 && start
== end
)
2243 while (*p
&& *p
!= '-')
2253 success_p
= i
== XLFD_LAST
;
2255 /* If requested, and font name was in the expected format,
2256 compute numeric values for some fields. */
2257 if (numeric_p
&& success_p
)
2259 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2260 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2261 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2262 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2263 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2264 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2267 /* Initialize it to zero. It will be overridden by font_list while
2268 trying alternate registries. */
2269 font
->registry_priority
= 0;
2275 /* Build an XLFD font name from font name fields in FONT. Value is a
2276 pointer to the font name, which is allocated via xmalloc. */
2279 build_font_name (font
)
2280 struct font_name
*font
;
2284 char *font_name
= (char *) xmalloc (size
);
2285 int total_length
= 0;
2287 for (i
= 0; i
< XLFD_LAST
; ++i
)
2289 /* Add 1 because of the leading `-'. */
2290 int len
= strlen (font
->fields
[i
]) + 1;
2292 /* Reallocate font_name if necessary. Add 1 for the final
2294 if (total_length
+ len
+ 1 >= size
)
2296 int new_size
= max (2 * size
, size
+ len
+ 1);
2297 int sz
= new_size
* sizeof *font_name
;
2298 font_name
= (char *) xrealloc (font_name
, sz
);
2302 font_name
[total_length
] = '-';
2303 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2304 total_length
+= len
;
2307 font_name
[total_length
] = 0;
2312 /* Free an array FONTS of N font_name structures. This frees FONTS
2313 itself and all `name' fields in its elements. */
2316 free_font_names (fonts
, n
)
2317 struct font_name
*fonts
;
2321 xfree (fonts
[--n
].name
);
2326 /* Sort vector FONTS of font_name structures which contains NFONTS
2327 elements using qsort and comparison function CMPFN. F is the frame
2328 on which the fonts will be used. The global variable font_frame
2329 is temporarily set to F to make it available in CMPFN. */
2332 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2334 struct font_name
*fonts
;
2336 int (*cmpfn
) P_ ((const void *, const void *));
2339 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2344 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2345 display in x_display_list. FONTS is a pointer to a vector of
2346 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2347 alternative patterns from Valternate_fontname_alist if no fonts are
2348 found matching PATTERN.
2350 For all fonts found, set FONTS[i].name to the name of the font,
2351 allocated via xmalloc, and split font names into fields. Ignore
2352 fonts that we can't parse. Value is the number of fonts found. */
2355 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2358 struct font_name
*fonts
;
2359 int nfonts
, try_alternatives_p
;
2363 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2364 better to do it the other way around. */
2366 Lisp_Object lpattern
, tem
;
2368 lpattern
= build_string (pattern
);
2370 /* Get the list of fonts matching PATTERN. */
2373 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2376 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2379 /* Make a copy of the font names we got from X, and
2380 split them into fields. */
2382 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2384 Lisp_Object elt
, tail
;
2385 char *name
= XSTRING (XCAR (tem
))->data
;
2387 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2388 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2392 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2401 /* Make a copy of the font name. */
2402 fonts
[n
].name
= xstrdup (name
);
2404 if (split_font_name (f
, fonts
+ n
, 1))
2406 if (font_scalable_p (fonts
+ n
)
2407 && !may_use_scalable_font_p (name
))
2410 xfree (fonts
[n
].name
);
2416 xfree (fonts
[n
].name
);
2419 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2420 if (n
== 0 && try_alternatives_p
)
2422 Lisp_Object list
= Valternate_fontname_alist
;
2424 while (CONSP (list
))
2426 Lisp_Object entry
= XCAR (list
);
2428 && STRINGP (XCAR (entry
))
2429 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2436 Lisp_Object patterns
= XCAR (list
);
2439 while (CONSP (patterns
)
2440 /* If list is screwed up, give up. */
2441 && (name
= XCAR (patterns
),
2443 /* Ignore patterns equal to PATTERN because we tried that
2444 already with no success. */
2445 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2446 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2449 patterns
= XCDR (patterns
);
2457 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2458 using comparison function CMPFN. Value is the number of fonts
2459 found. If value is non-zero, *FONTS is set to a vector of
2460 font_name structures allocated from the heap containing matching
2461 fonts. Each element of *FONTS contains a name member that is also
2462 allocated from the heap. Font names in these structures are split
2463 into fields. Use free_font_names to free such an array. */
2466 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2469 int (*cmpfn
) P_ ((const void *, const void *));
2470 struct font_name
**fonts
;
2474 /* Get the list of fonts matching pattern. 100 should suffice. */
2475 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2476 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2477 nfonts
= XFASTINT (Vfont_list_limit
);
2479 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2480 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2482 /* Sort the resulting array and return it in *FONTS. If no
2483 fonts were found, make sure to set *FONTS to null. */
2485 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2496 /* Compare two font_name structures *A and *B. Value is analogous to
2497 strcmp. Sort order is given by the global variable
2498 font_sort_order. Font names are sorted so that, everything else
2499 being equal, fonts with a resolution closer to that of the frame on
2500 which they are used are listed first. The global variable
2501 font_frame is the frame on which we operate. */
2504 cmp_font_names (a
, b
)
2507 struct font_name
*x
= (struct font_name
*) a
;
2508 struct font_name
*y
= (struct font_name
*) b
;
2511 /* All strings have been converted to lower-case by split_font_name,
2512 so we can use strcmp here. */
2513 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2518 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2520 int j
= font_sort_order
[i
];
2521 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2526 /* Everything else being equal, we prefer fonts with an
2527 y-resolution closer to that of the frame. */
2528 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2529 int x_resy
= x
->numeric
[XLFD_RESY
];
2530 int y_resy
= y
->numeric
[XLFD_RESY
];
2531 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2539 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2540 is non-nil list fonts matching that pattern. Otherwise, if
2541 REGISTRY is non-nil return only fonts with that registry, otherwise
2542 return fonts of any registry. Set *FONTS to a vector of font_name
2543 structures allocated from the heap containing the fonts found.
2544 Value is the number of fonts found. */
2547 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2549 Lisp_Object pattern
, family
, registry
;
2550 struct font_name
**fonts
;
2552 char *pattern_str
, *family_str
, *registry_str
;
2556 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2557 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2559 pattern_str
= (char *) alloca (strlen (family_str
)
2560 + strlen (registry_str
)
2562 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2563 strcat (pattern_str
, family_str
);
2564 strcat (pattern_str
, "-*-");
2565 strcat (pattern_str
, registry_str
);
2566 if (!index (registry_str
, '-'))
2568 if (registry_str
[strlen (registry_str
) - 1] == '*')
2569 strcat (pattern_str
, "-*");
2571 strcat (pattern_str
, "*-*");
2575 pattern_str
= (char *) XSTRING (pattern
)->data
;
2577 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2581 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2582 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2583 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2586 static struct font_name
*
2587 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2588 struct font_name
*fonts1
, *fonts2
;
2589 int nfonts1
, nfonts2
;
2591 int new_nfonts
= nfonts1
+ nfonts2
;
2592 struct font_name
*new_fonts
;
2594 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2595 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2596 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2603 /* Get a sorted list of fonts of family FAMILY on frame F.
2605 If PATTERN is non-nil list fonts matching that pattern.
2607 If REGISTRY is non-nil, return fonts with that registry and the
2608 alternative registries from Vface_alternative_font_registry_alist.
2610 If REGISTRY is nil return fonts of any registry.
2612 Set *FONTS to a vector of font_name structures allocated from the
2613 heap containing the fonts found. Value is the number of fonts
2617 font_list (f
, pattern
, family
, registry
, fonts
)
2619 Lisp_Object pattern
, family
, registry
;
2620 struct font_name
**fonts
;
2622 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2624 if (!NILP (registry
)
2625 && CONSP (Vface_alternative_font_registry_alist
))
2629 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2634 for (alter
= XCDR (alter
), reg_prio
= 1;
2636 alter
= XCDR (alter
), reg_prio
++)
2637 if (STRINGP (XCAR (alter
)))
2640 struct font_name
*fonts2
;
2642 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2644 for (i
= 0; i
< nfonts2
; i
++)
2645 fonts2
[i
].registry_priority
= reg_prio
;
2646 *fonts
= (nfonts
> 0
2647 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2658 /* Remove elements from LIST whose cars are `equal'. Called from
2659 x-family-fonts and x-font-family-list to remove duplicate font
2663 remove_duplicates (list
)
2666 Lisp_Object tail
= list
;
2668 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2670 Lisp_Object next
= XCDR (tail
);
2671 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2672 XCDR (tail
) = XCDR (next
);
2679 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2680 "Return a list of available fonts of family FAMILY on FRAME.\n\
2681 If FAMILY is omitted or nil, list all families.\n\
2682 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2684 If FRAME is omitted or nil, use the selected frame.\n\
2685 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2686 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2687 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2688 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2689 width, weight and slant of the font. These symbols are the same as for\n\
2690 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2691 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2692 giving the registry and encoding of the font.\n\
2693 The result list is sorted according to the current setting of\n\
2694 the face font sort order.")
2696 Lisp_Object family
, frame
;
2698 struct frame
*f
= check_x_frame (frame
);
2699 struct font_name
*fonts
;
2702 struct gcpro gcpro1
;
2705 CHECK_STRING (family
, 1);
2709 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2710 for (i
= nfonts
- 1; i
>= 0; --i
)
2712 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2715 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2716 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2717 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2718 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2719 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2720 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2721 tem
= build_font_name (fonts
+ i
);
2722 ASET (v
, 6, build_string (tem
));
2723 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2724 fonts
[i
].fields
[XLFD_ENCODING
]);
2725 ASET (v
, 7, build_string (tem
));
2728 result
= Fcons (v
, result
);
2731 remove_duplicates (result
);
2732 free_font_names (fonts
, nfonts
);
2738 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2740 "Return a list of available font families on FRAME.\n\
2741 If FRAME is omitted or nil, use the selected frame.\n\
2742 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2743 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2748 struct frame
*f
= check_x_frame (frame
);
2750 struct font_name
*fonts
;
2752 struct gcpro gcpro1
;
2753 int count
= specpdl_ptr
- specpdl
;
2756 /* Let's consider all fonts. Increase the limit for matching
2757 fonts until we have them all. */
2760 specbind (intern ("font-list-limit"), make_number (limit
));
2761 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2763 if (nfonts
== limit
)
2765 free_font_names (fonts
, nfonts
);
2774 for (i
= nfonts
- 1; i
>= 0; --i
)
2775 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2776 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2779 remove_duplicates (result
);
2780 free_font_names (fonts
, nfonts
);
2782 return unbind_to (count
, result
);
2786 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2787 "Return a list of the names of available fonts matching PATTERN.\n\
2788 If optional arguments FACE and FRAME are specified, return only fonts\n\
2789 the same size as FACE on FRAME.\n\
2790 PATTERN is a string, perhaps with wildcard characters;\n\
2791 the * character matches any substring, and\n\
2792 the ? character matches any single character.\n\
2793 PATTERN is case-insensitive.\n\
2794 FACE is a face name--a symbol.\n\
2796 The return value is a list of strings, suitable as arguments to\n\
2799 Fonts Emacs can't use may or may not be excluded\n\
2800 even if they match PATTERN and FACE.\n\
2801 The optional fourth argument MAXIMUM sets a limit on how many\n\
2802 fonts to match. The first MAXIMUM fonts are reported.\n\
2803 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2804 occupied by a character of a font. In that case, return only fonts\n\
2805 the WIDTH times as wide as FACE on FRAME.")
2806 (pattern
, face
, frame
, maximum
, width
)
2807 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2814 CHECK_STRING (pattern
, 0);
2820 CHECK_NATNUM (maximum
, 0);
2821 maxnames
= XINT (maximum
);
2825 CHECK_NUMBER (width
, 4);
2827 /* We can't simply call check_x_frame because this function may be
2828 called before any frame is created. */
2829 f
= frame_or_selected_frame (frame
, 2);
2830 if (!FRAME_WINDOW_P (f
))
2832 /* Perhaps we have not yet created any frame. */
2837 /* Determine the width standard for comparison with the fonts we find. */
2843 /* This is of limited utility since it works with character
2844 widths. Keep it for compatibility. --gerd. */
2845 int face_id
= lookup_named_face (f
, face
, 0);
2846 struct face
*face
= (face_id
< 0
2848 : FACE_FROM_ID (f
, face_id
));
2850 if (face
&& face
->font
)
2851 size
= FONT_WIDTH (face
->font
);
2853 size
= FONT_WIDTH (FRAME_FONT (f
));
2856 size
*= XINT (width
);
2860 Lisp_Object args
[2];
2862 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2864 /* We don't have to check fontsets. */
2866 args
[1] = list_fontsets (f
, pattern
, size
);
2867 return Fnconc (2, args
);
2871 #endif /* HAVE_WINDOW_SYSTEM */
2875 /***********************************************************************
2877 ***********************************************************************/
2879 /* Access face attributes of face LFACE, a Lisp vector. */
2881 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2882 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2883 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2884 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2885 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2886 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2887 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2888 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2889 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2890 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2891 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2892 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2893 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2894 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2895 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2896 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2898 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2899 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2901 #define LFACEP(LFACE) \
2903 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2904 && EQ (AREF (LFACE, 0), Qface))
2909 /* Check consistency of Lisp face attribute vector ATTRS. */
2912 check_lface_attrs (attrs
)
2915 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2916 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2917 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2918 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2919 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2920 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2921 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2922 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2923 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2924 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2925 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2926 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2927 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2928 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2929 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2930 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2931 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2932 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2933 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2934 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2935 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2936 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2937 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2938 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2939 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2940 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2941 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2942 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2943 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2944 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2945 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2946 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2947 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2948 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2949 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2950 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2952 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2953 #ifdef HAVE_WINDOW_SYSTEM
2954 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2955 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2956 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2957 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2958 || NILP (attrs
[LFACE_FONT_INDEX
])
2959 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2964 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2972 xassert (LFACEP (lface
));
2973 check_lface_attrs (XVECTOR (lface
)->contents
);
2977 #else /* GLYPH_DEBUG == 0 */
2979 #define check_lface_attrs(attrs) (void) 0
2980 #define check_lface(lface) (void) 0
2982 #endif /* GLYPH_DEBUG == 0 */
2985 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2986 to make it a symvol. If FACE_NAME is an alias for another face,
2987 return that face's name. */
2990 resolve_face_name (face_name
)
2991 Lisp_Object face_name
;
2993 Lisp_Object aliased
;
2995 if (STRINGP (face_name
))
2996 face_name
= intern (XSTRING (face_name
)->data
);
2998 while (SYMBOLP (face_name
))
3000 aliased
= Fget (face_name
, Qface_alias
);
3004 face_name
= aliased
;
3011 /* Return the face definition of FACE_NAME on frame F. F null means
3012 return the definition for new frames. FACE_NAME may be a string or
3013 a symbol (apparently Emacs 20.2 allowed strings as face names in
3014 face text properties; Ediff uses that). If FACE_NAME is an alias
3015 for another face, return that face's definition. If SIGNAL_P is
3016 non-zero, signal an error if FACE_NAME is not a valid face name.
3017 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3020 static INLINE Lisp_Object
3021 lface_from_face_name (f
, face_name
, signal_p
)
3023 Lisp_Object face_name
;
3028 face_name
= resolve_face_name (face_name
);
3031 lface
= assq_no_quit (face_name
, f
->face_alist
);
3033 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3036 lface
= XCDR (lface
);
3038 signal_error ("Invalid face", face_name
);
3040 check_lface (lface
);
3045 /* Get face attributes of face FACE_NAME from frame-local faces on
3046 frame F. Store the resulting attributes in ATTRS which must point
3047 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3048 is non-zero, signal an error if FACE_NAME does not name a face.
3049 Otherwise, value is zero if FACE_NAME is not a face. */
3052 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3054 Lisp_Object face_name
;
3061 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3064 bcopy (XVECTOR (lface
)->contents
, attrs
,
3065 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3075 /* Non-zero if all attributes in face attribute vector ATTRS are
3076 specified, i.e. are non-nil. */
3079 lface_fully_specified_p (attrs
)
3084 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3085 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3086 && i
!= LFACE_AVGWIDTH_INDEX
)
3087 if (UNSPECIFIEDP (attrs
[i
]))
3090 return i
== LFACE_VECTOR_SIZE
;
3093 #ifdef HAVE_WINDOW_SYSTEM
3095 /* Set font-related attributes of Lisp face LFACE from the fullname of
3096 the font opened by FONTNAME. If FORCE_P is zero, set only
3097 unspecified attributes of LFACE. The exception is `font'
3098 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3100 If FONTNAME is not available on frame F,
3101 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3102 If the fullname is not in a valid XLFD format,
3103 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3104 in LFACE and return 1.
3105 Otherwise, return 1. */
3108 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3111 Lisp_Object fontname
;
3112 int force_p
, may_fail_p
;
3114 struct font_name font
;
3119 char *font_name
= XSTRING (fontname
)->data
;
3120 struct font_info
*font_info
;
3122 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3123 fontset
= fs_query_fontset (fontname
, 0);
3125 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3127 /* Check if FONT_NAME is surely available on the system. Usually
3128 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3129 returns quickly. But, even if FONT_NAME is not yet cached,
3130 caching it now is not futail because we anyway load the font
3133 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3143 font
.name
= STRDUPA (font_info
->full_name
);
3144 have_xlfd_p
= split_font_name (f
, &font
, 1);
3146 /* Set attributes only if unspecified, otherwise face defaults for
3147 new frames would never take effect. If we couldn't get a font
3148 name conforming to XLFD, set normal values. */
3150 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3155 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3156 + strlen (font
.fields
[XLFD_FOUNDRY
])
3158 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3159 font
.fields
[XLFD_FAMILY
]);
3160 val
= build_string (buffer
);
3163 val
= build_string ("*");
3164 LFACE_FAMILY (lface
) = val
;
3167 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3170 pt
= xlfd_point_size (f
, &font
);
3172 pt
= pixel_point_size (f
, font_info
->height
* 10);
3174 LFACE_HEIGHT (lface
) = make_number (pt
);
3177 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3178 LFACE_SWIDTH (lface
)
3179 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3181 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3182 LFACE_AVGWIDTH (lface
)
3184 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3187 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3188 LFACE_WEIGHT (lface
)
3189 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3191 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3193 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3195 LFACE_FONT (lface
) = fontname
;
3200 #endif /* HAVE_WINDOW_SYSTEM */
3203 /* Merges the face height FROM with the face height TO, and returns the
3204 merged height. If FROM is an invalid height, then INVALID is
3205 returned instead. FROM may be a either an absolute face height or a
3206 `relative' height, and TO must be an absolute height. The returned
3207 value is always an absolute height. GCPRO is a lisp value that will
3208 be protected from garbage-collection if this function makes a call
3212 merge_face_heights (from
, to
, invalid
, gcpro
)
3213 Lisp_Object from
, to
, invalid
, gcpro
;
3217 if (INTEGERP (from
))
3218 result
= XINT (from
);
3219 else if (NUMBERP (from
))
3220 result
= XFLOATINT (from
) * XINT (to
);
3221 #if 0 /* Probably not so useful. */
3222 else if (CONSP (from
) && CONSP (XCDR (from
)))
3224 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3226 if (INTEGERP (XCAR (XCDR (from
))))
3228 int inc
= XINT (XCAR (XCDR (from
)));
3229 if (EQ (XCAR (from
), Qminus
))
3232 result
= XFASTINT (to
);
3233 if (result
+ inc
> 0)
3234 /* Note that `underflows' don't mean FROM is invalid, so
3235 we just pin the result at TO if it would otherwise be
3242 else if (FUNCTIONP (from
))
3244 /* Call function with current height as argument.
3245 From is the new height. */
3246 Lisp_Object args
[2], height
;
3247 struct gcpro gcpro1
;
3253 height
= safe_call (2, args
);
3257 if (NUMBERP (height
))
3258 result
= XFLOATINT (height
);
3262 return make_number (result
);
3268 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3269 store the resulting attributes in TO, which must be already be
3270 completely specified and contain only absolute attributes. Every
3271 specified attribute of FROM overrides the corresponding attribute of
3272 TO; relative attributes in FROM are merged with the absolute value in
3273 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3274 face inheritance; it should be Qnil when called from other places. */
3277 merge_face_vectors (f
, from
, to
, cycle_check
)
3279 Lisp_Object
*from
, *to
;
3280 Lisp_Object cycle_check
;
3284 /* If FROM inherits from some other faces, merge their attributes into
3285 TO before merging FROM's direct attributes. Note that an :inherit
3286 attribute of `unspecified' is the same as one of nil; we never
3287 merge :inherit attributes, so nil is more correct, but lots of
3288 other code uses `unspecified' as a generic value for face attributes. */
3289 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3290 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3291 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3293 /* If TO specifies a :font attribute, and FROM specifies some
3294 font-related attribute, we need to clear TO's :font attribute
3295 (because it will be inconsistent with whatever FROM specifies, and
3296 FROM takes precedence). */
3297 if (!NILP (to
[LFACE_FONT_INDEX
])
3298 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3299 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3300 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3301 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3302 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3303 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3304 to
[LFACE_FONT_INDEX
] = Qnil
;
3306 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3307 if (!UNSPECIFIEDP (from
[i
]))
3308 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3309 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3313 /* TO is always an absolute face, which should inherit from nothing.
3314 We blindly copy the :inherit attribute above and fix it up here. */
3315 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3319 /* Checks the `cycle check' variable CHECK to see if it indicates that
3320 EL is part of a cycle; CHECK must be either Qnil or a value returned
3321 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3322 elements after which a cycle might be suspected; after that many
3323 elements, this macro begins consing in order to keep more precise
3326 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3329 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3330 the caller should make sure that's ok. */
3332 #define CYCLE_CHECK(check, el, suspicious) \
3335 : (INTEGERP (check) \
3336 ? (XFASTINT (check) < (suspicious) \
3337 ? make_number (XFASTINT (check) + 1) \
3338 : Fcons (el, Qnil)) \
3339 : (!NILP (Fmemq ((el), (check))) \
3341 : Fcons ((el), (check)))))
3344 /* Merge face attributes from the face on frame F whose name is
3345 INHERITS, into the vector of face attributes TO; INHERITS may also be
3346 a list of face names, in which case they are applied in order.
3347 CYCLE_CHECK is used to detect loops in face inheritance.
3348 Returns true if any of the inherited attributes are `font-related'. */
3351 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3353 Lisp_Object inherit
;
3355 Lisp_Object cycle_check
;
3357 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3358 /* Inherit from the named face INHERIT. */
3362 /* Make sure we're not in an inheritance loop. */
3363 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3364 if (NILP (cycle_check
))
3365 /* Cycle detected, ignore any further inheritance. */
3368 lface
= lface_from_face_name (f
, inherit
, 0);
3370 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3372 else if (CONSP (inherit
))
3373 /* Handle a list of inherited faces by calling ourselves recursively
3374 on each element. Note that we only do so for symbol elements, so
3375 it's not possible to infinitely recurse. */
3377 while (CONSP (inherit
))
3379 if (SYMBOLP (XCAR (inherit
)))
3380 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3382 /* Check for a circular inheritance list. */
3383 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3384 if (NILP (cycle_check
))
3385 /* Cycle detected. */
3388 inherit
= XCDR (inherit
);
3394 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3395 is a face property, determine the resulting face attributes on
3396 frame F, and store them in TO. PROP may be a single face
3397 specification or a list of such specifications. Each face
3398 specification can be
3400 1. A symbol or string naming a Lisp face.
3402 2. A property list of the form (KEYWORD VALUE ...) where each
3403 KEYWORD is a face attribute name, and value is an appropriate value
3406 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3407 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3408 for compatibility with 20.2.
3410 Face specifications earlier in lists take precedence over later
3414 merge_face_vector_with_property (f
, to
, prop
)
3421 Lisp_Object first
= XCAR (prop
);
3423 if (EQ (first
, Qforeground_color
)
3424 || EQ (first
, Qbackground_color
))
3426 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3427 . COLOR). COLOR must be a string. */
3428 Lisp_Object color_name
= XCDR (prop
);
3429 Lisp_Object color
= first
;
3431 if (STRINGP (color_name
))
3433 if (EQ (color
, Qforeground_color
))
3434 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3436 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3439 add_to_log ("Invalid face color", color_name
, Qnil
);
3441 else if (SYMBOLP (first
)
3442 && *XSYMBOL (first
)->name
->data
== ':')
3444 /* Assume this is the property list form. */
3445 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3447 Lisp_Object keyword
= XCAR (prop
);
3448 Lisp_Object value
= XCAR (XCDR (prop
));
3450 if (EQ (keyword
, QCfamily
))
3452 if (STRINGP (value
))
3453 to
[LFACE_FAMILY_INDEX
] = value
;
3455 add_to_log ("Invalid face font family", value
, Qnil
);
3457 else if (EQ (keyword
, QCheight
))
3459 Lisp_Object new_height
=
3460 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3463 if (NILP (new_height
))
3464 add_to_log ("Invalid face font height", value
, Qnil
);
3466 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3468 else if (EQ (keyword
, QCweight
))
3471 && face_numeric_weight (value
) >= 0)
3472 to
[LFACE_WEIGHT_INDEX
] = value
;
3474 add_to_log ("Invalid face weight", value
, Qnil
);
3476 else if (EQ (keyword
, QCslant
))
3479 && face_numeric_slant (value
) >= 0)
3480 to
[LFACE_SLANT_INDEX
] = value
;
3482 add_to_log ("Invalid face slant", value
, Qnil
);
3484 else if (EQ (keyword
, QCunderline
))
3489 to
[LFACE_UNDERLINE_INDEX
] = value
;
3491 add_to_log ("Invalid face underline", value
, Qnil
);
3493 else if (EQ (keyword
, QCoverline
))
3498 to
[LFACE_OVERLINE_INDEX
] = value
;
3500 add_to_log ("Invalid face overline", value
, Qnil
);
3502 else if (EQ (keyword
, QCstrike_through
))
3507 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3509 add_to_log ("Invalid face strike-through", value
, Qnil
);
3511 else if (EQ (keyword
, QCbox
))
3514 value
= make_number (1);
3515 if (INTEGERP (value
)
3519 to
[LFACE_BOX_INDEX
] = value
;
3521 add_to_log ("Invalid face box", value
, Qnil
);
3523 else if (EQ (keyword
, QCinverse_video
)
3524 || EQ (keyword
, QCreverse_video
))
3526 if (EQ (value
, Qt
) || NILP (value
))
3527 to
[LFACE_INVERSE_INDEX
] = value
;
3529 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3531 else if (EQ (keyword
, QCforeground
))
3533 if (STRINGP (value
))
3534 to
[LFACE_FOREGROUND_INDEX
] = value
;
3536 add_to_log ("Invalid face foreground", value
, Qnil
);
3538 else if (EQ (keyword
, QCbackground
))
3540 if (STRINGP (value
))
3541 to
[LFACE_BACKGROUND_INDEX
] = value
;
3543 add_to_log ("Invalid face background", value
, Qnil
);
3545 else if (EQ (keyword
, QCstipple
))
3547 #ifdef HAVE_X_WINDOWS
3548 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3549 if (!NILP (pixmap_p
))
3550 to
[LFACE_STIPPLE_INDEX
] = value
;
3552 add_to_log ("Invalid face stipple", value
, Qnil
);
3555 else if (EQ (keyword
, QCwidth
))
3558 && face_numeric_swidth (value
) >= 0)
3559 to
[LFACE_SWIDTH_INDEX
] = value
;
3561 add_to_log ("Invalid face width", value
, Qnil
);
3563 else if (EQ (keyword
, QCinherit
))
3565 if (SYMBOLP (value
))
3566 to
[LFACE_INHERIT_INDEX
] = value
;
3570 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3571 if (!SYMBOLP (XCAR (tail
)))
3574 to
[LFACE_INHERIT_INDEX
] = value
;
3576 add_to_log ("Invalid face inherit", value
, Qnil
);
3580 add_to_log ("Invalid attribute %s in face property",
3583 prop
= XCDR (XCDR (prop
));
3588 /* This is a list of face specs. Specifications at the
3589 beginning of the list take precedence over later
3590 specifications, so we have to merge starting with the
3591 last specification. */
3592 Lisp_Object next
= XCDR (prop
);
3594 merge_face_vector_with_property (f
, to
, next
);
3595 merge_face_vector_with_property (f
, to
, first
);
3600 /* PROP ought to be a face name. */
3601 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3603 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3605 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3610 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3611 Sinternal_make_lisp_face
, 1, 2, 0,
3612 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3613 If FACE was not known as a face before, create a new one.\n\
3614 If optional argument FRAME is specified, make a frame-local face\n\
3615 for that frame. Otherwise operate on the global face definition.\n\
3616 Value is a vector of face attributes.")
3618 Lisp_Object face
, frame
;
3620 Lisp_Object global_lface
, lface
;
3624 CHECK_SYMBOL (face
, 0);
3625 global_lface
= lface_from_face_name (NULL
, face
, 0);
3629 CHECK_LIVE_FRAME (frame
, 1);
3631 lface
= lface_from_face_name (f
, face
, 0);
3634 f
= NULL
, lface
= Qnil
;
3636 /* Add a global definition if there is none. */
3637 if (NILP (global_lface
))
3639 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3641 AREF (global_lface
, 0) = Qface
;
3642 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3643 Vface_new_frame_defaults
);
3645 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3646 face id to Lisp face is given by the vector lface_id_to_name.
3647 The mapping from Lisp face to Lisp face id is given by the
3648 property `face' of the Lisp face name. */
3649 if (next_lface_id
== lface_id_to_name_size
)
3651 int new_size
= max (50, 2 * lface_id_to_name_size
);
3652 int sz
= new_size
* sizeof *lface_id_to_name
;
3653 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3654 lface_id_to_name_size
= new_size
;
3657 lface_id_to_name
[next_lface_id
] = face
;
3658 Fput (face
, Qface
, make_number (next_lface_id
));
3662 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3663 AREF (global_lface
, i
) = Qunspecified
;
3665 /* Add a frame-local definition. */
3670 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3672 AREF (lface
, 0) = Qface
;
3673 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3676 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3677 AREF (lface
, i
) = Qunspecified
;
3680 lface
= global_lface
;
3682 xassert (LFACEP (lface
));
3683 check_lface (lface
);
3688 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3689 Sinternal_lisp_face_p
, 1, 2, 0,
3690 "Return non-nil if FACE names a face.\n\
3691 If optional second parameter FRAME is non-nil, check for the\n\
3692 existence of a frame-local face with name FACE on that frame.\n\
3693 Otherwise check for the existence of a global face.")
3695 Lisp_Object face
, frame
;
3701 CHECK_LIVE_FRAME (frame
, 1);
3702 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3705 lface
= lface_from_face_name (NULL
, face
, 0);
3711 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3712 Sinternal_copy_lisp_face
, 4, 4, 0,
3713 "Copy face FROM to TO.\n\
3714 If FRAME it t, copy the global face definition of FROM to the\n\
3715 global face definition of TO. Otherwise, copy the frame-local\n\
3716 definition of FROM on FRAME to the frame-local definition of TO\n\
3717 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3720 (from
, to
, frame
, new_frame
)
3721 Lisp_Object from
, to
, frame
, new_frame
;
3723 Lisp_Object lface
, copy
;
3725 CHECK_SYMBOL (from
, 0);
3726 CHECK_SYMBOL (to
, 1);
3727 if (NILP (new_frame
))
3732 /* Copy global definition of FROM. We don't make copies of
3733 strings etc. because 20.2 didn't do it either. */
3734 lface
= lface_from_face_name (NULL
, from
, 1);
3735 copy
= Finternal_make_lisp_face (to
, Qnil
);
3739 /* Copy frame-local definition of FROM. */
3740 CHECK_LIVE_FRAME (frame
, 2);
3741 CHECK_LIVE_FRAME (new_frame
, 3);
3742 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3743 copy
= Finternal_make_lisp_face (to
, new_frame
);
3746 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3747 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3753 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3754 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3755 "Set attribute ATTR of FACE to VALUE.\n\
3756 FRAME being a frame means change the face on that frame.\n\
3757 FRAME nil means change change the face of the selected frame.\n\
3758 FRAME t means change the default for new frames.\n\
3759 FRAME 0 means change the face on all frames, and change the default\n\
3761 (face
, attr
, value
, frame
)
3762 Lisp_Object face
, attr
, value
, frame
;
3765 Lisp_Object old_value
= Qnil
;
3766 /* Set 1 if ATTR is QCfont. */
3767 int font_attr_p
= 0;
3768 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3769 int font_related_attr_p
= 0;
3771 CHECK_SYMBOL (face
, 0);
3772 CHECK_SYMBOL (attr
, 1);
3774 face
= resolve_face_name (face
);
3776 /* If FRAME is 0, change face on all frames, and change the
3777 default for new frames. */
3778 if (INTEGERP (frame
) && XINT (frame
) == 0)
3781 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3782 FOR_EACH_FRAME (tail
, frame
)
3783 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3787 /* Set lface to the Lisp attribute vector of FACE. */
3789 lface
= lface_from_face_name (NULL
, face
, 1);
3793 frame
= selected_frame
;
3795 CHECK_LIVE_FRAME (frame
, 3);
3796 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3798 /* If a frame-local face doesn't exist yet, create one. */
3800 lface
= Finternal_make_lisp_face (face
, frame
);
3803 if (EQ (attr
, QCfamily
))
3805 if (!UNSPECIFIEDP (value
))
3807 CHECK_STRING (value
, 3);
3808 if (XSTRING (value
)->size
== 0)
3809 signal_error ("Invalid face family", value
);
3811 old_value
= LFACE_FAMILY (lface
);
3812 LFACE_FAMILY (lface
) = value
;
3813 font_related_attr_p
= 1;
3815 else if (EQ (attr
, QCheight
))
3817 if (!UNSPECIFIEDP (value
))
3820 (EQ (face
, Qdefault
) ? value
:
3821 /* The default face must have an absolute size, otherwise, we do
3822 a test merge with a random height to see if VALUE's ok. */
3823 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3825 if (!INTEGERP(test
) || XINT(test
) <= 0)
3826 signal_error ("Invalid face height", value
);
3829 old_value
= LFACE_HEIGHT (lface
);
3830 LFACE_HEIGHT (lface
) = value
;
3831 font_related_attr_p
= 1;
3833 else if (EQ (attr
, QCweight
))
3835 if (!UNSPECIFIEDP (value
))
3837 CHECK_SYMBOL (value
, 3);
3838 if (face_numeric_weight (value
) < 0)
3839 signal_error ("Invalid face weight", value
);
3841 old_value
= LFACE_WEIGHT (lface
);
3842 LFACE_WEIGHT (lface
) = value
;
3843 font_related_attr_p
= 1;
3845 else if (EQ (attr
, QCslant
))
3847 if (!UNSPECIFIEDP (value
))
3849 CHECK_SYMBOL (value
, 3);
3850 if (face_numeric_slant (value
) < 0)
3851 signal_error ("Invalid face slant", value
);
3853 old_value
= LFACE_SLANT (lface
);
3854 LFACE_SLANT (lface
) = value
;
3855 font_related_attr_p
= 1;
3857 else if (EQ (attr
, QCunderline
))
3859 if (!UNSPECIFIEDP (value
))
3860 if ((SYMBOLP (value
)
3862 && !EQ (value
, Qnil
))
3863 /* Underline color. */
3865 && XSTRING (value
)->size
== 0))
3866 signal_error ("Invalid face underline", value
);
3868 old_value
= LFACE_UNDERLINE (lface
);
3869 LFACE_UNDERLINE (lface
) = value
;
3871 else if (EQ (attr
, QCoverline
))
3873 if (!UNSPECIFIEDP (value
))
3874 if ((SYMBOLP (value
)
3876 && !EQ (value
, Qnil
))
3877 /* Overline color. */
3879 && XSTRING (value
)->size
== 0))
3880 signal_error ("Invalid face overline", value
);
3882 old_value
= LFACE_OVERLINE (lface
);
3883 LFACE_OVERLINE (lface
) = value
;
3885 else if (EQ (attr
, QCstrike_through
))
3887 if (!UNSPECIFIEDP (value
))
3888 if ((SYMBOLP (value
)
3890 && !EQ (value
, Qnil
))
3891 /* Strike-through color. */
3893 && XSTRING (value
)->size
== 0))
3894 signal_error ("Invalid face strike-through", value
);
3896 old_value
= LFACE_STRIKE_THROUGH (lface
);
3897 LFACE_STRIKE_THROUGH (lface
) = value
;
3899 else if (EQ (attr
, QCbox
))
3903 /* Allow t meaning a simple box of width 1 in foreground color
3906 value
= make_number (1);
3908 if (UNSPECIFIEDP (value
))
3910 else if (NILP (value
))
3912 else if (INTEGERP (value
))
3913 valid_p
= XINT (value
) != 0;
3914 else if (STRINGP (value
))
3915 valid_p
= XSTRING (value
)->size
> 0;
3916 else if (CONSP (value
))
3932 if (EQ (k
, QCline_width
))
3934 if (!INTEGERP (v
) || XINT (v
) == 0)
3937 else if (EQ (k
, QCcolor
))
3939 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3942 else if (EQ (k
, QCstyle
))
3944 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3951 valid_p
= NILP (tem
);
3957 signal_error ("Invalid face box", value
);
3959 old_value
= LFACE_BOX (lface
);
3960 LFACE_BOX (lface
) = value
;
3962 else if (EQ (attr
, QCinverse_video
)
3963 || EQ (attr
, QCreverse_video
))
3965 if (!UNSPECIFIEDP (value
))
3967 CHECK_SYMBOL (value
, 3);
3968 if (!EQ (value
, Qt
) && !NILP (value
))
3969 signal_error ("Invalid inverse-video face attribute value", value
);
3971 old_value
= LFACE_INVERSE (lface
);
3972 LFACE_INVERSE (lface
) = value
;
3974 else if (EQ (attr
, QCforeground
))
3976 if (!UNSPECIFIEDP (value
))
3978 /* Don't check for valid color names here because it depends
3979 on the frame (display) whether the color will be valid
3980 when the face is realized. */
3981 CHECK_STRING (value
, 3);
3982 if (XSTRING (value
)->size
== 0)
3983 signal_error ("Empty foreground color value", value
);
3985 old_value
= LFACE_FOREGROUND (lface
);
3986 LFACE_FOREGROUND (lface
) = value
;
3988 else if (EQ (attr
, QCbackground
))
3990 if (!UNSPECIFIEDP (value
))
3992 /* Don't check for valid color names here because it depends
3993 on the frame (display) whether the color will be valid
3994 when the face is realized. */
3995 CHECK_STRING (value
, 3);
3996 if (XSTRING (value
)->size
== 0)
3997 signal_error ("Empty background color value", value
);
3999 old_value
= LFACE_BACKGROUND (lface
);
4000 LFACE_BACKGROUND (lface
) = value
;
4002 else if (EQ (attr
, QCstipple
))
4004 #ifdef HAVE_X_WINDOWS
4005 if (!UNSPECIFIEDP (value
)
4007 && NILP (Fbitmap_spec_p (value
)))
4008 signal_error ("Invalid stipple attribute", value
);
4009 old_value
= LFACE_STIPPLE (lface
);
4010 LFACE_STIPPLE (lface
) = value
;
4011 #endif /* HAVE_X_WINDOWS */
4013 else if (EQ (attr
, QCwidth
))
4015 if (!UNSPECIFIEDP (value
))
4017 CHECK_SYMBOL (value
, 3);
4018 if (face_numeric_swidth (value
) < 0)
4019 signal_error ("Invalid face width", value
);
4021 old_value
= LFACE_SWIDTH (lface
);
4022 LFACE_SWIDTH (lface
) = value
;
4023 font_related_attr_p
= 1;
4025 else if (EQ (attr
, QCfont
))
4027 #ifdef HAVE_WINDOW_SYSTEM
4028 /* Set font-related attributes of the Lisp face from an
4033 CHECK_STRING (value
, 3);
4035 f
= SELECTED_FRAME ();
4037 f
= check_x_frame (frame
);
4039 /* VALUE may be a fontset name or an alias of fontset. In such
4040 a case, use the base fontset name. */
4041 tmp
= Fquery_fontset (value
, Qnil
);
4045 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4046 signal_error ("Invalid font or fontset name", value
);
4049 #endif /* HAVE_WINDOW_SYSTEM */
4051 else if (EQ (attr
, QCinherit
))
4054 if (SYMBOLP (value
))
4057 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4058 if (!SYMBOLP (XCAR (tail
)))
4061 LFACE_INHERIT (lface
) = value
;
4063 signal_error ("Invalid face inheritance", value
);
4065 else if (EQ (attr
, QCbold
))
4067 old_value
= LFACE_WEIGHT (lface
);
4068 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4069 font_related_attr_p
= 1;
4071 else if (EQ (attr
, QCitalic
))
4073 old_value
= LFACE_SLANT (lface
);
4074 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4075 font_related_attr_p
= 1;
4078 signal_error ("Invalid face attribute name", attr
);
4080 if (font_related_attr_p
4081 && !UNSPECIFIEDP (value
))
4082 /* If a font-related attribute other than QCfont is specified, the
4083 original `font' attribute nor that of default face is useless
4084 to determine a new font. Thus, we set it to nil so that font
4085 selection mechanism doesn't use it. */
4086 LFACE_FONT (lface
) = Qnil
;
4088 /* Changing a named face means that all realized faces depending on
4089 that face are invalid. Since we cannot tell which realized faces
4090 depend on the face, make sure they are all removed. This is done
4091 by incrementing face_change_count. The next call to
4092 init_iterator will then free realized faces. */
4094 && (EQ (attr
, QCfont
)
4095 || NILP (Fequal (old_value
, value
))))
4097 ++face_change_count
;
4098 ++windows_or_buffers_changed
;
4101 if (!UNSPECIFIEDP (value
)
4102 && NILP (Fequal (old_value
, value
)))
4108 if (EQ (face
, Qdefault
))
4110 #ifdef HAVE_WINDOW_SYSTEM
4111 /* Changed font-related attributes of the `default' face are
4112 reflected in changed `font' frame parameters. */
4113 if ((font_related_attr_p
|| font_attr_p
)
4114 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4115 set_font_frame_param (frame
, lface
);
4117 #endif /* HAVE_WINDOW_SYSTEM */
4119 if (EQ (attr
, QCforeground
))
4120 param
= Qforeground_color
;
4121 else if (EQ (attr
, QCbackground
))
4122 param
= Qbackground_color
;
4124 #ifdef HAVE_WINDOW_SYSTEM
4126 else if (EQ (face
, Qscroll_bar
))
4128 /* Changing the colors of `scroll-bar' sets frame parameters
4129 `scroll-bar-foreground' and `scroll-bar-background'. */
4130 if (EQ (attr
, QCforeground
))
4131 param
= Qscroll_bar_foreground
;
4132 else if (EQ (attr
, QCbackground
))
4133 param
= Qscroll_bar_background
;
4135 #endif /* not WINDOWSNT */
4136 else if (EQ (face
, Qborder
))
4138 /* Changing background color of `border' sets frame parameter
4140 if (EQ (attr
, QCbackground
))
4141 param
= Qborder_color
;
4143 else if (EQ (face
, Qcursor
))
4145 /* Changing background color of `cursor' sets frame parameter
4147 if (EQ (attr
, QCbackground
))
4148 param
= Qcursor_color
;
4150 else if (EQ (face
, Qmouse
))
4152 /* Changing background color of `mouse' sets frame parameter
4154 if (EQ (attr
, QCbackground
))
4155 param
= Qmouse_color
;
4157 #endif /* HAVE_WINDOW_SYSTEM */
4158 else if (EQ (face
, Qmenu
))
4159 ++menu_face_change_count
;
4163 /* Update `default-frame-alist', which is used for new frames. */
4165 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4168 /* Update the current frame's parameters. */
4171 cons
= XCAR (Vparam_value_alist
);
4172 XCAR (cons
) = param
;
4173 XCDR (cons
) = value
;
4174 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4182 #ifdef HAVE_WINDOW_SYSTEM
4184 /* Set the `font' frame parameter of FRAME determined from `default'
4185 face attributes LFACE. If a face or fontset name is explicitely
4186 specfied in LFACE, use it as is. Otherwise, determine a font name
4187 from the other font-related atrributes of LFACE. In that case, if
4188 there's no matching font, signals an error. */
4191 set_font_frame_param (frame
, lface
)
4192 Lisp_Object frame
, lface
;
4194 struct frame
*f
= XFRAME (frame
);
4196 if (FRAME_WINDOW_P (f
))
4198 Lisp_Object font_name
;
4201 if (STRINGP (LFACE_FONT (lface
)))
4202 font_name
= LFACE_FONT (lface
);
4205 /* Choose a font name that reflects LFACE's attributes and has
4206 the registry and encoding pattern specified in the default
4207 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4208 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4210 error ("No font matches the specified attribute");
4211 font_name
= build_string (font
);
4215 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4220 /* Update the corresponding face when frame parameter PARAM on frame F
4221 has been assigned the value NEW_VALUE. */
4224 update_face_from_frame_parameter (f
, param
, new_value
)
4226 Lisp_Object param
, new_value
;
4230 /* If there are no faces yet, give up. This is the case when called
4231 from Fx_create_frame, and we do the necessary things later in
4232 face-set-after-frame-defaults. */
4233 if (NILP (f
->face_alist
))
4236 if (EQ (param
, Qforeground_color
))
4238 lface
= lface_from_face_name (f
, Qdefault
, 1);
4239 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4240 ? new_value
: Qunspecified
);
4241 realize_basic_faces (f
);
4243 else if (EQ (param
, Qbackground_color
))
4247 /* Changing the background color might change the background
4248 mode, so that we have to load new defface specs. Call
4249 frame-update-face-colors to do that. */
4250 XSETFRAME (frame
, f
);
4251 call1 (Qframe_update_face_colors
, frame
);
4253 lface
= lface_from_face_name (f
, Qdefault
, 1);
4254 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4255 ? new_value
: Qunspecified
);
4256 realize_basic_faces (f
);
4258 if (EQ (param
, Qborder_color
))
4260 lface
= lface_from_face_name (f
, Qborder
, 1);
4261 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4262 ? new_value
: Qunspecified
);
4264 else if (EQ (param
, Qcursor_color
))
4266 lface
= lface_from_face_name (f
, Qcursor
, 1);
4267 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4268 ? new_value
: Qunspecified
);
4270 else if (EQ (param
, Qmouse_color
))
4272 lface
= lface_from_face_name (f
, Qmouse
, 1);
4273 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4274 ? new_value
: Qunspecified
);
4279 /* Get the value of X resource RESOURCE, class CLASS for the display
4280 of frame FRAME. This is here because ordinary `x-get-resource'
4281 doesn't take a frame argument. */
4283 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4284 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4285 (resource
, class, frame
)
4286 Lisp_Object resource
, class, frame
;
4288 Lisp_Object value
= Qnil
;
4291 CHECK_STRING (resource
, 0);
4292 CHECK_STRING (class, 1);
4293 CHECK_LIVE_FRAME (frame
, 2);
4295 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4296 resource
, class, Qnil
, Qnil
);
4298 #endif /* not macintosh */
4299 #endif /* not WINDOWSNT */
4304 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4305 If VALUE is "on" or "true", return t. If VALUE is "off" or
4306 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4307 error; if SIGNAL_P is zero, return 0. */
4310 face_boolean_x_resource_value (value
, signal_p
)
4314 Lisp_Object result
= make_number (0);
4316 xassert (STRINGP (value
));
4318 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4319 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4321 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4322 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4324 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4325 result
= Qunspecified
;
4327 signal_error ("Invalid face attribute value from X resource", value
);
4333 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4334 Finternal_set_lisp_face_attribute_from_resource
,
4335 Sinternal_set_lisp_face_attribute_from_resource
,
4337 (face
, attr
, value
, frame
)
4338 Lisp_Object face
, attr
, value
, frame
;
4340 CHECK_SYMBOL (face
, 0);
4341 CHECK_SYMBOL (attr
, 1);
4342 CHECK_STRING (value
, 2);
4344 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4345 value
= Qunspecified
;
4346 else if (EQ (attr
, QCheight
))
4348 value
= Fstring_to_number (value
, make_number (10));
4349 if (XINT (value
) <= 0)
4350 signal_error ("Invalid face height from X resource", value
);
4352 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4353 value
= face_boolean_x_resource_value (value
, 1);
4354 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4355 value
= intern (XSTRING (value
)->data
);
4356 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4357 value
= face_boolean_x_resource_value (value
, 1);
4358 else if (EQ (attr
, QCunderline
)
4359 || EQ (attr
, QCoverline
)
4360 || EQ (attr
, QCstrike_through
)
4361 || EQ (attr
, QCbox
))
4363 Lisp_Object boolean_value
;
4365 /* If the result of face_boolean_x_resource_value is t or nil,
4366 VALUE does NOT specify a color. */
4367 boolean_value
= face_boolean_x_resource_value (value
, 0);
4368 if (SYMBOLP (boolean_value
))
4369 value
= boolean_value
;
4372 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4375 #endif /* HAVE_WINDOW_SYSTEM */
4378 /***********************************************************************
4380 ***********************************************************************/
4382 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4384 /* Make menus on frame F appear as specified by the `menu' face. */
4387 x_update_menu_appearance (f
)
4390 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4394 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4398 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4399 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4400 char *myname
= XSTRING (Vx_resource_name
)->data
;
4403 const char *popup_path
= "popup_menu";
4405 const char *popup_path
= "menu.popup";
4408 if (STRINGP (LFACE_FOREGROUND (lface
)))
4410 sprintf (line
, "%s.%s*foreground: %s",
4412 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4413 XrmPutLineResource (&rdb
, line
);
4414 sprintf (line
, "%s.pane.menubar*foreground: %s",
4415 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4416 XrmPutLineResource (&rdb
, line
);
4420 if (STRINGP (LFACE_BACKGROUND (lface
)))
4422 sprintf (line
, "%s.%s*background: %s",
4424 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4425 XrmPutLineResource (&rdb
, line
);
4426 sprintf (line
, "%s.pane.menubar*background: %s",
4427 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4428 XrmPutLineResource (&rdb
, line
);
4433 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4434 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4435 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4436 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4437 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4438 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4441 const char *suffix
= "List";
4443 const char *suffix
= "";
4445 sprintf (line
, "%s.pane.menubar*font%s: %s",
4446 myname
, suffix
, face
->font_name
);
4447 XrmPutLineResource (&rdb
, line
);
4448 sprintf (line
, "%s.%s*font%s: %s",
4449 myname
, popup_path
, suffix
, face
->font_name
);
4450 XrmPutLineResource (&rdb
, line
);
4454 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4456 free_frame_menubar (f
);
4457 set_frame_menubar (f
, 1, 1);
4462 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4466 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4467 Sinternal_get_lisp_face_attribute
,
4469 "Return face attribute KEYWORD of face SYMBOL.\n\
4470 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4471 face attribute name, signal an error.\n\
4472 If the optional argument FRAME is given, report on face FACE in that\n\
4473 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4474 frames). If FRAME is omitted or nil, use the selected frame.")
4475 (symbol
, keyword
, frame
)
4476 Lisp_Object symbol
, keyword
, frame
;
4478 Lisp_Object lface
, value
= Qnil
;
4480 CHECK_SYMBOL (symbol
, 0);
4481 CHECK_SYMBOL (keyword
, 1);
4484 lface
= lface_from_face_name (NULL
, symbol
, 1);
4488 frame
= selected_frame
;
4489 CHECK_LIVE_FRAME (frame
, 2);
4490 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4493 if (EQ (keyword
, QCfamily
))
4494 value
= LFACE_FAMILY (lface
);
4495 else if (EQ (keyword
, QCheight
))
4496 value
= LFACE_HEIGHT (lface
);
4497 else if (EQ (keyword
, QCweight
))
4498 value
= LFACE_WEIGHT (lface
);
4499 else if (EQ (keyword
, QCslant
))
4500 value
= LFACE_SLANT (lface
);
4501 else if (EQ (keyword
, QCunderline
))
4502 value
= LFACE_UNDERLINE (lface
);
4503 else if (EQ (keyword
, QCoverline
))
4504 value
= LFACE_OVERLINE (lface
);
4505 else if (EQ (keyword
, QCstrike_through
))
4506 value
= LFACE_STRIKE_THROUGH (lface
);
4507 else if (EQ (keyword
, QCbox
))
4508 value
= LFACE_BOX (lface
);
4509 else if (EQ (keyword
, QCinverse_video
)
4510 || EQ (keyword
, QCreverse_video
))
4511 value
= LFACE_INVERSE (lface
);
4512 else if (EQ (keyword
, QCforeground
))
4513 value
= LFACE_FOREGROUND (lface
);
4514 else if (EQ (keyword
, QCbackground
))
4515 value
= LFACE_BACKGROUND (lface
);
4516 else if (EQ (keyword
, QCstipple
))
4517 value
= LFACE_STIPPLE (lface
);
4518 else if (EQ (keyword
, QCwidth
))
4519 value
= LFACE_SWIDTH (lface
);
4520 else if (EQ (keyword
, QCinherit
))
4521 value
= LFACE_INHERIT (lface
);
4522 else if (EQ (keyword
, QCfont
))
4523 value
= LFACE_FONT (lface
);
4525 signal_error ("Invalid face attribute name", keyword
);
4531 DEFUN ("internal-lisp-face-attribute-values",
4532 Finternal_lisp_face_attribute_values
,
4533 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4534 "Return a list of valid discrete values for face attribute ATTR.\n\
4535 Value is nil if ATTR doesn't have a discrete set of valid values.")
4539 Lisp_Object result
= Qnil
;
4541 CHECK_SYMBOL (attr
, 0);
4543 if (EQ (attr
, QCweight
)
4544 || EQ (attr
, QCslant
)
4545 || EQ (attr
, QCwidth
))
4547 /* Extract permissible symbols from tables. */
4548 struct table_entry
*table
;
4551 if (EQ (attr
, QCweight
))
4552 table
= weight_table
, dim
= DIM (weight_table
);
4553 else if (EQ (attr
, QCslant
))
4554 table
= slant_table
, dim
= DIM (slant_table
);
4556 table
= swidth_table
, dim
= DIM (swidth_table
);
4558 for (i
= 0; i
< dim
; ++i
)
4560 Lisp_Object symbol
= *table
[i
].symbol
;
4561 Lisp_Object tail
= result
;
4564 && !EQ (XCAR (tail
), symbol
))
4568 result
= Fcons (symbol
, result
);
4571 else if (EQ (attr
, QCunderline
))
4572 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4573 else if (EQ (attr
, QCoverline
))
4574 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4575 else if (EQ (attr
, QCstrike_through
))
4576 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4577 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4578 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4584 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4585 Sinternal_merge_in_global_face
, 2, 2, 0,
4586 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4587 Default face attributes override any local face attributes.")
4589 Lisp_Object face
, frame
;
4592 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4594 CHECK_LIVE_FRAME (frame
, 1);
4595 global_lface
= lface_from_face_name (NULL
, face
, 1);
4596 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4597 if (NILP (local_lface
))
4598 local_lface
= Finternal_make_lisp_face (face
, frame
);
4600 /* Make every specified global attribute override the local one.
4601 BEWARE!! This is only used from `face-set-after-frame-default' where
4602 the local frame is defined from default specs in `face-defface-spec'
4603 and those should be overridden by global settings. Hence the strange
4604 "global before local" priority. */
4605 lvec
= XVECTOR (local_lface
)->contents
;
4606 gvec
= XVECTOR (global_lface
)->contents
;
4607 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4608 if (! UNSPECIFIEDP (gvec
[i
]))
4615 /* The following function is implemented for compatibility with 20.2.
4616 The function is used in x-resolve-fonts when it is asked to
4617 return fonts with the same size as the font of a face. This is
4618 done in fontset.el. */
4620 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4621 "Return the font name of face FACE, or nil if it is unspecified.\n\
4622 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4623 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4624 The font default for a face is either nil, or a list\n\
4625 of the form (bold), (italic) or (bold italic).\n\
4626 If FRAME is omitted or nil, use the selected frame.")
4628 Lisp_Object face
, frame
;
4632 Lisp_Object result
= Qnil
;
4633 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4635 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4636 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4637 result
= Fcons (Qbold
, result
);
4639 if (!NILP (LFACE_SLANT (lface
))
4640 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4641 result
= Fcons (Qitalic
, result
);
4647 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4648 int face_id
= lookup_named_face (f
, face
, 0);
4649 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4650 return face
? build_string (face
->font_name
) : Qnil
;
4655 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4656 all attributes are `equal'. Tries to be fast because this function
4657 is called quite often. */
4660 lface_equal_p (v1
, v2
)
4661 Lisp_Object
*v1
, *v2
;
4665 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4667 Lisp_Object a
= v1
[i
];
4668 Lisp_Object b
= v2
[i
];
4670 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4671 and the other is specified. */
4672 equal_p
= XTYPE (a
) == XTYPE (b
);
4681 equal_p
= ((STRING_BYTES (XSTRING (a
))
4682 == STRING_BYTES (XSTRING (b
)))
4683 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4684 STRING_BYTES (XSTRING (a
))) == 0);
4693 equal_p
= !NILP (Fequal (a
, b
));
4703 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4704 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4705 "True if FACE1 and FACE2 are equal.\n\
4706 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4707 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4708 If FRAME is omitted or nil, use the selected frame.")
4709 (face1
, face2
, frame
)
4710 Lisp_Object face1
, face2
, frame
;
4714 Lisp_Object lface1
, lface2
;
4719 /* Don't use check_x_frame here because this function is called
4720 before X frames exist. At that time, if FRAME is nil,
4721 selected_frame will be used which is the frame dumped with
4722 Emacs. That frame is not an X frame. */
4723 f
= frame_or_selected_frame (frame
, 2);
4725 lface1
= lface_from_face_name (NULL
, face1
, 1);
4726 lface2
= lface_from_face_name (NULL
, face2
, 1);
4727 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4728 XVECTOR (lface2
)->contents
);
4729 return equal_p
? Qt
: Qnil
;
4733 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4734 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4735 "True if FACE has no attribute specified.\n\
4736 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4737 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4738 If FRAME is omitted or nil, use the selected frame.")
4740 Lisp_Object face
, frame
;
4747 frame
= selected_frame
;
4748 CHECK_LIVE_FRAME (frame
, 0);
4752 lface
= lface_from_face_name (NULL
, face
, 1);
4754 lface
= lface_from_face_name (f
, face
, 1);
4756 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4757 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4760 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4764 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4766 "Return an alist of frame-local faces defined on FRAME.\n\
4767 For internal use only.")
4771 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4772 return f
->face_alist
;
4776 /* Return a hash code for Lisp string STRING with case ignored. Used
4777 below in computing a hash value for a Lisp face. */
4779 static INLINE
unsigned
4780 hash_string_case_insensitive (string
)
4785 xassert (STRINGP (string
));
4786 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4787 hash
= (hash
<< 1) ^ tolower (*s
);
4792 /* Return a hash code for face attribute vector V. */
4794 static INLINE
unsigned
4798 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4799 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4800 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4801 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4802 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4803 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4804 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4808 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4809 considering charsets/registries). They do if they specify the same
4810 family, point size, weight, width, slant, and fontset. Both LFACE1
4811 and LFACE2 must be fully-specified. */
4814 lface_same_font_attributes_p (lface1
, lface2
)
4815 Lisp_Object
*lface1
, *lface2
;
4817 xassert (lface_fully_specified_p (lface1
)
4818 && lface_fully_specified_p (lface2
));
4819 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4820 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4821 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4822 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4823 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4824 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4825 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4826 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4827 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4828 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4829 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4830 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4835 /***********************************************************************
4837 ***********************************************************************/
4839 /* Allocate and return a new realized face for Lisp face attribute
4842 static struct face
*
4843 make_realized_face (attr
)
4846 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4847 bzero (face
, sizeof *face
);
4848 face
->ascii_face
= face
;
4849 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4854 /* Free realized face FACE, including its X resources. FACE may
4858 free_realized_face (f
, face
)
4864 #ifdef HAVE_WINDOW_SYSTEM
4865 if (FRAME_WINDOW_P (f
))
4867 /* Free fontset of FACE if it is ASCII face. */
4868 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4869 free_face_fontset (f
, face
);
4872 x_free_gc (f
, face
->gc
);
4876 free_face_colors (f
, face
);
4877 x_destroy_bitmap (f
, face
->stipple
);
4879 #endif /* HAVE_WINDOW_SYSTEM */
4886 /* Prepare face FACE for subsequent display on frame F. This
4887 allocated GCs if they haven't been allocated yet or have been freed
4888 by clearing the face cache. */
4891 prepare_face_for_display (f
, face
)
4895 #ifdef HAVE_WINDOW_SYSTEM
4896 xassert (FRAME_WINDOW_P (f
));
4901 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4903 xgcv
.foreground
= face
->foreground
;
4904 xgcv
.background
= face
->background
;
4905 #ifdef HAVE_X_WINDOWS
4906 xgcv
.graphics_exposures
= False
;
4908 /* The font of FACE may be null if we couldn't load it. */
4911 #ifdef HAVE_X_WINDOWS
4912 xgcv
.font
= face
->font
->fid
;
4915 xgcv
.font
= face
->font
;
4918 xgcv
.font
= face
->font
;
4924 #ifdef HAVE_X_WINDOWS
4927 xgcv
.fill_style
= FillOpaqueStippled
;
4928 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4929 mask
|= GCFillStyle
| GCStipple
;
4932 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4935 #endif /* HAVE_WINDOW_SYSTEM */
4939 /***********************************************************************
4941 ***********************************************************************/
4943 /* Return a new face cache for frame F. */
4945 static struct face_cache
*
4949 struct face_cache
*c
;
4952 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4953 bzero (c
, sizeof *c
);
4954 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4955 c
->buckets
= (struct face
**) xmalloc (size
);
4956 bzero (c
->buckets
, size
);
4958 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4964 /* Clear out all graphics contexts for all realized faces, except for
4965 the basic faces. This should be done from time to time just to avoid
4966 keeping too many graphics contexts that are no longer needed. */
4970 struct face_cache
*c
;
4972 if (c
&& FRAME_WINDOW_P (c
->f
))
4974 #ifdef HAVE_WINDOW_SYSTEM
4976 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4978 struct face
*face
= c
->faces_by_id
[i
];
4979 if (face
&& face
->gc
)
4981 x_free_gc (c
->f
, face
->gc
);
4985 #endif /* HAVE_WINDOW_SYSTEM */
4990 /* Free all realized faces in face cache C, including basic faces. C
4991 may be null. If faces are freed, make sure the frame's current
4992 matrix is marked invalid, so that a display caused by an expose
4993 event doesn't try to use faces we destroyed. */
4996 free_realized_faces (c
)
4997 struct face_cache
*c
;
5002 struct frame
*f
= c
->f
;
5004 /* We must block input here because we can't process X events
5005 safely while only some faces are freed, or when the frame's
5006 current matrix still references freed faces. */
5009 for (i
= 0; i
< c
->used
; ++i
)
5011 free_realized_face (f
, c
->faces_by_id
[i
]);
5012 c
->faces_by_id
[i
] = NULL
;
5016 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5017 bzero (c
->buckets
, size
);
5019 /* Must do a thorough redisplay the next time. Mark current
5020 matrices as invalid because they will reference faces freed
5021 above. This function is also called when a frame is
5022 destroyed. In this case, the root window of F is nil. */
5023 if (WINDOWP (f
->root_window
))
5025 clear_current_matrices (f
);
5026 ++windows_or_buffers_changed
;
5034 /* Free all faces realized for multibyte characters on frame F that
5038 free_realized_multibyte_face (f
, fontset
)
5042 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5046 /* We must block input here because we can't process X events safely
5047 while only some faces are freed, or when the frame's current
5048 matrix still references freed faces. */
5051 for (i
= 0; i
< cache
->used
; i
++)
5053 face
= cache
->faces_by_id
[i
];
5055 && face
!= face
->ascii_face
5056 && face
->fontset
== fontset
)
5058 uncache_face (cache
, face
);
5059 free_realized_face (f
, face
);
5063 /* Must do a thorough redisplay the next time. Mark current
5064 matrices as invalid because they will reference faces freed
5065 above. This function is also called when a frame is destroyed.
5066 In this case, the root window of F is nil. */
5067 if (WINDOWP (f
->root_window
))
5069 clear_current_matrices (f
);
5070 ++windows_or_buffers_changed
;
5077 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5078 This is done after attributes of a named face have been changed,
5079 because we can't tell which realized faces depend on that face. */
5082 free_all_realized_faces (frame
)
5088 FOR_EACH_FRAME (rest
, frame
)
5089 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5092 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5096 /* Free face cache C and faces in it, including their X resources. */
5100 struct face_cache
*c
;
5104 free_realized_faces (c
);
5106 xfree (c
->faces_by_id
);
5112 /* Cache realized face FACE in face cache C. HASH is the hash value
5113 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5114 collision list of the face hash table of C. This is done because
5115 otherwise lookup_face would find FACE for every character, even if
5116 faces with the same attributes but for specific characters exist. */
5119 cache_face (c
, face
, hash
)
5120 struct face_cache
*c
;
5124 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5128 if (face
->fontset
>= 0)
5130 struct face
*last
= c
->buckets
[i
];
5141 c
->buckets
[i
] = face
;
5142 face
->prev
= face
->next
= NULL
;
5148 face
->next
= c
->buckets
[i
];
5150 face
->next
->prev
= face
;
5151 c
->buckets
[i
] = face
;
5154 /* Find a free slot in C->faces_by_id and use the index of the free
5155 slot as FACE->id. */
5156 for (i
= 0; i
< c
->used
; ++i
)
5157 if (c
->faces_by_id
[i
] == NULL
)
5161 /* Maybe enlarge C->faces_by_id. */
5162 if (i
== c
->used
&& c
->used
== c
->size
)
5164 int new_size
= 2 * c
->size
;
5165 int sz
= new_size
* sizeof *c
->faces_by_id
;
5166 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5171 /* Check that FACE got a unique id. */
5176 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5177 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5183 #endif /* GLYPH_DEBUG */
5185 c
->faces_by_id
[i
] = face
;
5191 /* Remove face FACE from cache C. */
5194 uncache_face (c
, face
)
5195 struct face_cache
*c
;
5198 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5201 face
->prev
->next
= face
->next
;
5203 c
->buckets
[i
] = face
->next
;
5206 face
->next
->prev
= face
->prev
;
5208 c
->faces_by_id
[face
->id
] = NULL
;
5209 if (face
->id
== c
->used
)
5214 /* Look up a realized face with face attributes ATTR in the face cache
5215 of frame F. The face will be used to display character C. Value
5216 is the ID of the face found. If no suitable face is found, realize
5217 a new one. In that case, if C is a multibyte character, BASE_FACE
5218 is a face that has the same attributes. */
5221 lookup_face (f
, attr
, c
, base_face
)
5225 struct face
*base_face
;
5227 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5232 xassert (cache
!= NULL
);
5233 check_lface_attrs (attr
);
5235 /* Look up ATTR in the face cache. */
5236 hash
= lface_hash (attr
);
5237 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5239 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5240 if (face
->hash
== hash
5241 && (!FRAME_WINDOW_P (f
)
5242 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5243 && lface_equal_p (face
->lface
, attr
))
5246 /* If not found, realize a new face. */
5248 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5251 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5253 /* When this function is called from face_for_char (in this case, C is
5254 a multibyte character), a fontset of a face returned by
5255 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5256 C) is not sutisfied. The fontset is set for this face by
5257 face_for_char later. */
5259 if (FRAME_WINDOW_P (f
))
5260 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5262 #endif /* GLYPH_DEBUG */
5268 /* Return the face id of the realized face for named face SYMBOL on
5269 frame F suitable for displaying character C. Value is -1 if the
5270 face couldn't be determined, which might happen if the default face
5271 isn't realized and cannot be realized. */
5274 lookup_named_face (f
, symbol
, c
)
5279 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5280 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5281 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5283 if (default_face
== NULL
)
5285 if (!realize_basic_faces (f
))
5287 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5290 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5291 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5292 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5293 return lookup_face (f
, attrs
, c
, NULL
);
5297 /* Return the ID of the realized ASCII face of Lisp face with ID
5298 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5301 ascii_face_of_lisp_face (f
, lface_id
)
5307 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5309 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5310 face_id
= lookup_named_face (f
, face_name
, 0);
5319 /* Return a face for charset ASCII that is like the face with id
5320 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5321 STEPS < 0 means larger. Value is the id of the face. */
5324 smaller_face (f
, face_id
, steps
)
5328 #ifdef HAVE_WINDOW_SYSTEM
5330 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5331 int pt
, last_pt
, last_height
;
5334 struct face
*new_face
;
5336 /* If not called for an X frame, just return the original face. */
5337 if (FRAME_TERMCAP_P (f
))
5340 /* Try in increments of 1/2 pt. */
5341 delta
= steps
< 0 ? 5 : -5;
5342 steps
= abs (steps
);
5344 face
= FACE_FROM_ID (f
, face_id
);
5345 bcopy (face
->lface
, attrs
, sizeof attrs
);
5346 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5347 new_face_id
= face_id
;
5348 last_height
= FONT_HEIGHT (face
->font
);
5352 /* Give up if we cannot find a font within 10pt. */
5353 && abs (last_pt
- pt
) < 100)
5355 /* Look up a face for a slightly smaller/larger font. */
5357 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5358 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5359 new_face
= FACE_FROM_ID (f
, new_face_id
);
5361 /* If height changes, count that as one step. */
5362 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5363 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5366 last_height
= FONT_HEIGHT (new_face
->font
);
5373 #else /* not HAVE_WINDOW_SYSTEM */
5377 #endif /* not HAVE_WINDOW_SYSTEM */
5381 /* Return a face for charset ASCII that is like the face with id
5382 FACE_ID on frame F, but has height HEIGHT. */
5385 face_with_height (f
, face_id
, height
)
5390 #ifdef HAVE_WINDOW_SYSTEM
5392 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5394 if (FRAME_TERMCAP_P (f
)
5398 face
= FACE_FROM_ID (f
, face_id
);
5399 bcopy (face
->lface
, attrs
, sizeof attrs
);
5400 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5401 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5402 #endif /* HAVE_WINDOW_SYSTEM */
5408 /* Return the face id of the realized face for named face SYMBOL on
5409 frame F suitable for displaying character C, and use attributes of
5410 the face FACE_ID for attributes that aren't completely specified by
5411 SYMBOL. This is like lookup_named_face, except that the default
5412 attributes come from FACE_ID, not from the default face. FACE_ID
5413 is assumed to be already realized. */
5416 lookup_derived_face (f
, symbol
, c
, face_id
)
5422 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5423 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5424 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5429 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5430 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5431 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5432 return lookup_face (f
, attrs
, c
, default_face
);
5437 /***********************************************************************
5439 ***********************************************************************/
5441 DEFUN ("internal-set-font-selection-order",
5442 Finternal_set_font_selection_order
,
5443 Sinternal_set_font_selection_order
, 1, 1, 0,
5444 "Set font selection order for face font selection to ORDER.\n\
5445 ORDER must be a list of length 4 containing the symbols `:width',\n\
5446 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5447 first in ORDER are matched first, e.g. if `:height' appears before\n\
5448 `:weight' in ORDER, font selection first tries to find a font with\n\
5449 a suitable height, and then tries to match the font weight.\n\
5456 int indices
[DIM (font_sort_order
)];
5458 CHECK_LIST (order
, 0);
5459 bzero (indices
, sizeof indices
);
5463 CONSP (list
) && i
< DIM (indices
);
5464 list
= XCDR (list
), ++i
)
5466 Lisp_Object attr
= XCAR (list
);
5469 if (EQ (attr
, QCwidth
))
5471 else if (EQ (attr
, QCheight
))
5472 xlfd
= XLFD_POINT_SIZE
;
5473 else if (EQ (attr
, QCweight
))
5475 else if (EQ (attr
, QCslant
))
5480 if (indices
[i
] != 0)
5485 if (!NILP (list
) || i
!= DIM (indices
))
5486 signal_error ("Invalid font sort order", order
);
5487 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5488 if (indices
[i
] == 0)
5489 signal_error ("Invalid font sort order", order
);
5491 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5493 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5494 free_all_realized_faces (Qnil
);
5501 DEFUN ("internal-set-alternative-font-family-alist",
5502 Finternal_set_alternative_font_family_alist
,
5503 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5504 "Define alternative font families to try in face font selection.\n\
5505 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5506 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5507 be found. Value is ALIST.")
5511 CHECK_LIST (alist
, 0);
5512 Vface_alternative_font_family_alist
= alist
;
5513 free_all_realized_faces (Qnil
);
5518 DEFUN ("internal-set-alternative-font-registry-alist",
5519 Finternal_set_alternative_font_registry_alist
,
5520 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5521 "Define alternative font registries to try in face font selection.\n\
5522 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5523 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5524 be found. Value is ALIST.")
5528 CHECK_LIST (alist
, 0);
5529 Vface_alternative_font_registry_alist
= alist
;
5530 free_all_realized_faces (Qnil
);
5535 #ifdef HAVE_WINDOW_SYSTEM
5537 /* Value is non-zero if FONT is the name of a scalable font. The
5538 X11R6 XLFD spec says that point size, pixel size, and average width
5539 are zero for scalable fonts. Intlfonts contain at least one
5540 scalable font ("*-muleindian-1") for which this isn't true, so we
5541 just test average width. */
5544 font_scalable_p (font
)
5545 struct font_name
*font
;
5547 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5548 return (*s
== '0' && *(s
+ 1) == '\0')
5550 /* Windows implementation of XLFD is slightly broken for backward
5551 compatibility with previous broken versions, so test for
5552 wildcards as well as 0. */
5559 /* Ignore the difference of font point size less than this value. */
5561 #define FONT_POINT_SIZE_QUANTUM 5
5563 /* Value is non-zero if FONT1 is a better match for font attributes
5564 VALUES than FONT2. VALUES is an array of face attribute values in
5565 font sort order. COMPARE_PT_P zero means don't compare point
5566 sizes. AVGWIDTH, if not zero, is a specified font average width
5570 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5572 struct font_name
*font1
, *font2
;
5573 int compare_pt_p
, avgwidth
;
5577 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5579 int xlfd_idx
= font_sort_order
[i
];
5581 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5583 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5584 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5586 if (xlfd_idx
== XLFD_POINT_SIZE
5587 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5589 if (delta1
> delta2
)
5591 else if (delta1
< delta2
)
5595 /* The difference may be equal because, e.g., the face
5596 specifies `italic' but we have only `regular' and
5597 `oblique'. Prefer `oblique' in this case. */
5598 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5599 && font1
->numeric
[xlfd_idx
] > values
[i
]
5600 && font2
->numeric
[xlfd_idx
] < values
[i
])
5608 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5609 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5610 if (delta1
> delta2
)
5612 else if (delta1
< delta2
)
5616 return font1
->registry_priority
< font2
->registry_priority
;
5620 /* Value is non-zero if FONT is an exact match for face attributes in
5621 SPECIFIED. SPECIFIED is an array of face attribute values in font
5622 sort order. AVGWIDTH, if non-zero, is an average width to compare
5626 exact_face_match_p (specified
, font
, avgwidth
)
5628 struct font_name
*font
;
5633 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5634 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5637 return (i
== DIM (font_sort_order
)
5639 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5643 /* Value is the name of a scaled font, generated from scalable font
5644 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5645 Value is allocated from heap. */
5648 build_scalable_font_name (f
, font
, specified_pt
)
5650 struct font_name
*font
;
5653 char point_size
[20], pixel_size
[20];
5655 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5658 /* If scalable font is for a specific resolution, compute
5659 the point size we must specify from the resolution of
5660 the display and the specified resolution of the font. */
5661 if (font
->numeric
[XLFD_RESY
] != 0)
5663 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5664 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5669 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5672 /* Set point size of the font. */
5673 sprintf (point_size
, "%d", (int) pt
);
5674 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5675 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5677 /* Set pixel size. */
5678 sprintf (pixel_size
, "%d", pixel_value
);
5679 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5680 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5682 /* If font doesn't specify its resolution, use the
5683 resolution of the display. */
5684 if (font
->numeric
[XLFD_RESY
] == 0)
5687 sprintf (buffer
, "%d", (int) resy
);
5688 font
->fields
[XLFD_RESY
] = buffer
;
5689 font
->numeric
[XLFD_RESY
] = resy
;
5692 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5695 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5696 sprintf (buffer
, "%d", resx
);
5697 font
->fields
[XLFD_RESX
] = buffer
;
5698 font
->numeric
[XLFD_RESX
] = resx
;
5701 return build_font_name (font
);
5705 /* Value is non-zero if we are allowed to use scalable font FONT. We
5706 can't run a Lisp function here since this function may be called
5707 with input blocked. */
5710 may_use_scalable_font_p (font
)
5713 if (EQ (Vscalable_fonts_allowed
, Qt
))
5715 else if (CONSP (Vscalable_fonts_allowed
))
5717 Lisp_Object tail
, regexp
;
5719 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5721 regexp
= XCAR (tail
);
5722 if (STRINGP (regexp
)
5723 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5733 /* Return the name of the best matching font for face attributes ATTRS
5734 in the array of font_name structures FONTS which contains NFONTS
5735 elements. WIDTH_RATIO is a factor with which to multiply average
5736 widths if ATTRS specifies such a width.
5738 Value is a font name which is allocated from the heap. FONTS is
5739 freed by this function. */
5742 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5745 struct font_name
*fonts
;
5750 struct font_name
*best
;
5753 int exact_p
, avgwidth
;
5758 /* Make specified font attributes available in `specified',
5759 indexed by sort order. */
5760 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5762 int xlfd_idx
= font_sort_order
[i
];
5764 if (xlfd_idx
== XLFD_SWIDTH
)
5765 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5766 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5767 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5768 else if (xlfd_idx
== XLFD_WEIGHT
)
5769 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5770 else if (xlfd_idx
== XLFD_SLANT
)
5771 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5776 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5778 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5782 /* Start with the first non-scalable font in the list. */
5783 for (i
= 0; i
< nfonts
; ++i
)
5784 if (!font_scalable_p (fonts
+ i
))
5787 /* Find the best match among the non-scalable fonts. */
5792 for (i
= 1; i
< nfonts
; ++i
)
5793 if (!font_scalable_p (fonts
+ i
)
5794 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5798 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5807 /* Unless we found an exact match among non-scalable fonts, see if
5808 we can find a better match among scalable fonts. */
5811 /* A scalable font is better if
5813 1. its weight, slant, swidth attributes are better, or.
5815 2. the best non-scalable font doesn't have the required
5816 point size, and the scalable fonts weight, slant, swidth
5819 int non_scalable_has_exact_height_p
;
5821 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5822 non_scalable_has_exact_height_p
= 1;
5824 non_scalable_has_exact_height_p
= 0;
5826 for (i
= 0; i
< nfonts
; ++i
)
5827 if (font_scalable_p (fonts
+ i
))
5830 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5831 || (!non_scalable_has_exact_height_p
5832 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5837 if (font_scalable_p (best
))
5838 font_name
= build_scalable_font_name (f
, best
, pt
);
5840 font_name
= build_font_name (best
);
5842 /* Free font_name structures. */
5843 free_font_names (fonts
, nfonts
);
5849 /* Get a list of matching fonts on frame F, considering FAMILY
5850 and alternative font families from Vface_alternative_font_registry_alist.
5852 FAMILY is the font family whose alternatives are considered.
5854 REGISTRY, if a string, specifies a font registry and encoding to
5855 match. A value of nil means include fonts of any registry and
5858 Return in *FONTS a pointer to a vector of font_name structures for
5859 the fonts matched. Value is the number of fonts found. */
5862 try_alternative_families (f
, family
, registry
, fonts
)
5864 Lisp_Object family
, registry
;
5865 struct font_name
**fonts
;
5870 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5873 /* Try alternative font families. */
5874 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5877 for (alter
= XCDR (alter
);
5878 CONSP (alter
) && nfonts
== 0;
5879 alter
= XCDR (alter
))
5881 if (STRINGP (XCAR (alter
)))
5882 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5886 /* Try scalable fonts before giving up. */
5887 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5889 int count
= BINDING_STACK_SIZE ();
5890 specbind (Qscalable_fonts_allowed
, Qt
);
5891 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5892 unbind_to (count
, Qnil
);
5899 /* Get a list of matching fonts on frame F.
5901 FAMILY, if a string, specifies a font family derived from the fontset.
5902 It is only used if the face does not specify any family in ATTRS or
5903 if we cannot find any font of the face's family.
5905 REGISTRY, if a string, specifies a font registry and encoding to
5906 match. A value of nil means include fonts of any registry and
5909 Return in *FONTS a pointer to a vector of font_name structures for
5910 the fonts matched. Value is the number of fonts found. */
5913 try_font_list (f
, attrs
, family
, registry
, fonts
)
5916 Lisp_Object family
, registry
;
5917 struct font_name
**fonts
;
5920 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
5922 if (STRINGP (face_family
))
5923 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
5925 if (nfonts
== 0 && !NILP (family
))
5926 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5928 /* Try font family of the default face or "fixed". */
5931 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5933 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
5935 family
= build_string ("fixed");
5936 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5939 /* Try any family with the given registry. */
5941 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5947 /* Return the fontset id of the base fontset name or alias name given
5948 by the fontset attribute of ATTRS. Value is -1 if the fontset
5949 attribute of ATTRS doesn't name a fontset. */
5952 face_fontset (attrs
)
5957 name
= attrs
[LFACE_FONT_INDEX
];
5958 if (!STRINGP (name
))
5960 return fs_query_fontset (name
, 0);
5964 /* Choose a name of font to use on frame F to display character C with
5965 Lisp face attributes specified by ATTRS. The font name is
5966 determined by the font-related attributes in ATTRS and the name
5967 pattern for C in FONTSET. Value is the font name which is
5968 allocated from the heap and must be freed by the caller, or NULL if
5969 we can get no information about the font name of C. It is assured
5970 that we always get some information for a single byte
5974 choose_face_font (f
, attrs
, fontset
, c
)
5979 Lisp_Object pattern
;
5980 char *font_name
= NULL
;
5981 struct font_name
*fonts
;
5982 int nfonts
, width_ratio
;
5984 /* Get (foundry and) family name and registry (and encoding) name of
5986 pattern
= fontset_font_pattern (f
, fontset
, c
);
5989 xassert (!SINGLE_BYTE_CHAR_P (c
));
5993 /* If what we got is a name pattern, return it. */
5994 if (STRINGP (pattern
))
5995 return xstrdup (XSTRING (pattern
)->data
);
5997 /* Get a list of fonts matching that pattern and choose the
5998 best match for the specified face attributes from it. */
5999 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6000 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6002 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6003 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6007 #endif /* HAVE_WINDOW_SYSTEM */
6011 /***********************************************************************
6013 ***********************************************************************/
6015 /* Realize basic faces on frame F. Value is zero if frame parameters
6016 of F don't contain enough information needed to realize the default
6020 realize_basic_faces (f
)
6024 int count
= BINDING_STACK_SIZE ();
6026 /* Block input there so that we won't be surprised by an X expose
6027 event, for instance without having the faces set up. */
6029 specbind (Qscalable_fonts_allowed
, Qt
);
6031 if (realize_default_face (f
))
6033 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6034 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6035 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6036 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6037 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6038 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6039 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6040 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6041 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6043 /* Reflect changes in the `menu' face in menu bars. */
6044 if (menu_face_change_count
)
6046 --menu_face_change_count
;
6047 #ifdef USE_X_TOOLKIT
6048 x_update_menu_appearance (f
);
6055 unbind_to (count
, Qnil
);
6061 /* Realize the default face on frame F. If the face is not fully
6062 specified, make it fully-specified. Attributes of the default face
6063 that are not explicitly specified are taken from frame parameters. */
6066 realize_default_face (f
)
6069 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6071 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6072 Lisp_Object frame_font
;
6075 /* If the `default' face is not yet known, create it. */
6076 lface
= lface_from_face_name (f
, Qdefault
, 0);
6080 XSETFRAME (frame
, f
);
6081 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6084 #ifdef HAVE_WINDOW_SYSTEM
6085 if (FRAME_WINDOW_P (f
))
6087 /* Set frame_font to the value of the `font' frame parameter. */
6088 frame_font
= Fassq (Qfont
, f
->param_alist
);
6089 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6090 frame_font
= XCDR (frame_font
);
6091 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6093 #endif /* HAVE_WINDOW_SYSTEM */
6095 if (!FRAME_WINDOW_P (f
))
6097 LFACE_FAMILY (lface
) = build_string ("default");
6098 LFACE_SWIDTH (lface
) = Qnormal
;
6099 LFACE_HEIGHT (lface
) = make_number (1);
6100 LFACE_WEIGHT (lface
) = Qnormal
;
6101 LFACE_SLANT (lface
) = Qnormal
;
6102 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6105 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6106 LFACE_UNDERLINE (lface
) = Qnil
;
6108 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6109 LFACE_OVERLINE (lface
) = Qnil
;
6111 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6112 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6114 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6115 LFACE_BOX (lface
) = Qnil
;
6117 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6118 LFACE_INVERSE (lface
) = Qnil
;
6120 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6122 /* This function is called so early that colors are not yet
6123 set in the frame parameter list. */
6124 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6126 if (CONSP (color
) && STRINGP (XCDR (color
)))
6127 LFACE_FOREGROUND (lface
) = XCDR (color
);
6128 else if (FRAME_WINDOW_P (f
))
6130 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6131 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6136 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6138 /* This function is called so early that colors are not yet
6139 set in the frame parameter list. */
6140 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6141 if (CONSP (color
) && STRINGP (XCDR (color
)))
6142 LFACE_BACKGROUND (lface
) = XCDR (color
);
6143 else if (FRAME_WINDOW_P (f
))
6145 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6146 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6151 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6152 LFACE_STIPPLE (lface
) = Qnil
;
6154 /* Realize the face; it must be fully-specified now. */
6155 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6156 check_lface (lface
);
6157 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6158 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6163 /* Realize basic faces other than the default face in face cache C.
6164 SYMBOL is the face name, ID is the face id the realized face must
6165 have. The default face must have been realized already. */
6168 realize_named_face (f
, symbol
, id
)
6173 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6174 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6175 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6176 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6177 struct face
*new_face
;
6179 /* The default face must exist and be fully specified. */
6180 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6181 check_lface_attrs (attrs
);
6182 xassert (lface_fully_specified_p (attrs
));
6184 /* If SYMBOL isn't know as a face, create it. */
6188 XSETFRAME (frame
, f
);
6189 lface
= Finternal_make_lisp_face (symbol
, frame
);
6192 /* Merge SYMBOL's face with the default face. */
6193 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6194 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6196 /* Realize the face. */
6197 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6201 /* Realize the fully-specified face with attributes ATTRS in face
6202 cache CACHE for character C. If C is a multibyte character,
6203 BASE_FACE is a face that has the same attributes. Otherwise,
6204 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6205 ID of face to remove before caching the new face. Value is a
6206 pointer to the newly created realized face. */
6208 static struct face
*
6209 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6210 struct face_cache
*cache
;
6213 struct face
*base_face
;
6218 /* LFACE must be fully specified. */
6219 xassert (cache
!= NULL
);
6220 check_lface_attrs (attrs
);
6222 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6224 /* Remove the former face. */
6225 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6226 uncache_face (cache
, former_face
);
6227 free_realized_face (cache
->f
, former_face
);
6230 if (FRAME_WINDOW_P (cache
->f
))
6231 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6232 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6233 face
= realize_tty_face (cache
, attrs
, c
);
6237 /* Insert the new face. */
6238 cache_face (cache
, face
, lface_hash (attrs
));
6239 #ifdef HAVE_WINDOW_SYSTEM
6240 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6241 load_face_font (cache
->f
, face
, c
);
6242 #endif /* HAVE_WINDOW_SYSTEM */
6247 /* Realize the fully-specified face with attributes ATTRS in face
6248 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6249 a multibyte character, BASE_FACE is a face that has the same
6250 attributes. Otherwise, BASE_FACE is ignored. If the new face
6251 doesn't share font with the default face, a fontname is allocated
6252 from the heap and set in `font_name' of the new face, but it is not
6253 yet loaded here. Value is a pointer to the newly created realized
6256 static struct face
*
6257 realize_x_face (cache
, attrs
, c
, base_face
)
6258 struct face_cache
*cache
;
6261 struct face
*base_face
;
6263 #ifdef HAVE_WINDOW_SYSTEM
6264 struct face
*face
, *default_face
;
6266 Lisp_Object stipple
, overline
, strike_through
, box
;
6268 xassert (FRAME_WINDOW_P (cache
->f
));
6269 xassert (SINGLE_BYTE_CHAR_P (c
)
6272 /* Allocate a new realized face. */
6273 face
= make_realized_face (attrs
);
6277 /* If C is a multibyte character, we share all face attirbutes with
6278 BASE_FACE including the realized fontset. But, we must load a
6280 if (!SINGLE_BYTE_CHAR_P (c
))
6282 bcopy (base_face
, face
, sizeof *face
);
6285 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6286 face
->foreground_defaulted_p
= 1;
6287 face
->background_defaulted_p
= 1;
6288 face
->underline_defaulted_p
= 1;
6289 face
->overline_color_defaulted_p
= 1;
6290 face
->strike_through_color_defaulted_p
= 1;
6291 face
->box_color_defaulted_p
= 1;
6293 /* to force realize_face to load font */
6298 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6300 /* Determine the font to use. Most of the time, the font will be
6301 the same as the font of the default face, so try that first. */
6302 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6304 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6305 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6307 face
->font
= default_face
->font
;
6308 face
->fontset
= default_face
->fontset
;
6309 face
->font_info_id
= default_face
->font_info_id
;
6310 face
->font_name
= default_face
->font_name
;
6311 face
->ascii_face
= face
;
6313 /* But, as we can't share the fontset, make a new realized
6314 fontset that has the same base fontset as of the default
6317 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6321 /* If the face attribute ATTRS specifies a fontset, use it as
6322 the base of a new realized fontset. Otherwise, use the same
6323 base fontset as of the default face. The base determines
6324 registry and encoding of a font. It may also determine
6325 foundry and family. The other fields of font name pattern
6326 are constructed from ATTRS. */
6327 int fontset
= face_fontset (attrs
);
6329 if ((fontset
== -1) && default_face
)
6330 fontset
= default_face
->fontset
;
6331 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6332 face
->font
= NULL
; /* to force realize_face to load font */
6335 /* Load the font if it is specified in ATTRS. This fixes
6336 changing frame font on the Mac. */
6337 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6339 struct font_info
*font_info
=
6340 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6342 face
->font
= font_info
->font
;
6347 /* Load colors, and set remaining attributes. */
6349 load_face_colors (f
, face
, attrs
);
6352 box
= attrs
[LFACE_BOX_INDEX
];
6355 /* A simple box of line width 1 drawn in color given by
6357 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6359 face
->box
= FACE_SIMPLE_BOX
;
6360 face
->box_line_width
= 1;
6362 else if (INTEGERP (box
))
6364 /* Simple box of specified line width in foreground color of the
6366 xassert (XINT (box
) != 0);
6367 face
->box
= FACE_SIMPLE_BOX
;
6368 face
->box_line_width
= XINT (box
);
6369 face
->box_color
= face
->foreground
;
6370 face
->box_color_defaulted_p
= 1;
6372 else if (CONSP (box
))
6374 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6375 being one of `raised' or `sunken'. */
6376 face
->box
= FACE_SIMPLE_BOX
;
6377 face
->box_color
= face
->foreground
;
6378 face
->box_color_defaulted_p
= 1;
6379 face
->box_line_width
= 1;
6383 Lisp_Object keyword
, value
;
6385 keyword
= XCAR (box
);
6393 if (EQ (keyword
, QCline_width
))
6395 if (INTEGERP (value
) && XINT (value
) != 0)
6396 face
->box_line_width
= XINT (value
);
6398 else if (EQ (keyword
, QCcolor
))
6400 if (STRINGP (value
))
6402 face
->box_color
= load_color (f
, face
, value
,
6404 face
->use_box_color_for_shadows_p
= 1;
6407 else if (EQ (keyword
, QCstyle
))
6409 if (EQ (value
, Qreleased_button
))
6410 face
->box
= FACE_RAISED_BOX
;
6411 else if (EQ (value
, Qpressed_button
))
6412 face
->box
= FACE_SUNKEN_BOX
;
6417 /* Text underline, overline, strike-through. */
6419 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6421 /* Use default color (same as foreground color). */
6422 face
->underline_p
= 1;
6423 face
->underline_defaulted_p
= 1;
6424 face
->underline_color
= 0;
6426 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6428 /* Use specified color. */
6429 face
->underline_p
= 1;
6430 face
->underline_defaulted_p
= 0;
6431 face
->underline_color
6432 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6433 LFACE_UNDERLINE_INDEX
);
6435 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6437 face
->underline_p
= 0;
6438 face
->underline_defaulted_p
= 0;
6439 face
->underline_color
= 0;
6442 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6443 if (STRINGP (overline
))
6445 face
->overline_color
6446 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6447 LFACE_OVERLINE_INDEX
);
6448 face
->overline_p
= 1;
6450 else if (EQ (overline
, Qt
))
6452 face
->overline_color
= face
->foreground
;
6453 face
->overline_color_defaulted_p
= 1;
6454 face
->overline_p
= 1;
6457 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6458 if (STRINGP (strike_through
))
6460 face
->strike_through_color
6461 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6462 LFACE_STRIKE_THROUGH_INDEX
);
6463 face
->strike_through_p
= 1;
6465 else if (EQ (strike_through
, Qt
))
6467 face
->strike_through_color
= face
->foreground
;
6468 face
->strike_through_color_defaulted_p
= 1;
6469 face
->strike_through_p
= 1;
6472 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6473 if (!NILP (stipple
))
6474 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6476 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6478 #endif /* HAVE_WINDOW_SYSTEM */
6482 /* Map a specified color of face FACE on frame F to a tty color index.
6483 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6484 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6485 default foreground/background colors. */
6488 map_tty_color (f
, face
, idx
, defaulted
)
6491 enum lface_attribute_index idx
;
6494 Lisp_Object frame
, color
, def
;
6495 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6496 unsigned long default_pixel
, default_other_pixel
, pixel
;
6498 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6502 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6503 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6507 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6508 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6511 XSETFRAME (frame
, f
);
6512 color
= face
->lface
[idx
];
6515 && XSTRING (color
)->size
6516 && CONSP (Vtty_defined_color_alist
)
6517 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6520 /* Associations in tty-defined-color-alist are of the form
6521 (NAME INDEX R G B). We need the INDEX part. */
6522 pixel
= XINT (XCAR (XCDR (def
)));
6525 if (pixel
== default_pixel
&& STRINGP (color
))
6527 pixel
= load_color (f
, face
, color
, idx
);
6529 #if defined (MSDOS) || defined (WINDOWSNT)
6530 /* If the foreground of the default face is the default color,
6531 use the foreground color defined by the frame. */
6533 if (FRAME_MSDOS_P (f
))
6536 if (pixel
== default_pixel
6537 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6540 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6542 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6543 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6546 else if (pixel
== default_other_pixel
)
6549 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6551 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6552 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6558 #endif /* MSDOS or WINDOWSNT */
6562 face
->foreground
= pixel
;
6564 face
->background
= pixel
;
6568 /* Realize the fully-specified face with attributes ATTRS in face
6569 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6570 pointer to the newly created realized face. */
6572 static struct face
*
6573 realize_tty_face (cache
, attrs
, c
)
6574 struct face_cache
*cache
;
6580 int face_colors_defaulted
= 0;
6581 struct frame
*f
= cache
->f
;
6583 /* Frame must be a termcap frame. */
6584 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6586 /* Allocate a new realized face. */
6587 face
= make_realized_face (attrs
);
6588 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6590 /* Map face attributes to TTY appearances. We map slant to
6591 dimmed text because we want italic text to appear differently
6592 and because dimmed text is probably used infrequently. */
6593 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6594 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6596 if (weight
> XLFD_WEIGHT_MEDIUM
)
6597 face
->tty_bold_p
= 1;
6598 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6599 face
->tty_dim_p
= 1;
6600 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6601 face
->tty_underline_p
= 1;
6602 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6603 face
->tty_reverse_p
= 1;
6605 /* Map color names to color indices. */
6606 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6607 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6609 /* Swap colors if face is inverse-video. If the colors are taken
6610 from the frame colors, they are already inverted, since the
6611 frame-creation function calls x-handle-reverse-video. */
6612 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6614 unsigned long tem
= face
->foreground
;
6615 face
->foreground
= face
->background
;
6616 face
->background
= tem
;
6619 if (tty_suppress_bold_inverse_default_colors_p
6621 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6622 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6623 face
->tty_bold_p
= 0;
6629 DEFUN ("tty-suppress-bold-inverse-default-colors",
6630 Ftty_suppress_bold_inverse_default_colors
,
6631 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6632 "Suppress/allow boldness of faces with inverse default colors.\n\
6633 SUPPRESS non-nil means suppress it.\n\
6634 This affects bold faces on TTYs whose foreground is the default background\n\
6635 color of the display and whose background is the default foreground color.\n\
6636 For such faces, the bold face attribute is ignored if this variable\n\
6639 Lisp_Object suppress
;
6641 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6642 ++face_change_count
;
6648 /***********************************************************************
6650 ***********************************************************************/
6652 /* Return the ID of the face to use to display character CH with face
6653 property PROP on frame F in current_buffer. */
6656 compute_char_face (f
, ch
, prop
)
6663 if (NILP (current_buffer
->enable_multibyte_characters
))
6668 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6669 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6673 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6674 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6675 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6676 merge_face_vector_with_property (f
, attrs
, prop
);
6677 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6684 /* Return the face ID associated with buffer position POS for
6685 displaying ASCII characters. Return in *ENDPTR the position at
6686 which a different face is needed, as far as text properties and
6687 overlays are concerned. W is a window displaying current_buffer.
6689 REGION_BEG, REGION_END delimit the region, so it can be
6692 LIMIT is a position not to scan beyond. That is to limit the time
6693 this function can take.
6695 If MOUSE is non-zero, use the character's mouse-face, not its face.
6697 The face returned is suitable for displaying ASCII characters. */
6700 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6701 endptr
, limit
, mouse
)
6704 int region_beg
, region_end
;
6709 struct frame
*f
= XFRAME (w
->frame
);
6710 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6711 Lisp_Object prop
, position
;
6713 Lisp_Object
*overlay_vec
;
6716 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6717 Lisp_Object limit1
, end
;
6718 struct face
*default_face
;
6720 /* W must display the current buffer. We could write this function
6721 to use the frame and buffer of W, but right now it doesn't. */
6722 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6724 XSETFRAME (frame
, f
);
6725 XSETFASTINT (position
, pos
);
6728 if (pos
< region_beg
&& region_beg
< endpos
)
6729 endpos
= region_beg
;
6731 /* Get the `face' or `mouse_face' text property at POS, and
6732 determine the next position at which the property changes. */
6733 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6734 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6735 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6737 endpos
= XINT (end
);
6739 /* Look at properties from overlays. */
6744 /* First try with room for 40 overlays. */
6746 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6747 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6748 &next_overlay
, NULL
, 0);
6750 /* If there are more than 40, make enough space for all, and try
6752 if (noverlays
> len
)
6755 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6756 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6757 &next_overlay
, NULL
, 0);
6760 if (next_overlay
< endpos
)
6761 endpos
= next_overlay
;
6766 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6768 /* Optimize common cases where we can use the default face. */
6771 && !(pos
>= region_beg
&& pos
< region_end
))
6772 return DEFAULT_FACE_ID
;
6774 /* Begin with attributes from the default face. */
6775 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6777 /* Merge in attributes specified via text properties. */
6779 merge_face_vector_with_property (f
, attrs
, prop
);
6781 /* Now merge the overlay data. */
6782 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6783 for (i
= 0; i
< noverlays
; i
++)
6788 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6790 merge_face_vector_with_property (f
, attrs
, prop
);
6792 oend
= OVERLAY_END (overlay_vec
[i
]);
6793 oendpos
= OVERLAY_POSITION (oend
);
6794 if (oendpos
< endpos
)
6798 /* If in the region, merge in the region face. */
6799 if (pos
>= region_beg
&& pos
< region_end
)
6801 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6802 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6804 if (region_end
< endpos
)
6805 endpos
= region_end
;
6810 /* Look up a realized face with the given face attributes,
6811 or realize a new one for ASCII characters. */
6812 return lookup_face (f
, attrs
, 0, NULL
);
6816 /* Compute the face at character position POS in Lisp string STRING on
6817 window W, for ASCII characters.
6819 If STRING is an overlay string, it comes from position BUFPOS in
6820 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6821 not an overlay string. W must display the current buffer.
6822 REGION_BEG and REGION_END give the start and end positions of the
6823 region; both are -1 if no region is visible.
6825 BASE_FACE_ID is the id of a face to merge with. For strings coming
6826 from overlays or the `display' property it is the face at BUFPOS.
6828 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6830 Set *ENDPTR to the next position where to check for faces in
6831 STRING; -1 if the face is constant from POS to the end of the
6834 Value is the id of the face to use. The face returned is suitable
6835 for displaying ASCII characters. */
6838 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6839 region_end
, endptr
, base_face_id
, mouse_p
)
6843 int region_beg
, region_end
;
6845 enum face_id base_face_id
;
6848 Lisp_Object prop
, position
, end
, limit
;
6849 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6850 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6851 struct face
*base_face
;
6852 int multibyte_p
= STRING_MULTIBYTE (string
);
6853 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6855 /* Get the value of the face property at the current position within
6856 STRING. Value is nil if there is no face property. */
6857 XSETFASTINT (position
, pos
);
6858 prop
= Fget_text_property (position
, prop_name
, string
);
6860 /* Get the next position at which to check for faces. Value of end
6861 is nil if face is constant all the way to the end of the string.
6862 Otherwise it is a string position where to check faces next.
6863 Limit is the maximum position up to which to check for property
6864 changes in Fnext_single_property_change. Strings are usually
6865 short, so set the limit to the end of the string. */
6866 XSETFASTINT (limit
, XSTRING (string
)->size
);
6867 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6869 *endptr
= XFASTINT (end
);
6873 base_face
= FACE_FROM_ID (f
, base_face_id
);
6874 xassert (base_face
);
6876 /* Optimize the default case that there is no face property and we
6877 are not in the region. */
6879 && (base_face_id
!= DEFAULT_FACE_ID
6880 /* BUFPOS <= 0 means STRING is not an overlay string, so
6881 that the region doesn't have to be taken into account. */
6883 || bufpos
< region_beg
6884 || bufpos
>= region_end
)
6886 /* We can't realize faces for different charsets differently
6887 if we don't have fonts, so we can stop here if not working
6888 on a window-system frame. */
6889 || !FRAME_WINDOW_P (f
)
6890 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6891 return base_face
->id
;
6893 /* Begin with attributes from the base face. */
6894 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6896 /* Merge in attributes specified via text properties. */
6898 merge_face_vector_with_property (f
, attrs
, prop
);
6900 /* If in the region, merge in the region face. */
6902 && bufpos
>= region_beg
6903 && bufpos
< region_end
)
6905 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6906 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6909 /* Look up a realized face with the given face attributes,
6910 or realize a new one for ASCII characters. */
6911 return lookup_face (f
, attrs
, 0, NULL
);
6916 /***********************************************************************
6918 ***********************************************************************/
6922 /* Print the contents of the realized face FACE to stderr. */
6925 dump_realized_face (face
)
6928 fprintf (stderr
, "ID: %d\n", face
->id
);
6929 #ifdef HAVE_X_WINDOWS
6930 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6932 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6934 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6935 fprintf (stderr
, "background: 0x%lx (%s)\n",
6937 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6938 fprintf (stderr
, "font_name: %s (%s)\n",
6940 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6941 #ifdef HAVE_X_WINDOWS
6942 fprintf (stderr
, "font = %p\n", face
->font
);
6944 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6945 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6946 fprintf (stderr
, "underline: %d (%s)\n",
6948 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6949 fprintf (stderr
, "hash: %d\n", face
->hash
);
6950 fprintf (stderr
, "charset: %d\n", face
->charset
);
6954 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6962 fprintf (stderr
, "font selection order: ");
6963 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6964 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6965 fprintf (stderr
, "\n");
6967 fprintf (stderr
, "alternative fonts: ");
6968 debug_print (Vface_alternative_font_family_alist
);
6969 fprintf (stderr
, "\n");
6971 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6972 Fdump_face (make_number (i
));
6977 CHECK_NUMBER (n
, 0);
6978 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6980 error ("Not a valid face");
6981 dump_realized_face (face
);
6988 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6992 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6993 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6994 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6998 #endif /* GLYPH_DEBUG != 0 */
7002 /***********************************************************************
7004 ***********************************************************************/
7009 Qface
= intern ("face");
7011 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7012 staticpro (&Qbitmap_spec_p
);
7013 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7014 staticpro (&Qframe_update_face_colors
);
7016 /* Lisp face attribute keywords. */
7017 QCfamily
= intern (":family");
7018 staticpro (&QCfamily
);
7019 QCheight
= intern (":height");
7020 staticpro (&QCheight
);
7021 QCweight
= intern (":weight");
7022 staticpro (&QCweight
);
7023 QCslant
= intern (":slant");
7024 staticpro (&QCslant
);
7025 QCunderline
= intern (":underline");
7026 staticpro (&QCunderline
);
7027 QCinverse_video
= intern (":inverse-video");
7028 staticpro (&QCinverse_video
);
7029 QCreverse_video
= intern (":reverse-video");
7030 staticpro (&QCreverse_video
);
7031 QCforeground
= intern (":foreground");
7032 staticpro (&QCforeground
);
7033 QCbackground
= intern (":background");
7034 staticpro (&QCbackground
);
7035 QCstipple
= intern (":stipple");;
7036 staticpro (&QCstipple
);
7037 QCwidth
= intern (":width");
7038 staticpro (&QCwidth
);
7039 QCfont
= intern (":font");
7040 staticpro (&QCfont
);
7041 QCbold
= intern (":bold");
7042 staticpro (&QCbold
);
7043 QCitalic
= intern (":italic");
7044 staticpro (&QCitalic
);
7045 QCoverline
= intern (":overline");
7046 staticpro (&QCoverline
);
7047 QCstrike_through
= intern (":strike-through");
7048 staticpro (&QCstrike_through
);
7049 QCbox
= intern (":box");
7051 QCinherit
= intern (":inherit");
7052 staticpro (&QCinherit
);
7054 /* Symbols used for Lisp face attribute values. */
7055 QCcolor
= intern (":color");
7056 staticpro (&QCcolor
);
7057 QCline_width
= intern (":line-width");
7058 staticpro (&QCline_width
);
7059 QCstyle
= intern (":style");
7060 staticpro (&QCstyle
);
7061 Qreleased_button
= intern ("released-button");
7062 staticpro (&Qreleased_button
);
7063 Qpressed_button
= intern ("pressed-button");
7064 staticpro (&Qpressed_button
);
7065 Qnormal
= intern ("normal");
7066 staticpro (&Qnormal
);
7067 Qultra_light
= intern ("ultra-light");
7068 staticpro (&Qultra_light
);
7069 Qextra_light
= intern ("extra-light");
7070 staticpro (&Qextra_light
);
7071 Qlight
= intern ("light");
7072 staticpro (&Qlight
);
7073 Qsemi_light
= intern ("semi-light");
7074 staticpro (&Qsemi_light
);
7075 Qsemi_bold
= intern ("semi-bold");
7076 staticpro (&Qsemi_bold
);
7077 Qbold
= intern ("bold");
7079 Qextra_bold
= intern ("extra-bold");
7080 staticpro (&Qextra_bold
);
7081 Qultra_bold
= intern ("ultra-bold");
7082 staticpro (&Qultra_bold
);
7083 Qoblique
= intern ("oblique");
7084 staticpro (&Qoblique
);
7085 Qitalic
= intern ("italic");
7086 staticpro (&Qitalic
);
7087 Qreverse_oblique
= intern ("reverse-oblique");
7088 staticpro (&Qreverse_oblique
);
7089 Qreverse_italic
= intern ("reverse-italic");
7090 staticpro (&Qreverse_italic
);
7091 Qultra_condensed
= intern ("ultra-condensed");
7092 staticpro (&Qultra_condensed
);
7093 Qextra_condensed
= intern ("extra-condensed");
7094 staticpro (&Qextra_condensed
);
7095 Qcondensed
= intern ("condensed");
7096 staticpro (&Qcondensed
);
7097 Qsemi_condensed
= intern ("semi-condensed");
7098 staticpro (&Qsemi_condensed
);
7099 Qsemi_expanded
= intern ("semi-expanded");
7100 staticpro (&Qsemi_expanded
);
7101 Qexpanded
= intern ("expanded");
7102 staticpro (&Qexpanded
);
7103 Qextra_expanded
= intern ("extra-expanded");
7104 staticpro (&Qextra_expanded
);
7105 Qultra_expanded
= intern ("ultra-expanded");
7106 staticpro (&Qultra_expanded
);
7107 Qbackground_color
= intern ("background-color");
7108 staticpro (&Qbackground_color
);
7109 Qforeground_color
= intern ("foreground-color");
7110 staticpro (&Qforeground_color
);
7111 Qunspecified
= intern ("unspecified");
7112 staticpro (&Qunspecified
);
7114 Qface_alias
= intern ("face-alias");
7115 staticpro (&Qface_alias
);
7116 Qdefault
= intern ("default");
7117 staticpro (&Qdefault
);
7118 Qtool_bar
= intern ("tool-bar");
7119 staticpro (&Qtool_bar
);
7120 Qregion
= intern ("region");
7121 staticpro (&Qregion
);
7122 Qfringe
= intern ("fringe");
7123 staticpro (&Qfringe
);
7124 Qheader_line
= intern ("header-line");
7125 staticpro (&Qheader_line
);
7126 Qscroll_bar
= intern ("scroll-bar");
7127 staticpro (&Qscroll_bar
);
7128 Qmenu
= intern ("menu");
7130 Qcursor
= intern ("cursor");
7131 staticpro (&Qcursor
);
7132 Qborder
= intern ("border");
7133 staticpro (&Qborder
);
7134 Qmouse
= intern ("mouse");
7135 staticpro (&Qmouse
);
7136 Qtty_color_desc
= intern ("tty-color-desc");
7137 staticpro (&Qtty_color_desc
);
7138 Qtty_color_by_index
= intern ("tty-color-by-index");
7139 staticpro (&Qtty_color_by_index
);
7140 Qtty_color_alist
= intern ("tty-color-alist");
7141 staticpro (&Qtty_color_alist
);
7142 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7143 staticpro (&Qscalable_fonts_allowed
);
7145 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7146 staticpro (&Vparam_value_alist
);
7147 Vface_alternative_font_family_alist
= Qnil
;
7148 staticpro (&Vface_alternative_font_family_alist
);
7149 Vface_alternative_font_registry_alist
= Qnil
;
7150 staticpro (&Vface_alternative_font_registry_alist
);
7152 defsubr (&Sinternal_make_lisp_face
);
7153 defsubr (&Sinternal_lisp_face_p
);
7154 defsubr (&Sinternal_set_lisp_face_attribute
);
7155 #ifdef HAVE_WINDOW_SYSTEM
7156 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7158 defsubr (&Scolor_gray_p
);
7159 defsubr (&Scolor_supported_p
);
7160 defsubr (&Sinternal_get_lisp_face_attribute
);
7161 defsubr (&Sinternal_lisp_face_attribute_values
);
7162 defsubr (&Sinternal_lisp_face_equal_p
);
7163 defsubr (&Sinternal_lisp_face_empty_p
);
7164 defsubr (&Sinternal_copy_lisp_face
);
7165 defsubr (&Sinternal_merge_in_global_face
);
7166 defsubr (&Sface_font
);
7167 defsubr (&Sframe_face_alist
);
7168 defsubr (&Sinternal_set_font_selection_order
);
7169 defsubr (&Sinternal_set_alternative_font_family_alist
);
7170 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7172 defsubr (&Sdump_face
);
7173 defsubr (&Sshow_face_resources
);
7174 #endif /* GLYPH_DEBUG */
7175 defsubr (&Sclear_face_cache
);
7176 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7178 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7179 defsubr (&Sdump_colors
);
7182 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7183 "*Limit for font matching.\n\
7184 If an integer > 0, font matching functions won't load more than\n\
7185 that number of fonts when searching for a matching font.");
7186 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7188 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7189 "List of global face definitions (for internal use only.)");
7190 Vface_new_frame_defaults
= Qnil
;
7192 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7193 "*Default stipple pattern used on monochrome displays.\n\
7194 This stipple pattern is used on monochrome displays\n\
7195 instead of shades of gray for a face background color.\n\
7196 See `set-face-stipple' for possible values for this variable.");
7197 Vface_default_stipple
= build_string ("gray3");
7199 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7200 "An alist of defined terminal colors and their RGB values.");
7201 Vtty_defined_color_alist
= Qnil
;
7203 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7204 "Allowed scalable fonts.\n\
7205 A value of nil means don't allow any scalable fonts.\n\
7206 A value of t means allow any scalable font.\n\
7207 Otherwise, value must be a list of regular expressions. A font may be\n\
7208 scaled if its name matches a regular expression in the list.\n\
7209 Note that if value is nil, a scalable font might still be used, if no\n\
7210 other font of the appropriate family and registry is available.");
7211 Vscalable_fonts_allowed
= Qnil
;
7213 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7214 "List of ignored fonts.\n\
7215 Each element is a regular expression that matches names of fonts to ignore.");
7216 Vface_ignored_fonts
= Qnil
;
7218 #ifdef HAVE_WINDOW_SYSTEM
7219 defsubr (&Sbitmap_spec_p
);
7220 defsubr (&Sx_list_fonts
);
7221 defsubr (&Sinternal_face_x_get_resource
);
7222 defsubr (&Sx_family_fonts
);
7223 defsubr (&Sx_font_family_list
);
7224 #endif /* HAVE_WINDOW_SYSTEM */