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>
200 #include "keyboard.h"
203 #ifdef HAVE_WINDOW_SYSTEM
205 #endif /* HAVE_WINDOW_SYSTEM */
207 #ifdef HAVE_X_WINDOWS
211 #include <Xm/XmStrDefs.h>
212 #endif /* USE_MOTIF */
213 #endif /* HAVE_X_WINDOWS */
222 /* Redefine X specifics to W32 equivalents to avoid cluttering the
223 code with #ifdef blocks. */
224 #undef FRAME_X_DISPLAY_INFO
225 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
226 #define x_display_info w32_display_info
227 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
228 #define check_x check_w32
229 #define x_list_fonts w32_list_fonts
230 #define GCGraphicsExposures 0
231 /* For historic reasons, FONT_WIDTH refers to average width on W32,
232 not maximum as on X. Redefine here. */
234 #define FONT_WIDTH FONT_MAX_WIDTH
235 #endif /* WINDOWSNT */
239 #define x_display_info mac_display_info
240 #define check_x check_mac
242 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
245 x_create_gc (f
, mask
, xgcv
)
251 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
260 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
265 #include "dispextern.h"
266 #include "blockinput.h"
268 #include "intervals.h"
270 #ifdef HAVE_X_WINDOWS
272 /* Compensate for a bug in Xos.h on some systems, on which it requires
273 time.h. On some such systems, Xos.h tries to redefine struct
274 timeval and struct timezone if USG is #defined while it is
277 #ifdef XOS_NEEDS_TIME_H
283 #else /* not XOS_NEEDS_TIME_H */
285 #endif /* not XOS_NEEDS_TIME_H */
287 #endif /* HAVE_X_WINDOWS */
292 #define abs(X) ((X) < 0 ? -(X) : (X))
294 /* Number of pt per inch (from the TeXbook). */
296 #define PT_PER_INCH 72.27
298 /* Non-zero if face attribute ATTR is unspecified. */
300 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
302 /* Value is the number of elements of VECTOR. */
304 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
306 /* Make a copy of string S on the stack using alloca. Value is a pointer
309 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
311 /* Make a copy of the contents of Lisp string S on the stack using
312 alloca. Value is a pointer to the copy. */
314 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
316 /* Size of hash table of realized faces in face caches (should be a
319 #define FACE_CACHE_BUCKETS_SIZE 1001
321 /* A definition of XColor for non-X frames. */
323 #ifndef HAVE_X_WINDOWS
328 unsigned short red
, green
, blue
;
334 #endif /* not HAVE_X_WINDOWS */
336 /* Keyword symbols used for face attribute names. */
338 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
339 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
340 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
341 Lisp_Object QCreverse_video
;
342 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
344 /* Symbols used for attribute values. */
346 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
347 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
348 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
349 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
350 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
351 Lisp_Object Qultra_expanded
;
352 Lisp_Object Qreleased_button
, Qpressed_button
;
353 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
354 Lisp_Object Qunspecified
;
356 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
358 /* The name of the function to call when the background of the frame
359 has changed, frame_update_face_colors. */
361 Lisp_Object Qframe_update_face_colors
;
363 /* Names of basic faces. */
365 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
366 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
367 extern Lisp_Object Qmode_line
;
369 /* The symbol `face-alias'. A symbols having that property is an
370 alias for another face. Value of the property is the name of
373 Lisp_Object Qface_alias
;
375 /* Names of frame parameters related to faces. */
377 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
378 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
380 /* Default stipple pattern used on monochrome displays. This stipple
381 pattern is used on monochrome displays instead of shades of gray
382 for a face background color. See `set-face-stipple' for possible
383 values for this variable. */
385 Lisp_Object Vface_default_stipple
;
387 /* Alist of alternative font families. Each element is of the form
388 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
389 try FAMILY1, then FAMILY2, ... */
391 Lisp_Object Vface_alternative_font_family_alist
;
393 /* Alist of alternative font registries. Each element is of the form
394 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
395 loaded, try REGISTRY1, then REGISTRY2, ... */
397 Lisp_Object Vface_alternative_font_registry_alist
;
399 /* Allowed scalable fonts. A value of nil means don't allow any
400 scalable fonts. A value of t means allow the use of any scalable
401 font. Otherwise, value must be a list of regular expressions. A
402 font may be scaled if its name matches a regular expression in the
405 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
407 /* List of regular expressions that matches names of fonts to ignore. */
409 Lisp_Object Vface_ignored_fonts
;
411 /* Maximum number of fonts to consider in font_list. If not an
412 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
414 Lisp_Object Vfont_list_limit
;
415 #define DEFAULT_FONT_LIST_LIMIT 100
417 /* The symbols `foreground-color' and `background-color' which can be
418 used as part of a `face' property. This is for compatibility with
421 Lisp_Object Qforeground_color
, Qbackground_color
;
423 /* The symbols `face' and `mouse-face' used as text properties. */
426 extern Lisp_Object Qmouse_face
;
428 /* Error symbol for wrong_type_argument in load_pixmap. */
430 Lisp_Object Qbitmap_spec_p
;
432 /* Alist of global face definitions. Each element is of the form
433 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
434 is a Lisp vector of face attributes. These faces are used
435 to initialize faces for new frames. */
437 Lisp_Object Vface_new_frame_defaults
;
439 /* The next ID to assign to Lisp faces. */
441 static int next_lface_id
;
443 /* A vector mapping Lisp face Id's to face names. */
445 static Lisp_Object
*lface_id_to_name
;
446 static int lface_id_to_name_size
;
448 /* TTY color-related functions (defined in tty-colors.el). */
450 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
452 /* The name of the function used to compute colors on TTYs. */
454 Lisp_Object Qtty_color_alist
;
456 /* An alist of defined terminal colors and their RGB values. */
458 Lisp_Object Vtty_defined_color_alist
;
460 /* Counter for calls to clear_face_cache. If this counter reaches
461 CLEAR_FONT_TABLE_COUNT, and a frame has more than
462 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
464 static int clear_font_table_count
;
465 #define CLEAR_FONT_TABLE_COUNT 100
466 #define CLEAR_FONT_TABLE_NFONTS 10
468 /* Non-zero means face attributes have been changed since the last
469 redisplay. Used in redisplay_internal. */
471 int face_change_count
;
473 /* Non-zero means don't display bold text if a face's foreground
474 and background colors are the inverse of the default colors of the
475 display. This is a kluge to suppress `bold black' foreground text
476 which is hard to read on an LCD monitor. */
478 int tty_suppress_bold_inverse_default_colors_p
;
480 /* A list of the form `((x . y))' used to avoid consing in
481 Finternal_set_lisp_face_attribute. */
483 static Lisp_Object Vparam_value_alist
;
485 /* The total number of colors currently allocated. */
488 static int ncolors_allocated
;
489 static int npixmaps_allocated
;
493 /* Non-zero means the definition of the `menu' face for new frames has
496 int menu_face_changed_default
;
499 /* Function prototypes. */
504 static void map_tty_color
P_ ((struct frame
*, struct face
*,
505 enum lface_attribute_index
, int *));
506 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
507 static int may_use_scalable_font_p
P_ ((char *));
508 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
509 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
511 static int x_face_list_fonts
P_ ((struct frame
*, char *,
512 struct font_name
*, int, int));
513 static int font_scalable_p
P_ ((struct font_name
*));
514 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
515 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
516 static unsigned char *xstrlwr
P_ ((unsigned char *));
517 static void signal_error
P_ ((char *, Lisp_Object
));
518 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
519 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
520 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
521 static void free_face_colors
P_ ((struct frame
*, struct face
*));
522 static int face_color_gray_p
P_ ((struct frame
*, char *));
523 static char *build_font_name
P_ ((struct font_name
*));
524 static void free_font_names
P_ ((struct font_name
*, int));
525 static int sorted_font_list
P_ ((struct frame
*, char *,
526 int (*cmpfn
) P_ ((const void *, const void *)),
527 struct font_name
**));
528 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
529 Lisp_Object
, struct font_name
**));
530 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
531 Lisp_Object
, struct font_name
**));
532 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
533 Lisp_Object
, Lisp_Object
, struct font_name
**));
534 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
535 Lisp_Object
, struct font_name
**));
536 static int cmp_font_names
P_ ((const void *, const void *));
537 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
538 struct face
*, int));
539 static struct face
*realize_x_face
P_ ((struct face_cache
*,
540 Lisp_Object
*, int, struct face
*));
541 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
542 Lisp_Object
*, int));
543 static int realize_basic_faces
P_ ((struct frame
*));
544 static int realize_default_face
P_ ((struct frame
*));
545 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
546 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
547 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
548 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
549 static unsigned lface_hash
P_ ((Lisp_Object
*));
550 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
551 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
552 static void free_realized_face
P_ ((struct frame
*, struct face
*));
553 static void clear_face_gcs
P_ ((struct face_cache
*));
554 static void free_face_cache
P_ ((struct face_cache
*));
555 static int face_numeric_weight
P_ ((Lisp_Object
));
556 static int face_numeric_slant
P_ ((Lisp_Object
));
557 static int face_numeric_swidth
P_ ((Lisp_Object
));
558 static int face_fontset
P_ ((Lisp_Object
*));
559 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
560 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
561 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
562 Lisp_Object
*, Lisp_Object
));
563 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
565 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
566 Lisp_Object
, int, int));
567 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
568 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
569 static void free_realized_faces
P_ ((struct face_cache
*));
570 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
571 struct font_name
*, int, int));
572 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
573 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
574 static int xlfd_numeric_slant
P_ ((struct font_name
*));
575 static int xlfd_numeric_weight
P_ ((struct font_name
*));
576 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
577 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
578 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
579 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
580 static int xlfd_fixed_p
P_ ((struct font_name
*));
581 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
583 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
584 struct font_name
*, int,
586 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
587 struct font_name
*, int));
589 #ifdef HAVE_WINDOW_SYSTEM
591 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
592 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
593 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
594 int (*cmpfn
) P_ ((const void *, const void *))));
595 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
596 static void x_free_gc
P_ ((struct frame
*, GC
));
597 static void clear_font_table
P_ ((struct x_display_info
*));
600 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
601 #endif /* WINDOWSNT */
604 static void x_update_menu_appearance
P_ ((struct frame
*));
606 extern void free_frame_menubar
P_ ((struct frame
*));
607 #endif /* USE_X_TOOLKIT */
609 #endif /* HAVE_WINDOW_SYSTEM */
612 /***********************************************************************
614 ***********************************************************************/
616 #ifdef HAVE_X_WINDOWS
618 #ifdef DEBUG_X_COLORS
620 /* The following is a poor mans infrastructure for debugging X color
621 allocation problems on displays with PseudoColor-8. Some X servers
622 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
623 color reference counts completely so that they don't signal an
624 error when a color is freed whose reference count is already 0.
625 Other X servers do. To help me debug this, the following code
626 implements a simple reference counting schema of its own, for a
627 single display/screen. --gerd. */
629 /* Reference counts for pixel colors. */
631 int color_count
[256];
633 /* Register color PIXEL as allocated. */
636 register_color (pixel
)
639 xassert (pixel
< 256);
640 ++color_count
[pixel
];
644 /* Register color PIXEL as deallocated. */
647 unregister_color (pixel
)
650 xassert (pixel
< 256);
651 if (color_count
[pixel
] > 0)
652 --color_count
[pixel
];
658 /* Register N colors from PIXELS as deallocated. */
661 unregister_colors (pixels
, n
)
662 unsigned long *pixels
;
666 for (i
= 0; i
< n
; ++i
)
667 unregister_color (pixels
[i
]);
671 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
672 doc
: /* Dump currently allocated colors to stderr. */)
677 fputc ('\n', stderr
);
679 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
682 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
685 fputc ('\n', stderr
);
687 fputc ('\t', stderr
);
691 fputc ('\n', stderr
);
695 #endif /* DEBUG_X_COLORS */
698 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
699 color values. Interrupt input must be blocked when this function
703 x_free_colors (f
, pixels
, npixels
)
705 unsigned long *pixels
;
708 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
710 /* If display has an immutable color map, freeing colors is not
711 necessary and some servers don't allow it. So don't do it. */
712 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
714 #ifdef DEBUG_X_COLORS
715 unregister_colors (pixels
, npixels
);
717 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
723 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
724 color values. Interrupt input must be blocked when this function
728 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
732 unsigned long *pixels
;
735 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
736 int class = dpyinfo
->visual
->class;
738 /* If display has an immutable color map, freeing colors is not
739 necessary and some servers don't allow it. So don't do it. */
740 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
742 #ifdef DEBUG_X_COLORS
743 unregister_colors (pixels
, npixels
);
745 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
750 /* Create and return a GC for use on frame F. GC values and mask
751 are given by XGCV and MASK. */
754 x_create_gc (f
, mask
, xgcv
)
761 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
768 /* Free GC which was used on frame F. */
776 xassert (--ngcs
>= 0);
777 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
781 #endif /* HAVE_X_WINDOWS */
784 /* W32 emulation of GCs */
787 x_create_gc (f
, mask
, xgcv
)
794 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
801 /* Free GC which was used on frame F. */
809 xassert (--ngcs
>= 0);
814 #endif /* WINDOWSNT */
816 /* Like stricmp. Used to compare parts of font names which are in
821 unsigned char *s1
, *s2
;
825 unsigned char c1
= tolower (*s1
);
826 unsigned char c2
= tolower (*s2
);
828 return c1
< c2
? -1 : 1;
833 return *s2
== 0 ? 0 : -1;
838 /* Like strlwr, which might not always be available. */
840 static unsigned char *
844 unsigned char *p
= s
;
853 /* Signal `error' with message S, and additional argument ARG. */
856 signal_error (s
, arg
)
860 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
864 /* If FRAME is nil, return a pointer to the selected frame.
865 Otherwise, check that FRAME is a live frame, and return a pointer
866 to it. NPARAM is the parameter number of FRAME, for
867 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
868 Lisp function definitions. */
870 static INLINE
struct frame
*
871 frame_or_selected_frame (frame
, nparam
)
876 frame
= selected_frame
;
878 CHECK_LIVE_FRAME (frame
, nparam
);
879 return XFRAME (frame
);
883 /***********************************************************************
885 ***********************************************************************/
887 /* Initialize face cache and basic faces for frame F. */
893 /* Make a face cache, if F doesn't have one. */
894 if (FRAME_FACE_CACHE (f
) == NULL
)
895 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
897 #ifdef HAVE_WINDOW_SYSTEM
898 /* Make the image cache. */
899 if (FRAME_WINDOW_P (f
))
901 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
902 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
903 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
905 #endif /* HAVE_WINDOW_SYSTEM */
907 /* Realize basic faces. Must have enough information in frame
908 parameters to realize basic faces at this point. */
909 #ifdef HAVE_X_WINDOWS
910 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
913 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
915 if (!realize_basic_faces (f
))
920 /* Free face cache of frame F. Called from Fdelete_frame. */
926 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
930 free_face_cache (face_cache
);
931 FRAME_FACE_CACHE (f
) = NULL
;
934 #ifdef HAVE_WINDOW_SYSTEM
935 if (FRAME_WINDOW_P (f
))
937 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
940 --image_cache
->refcount
;
941 if (image_cache
->refcount
== 0)
942 free_image_cache (f
);
945 #endif /* HAVE_WINDOW_SYSTEM */
949 /* Clear face caches, and recompute basic faces for frame F. Call
950 this after changing frame parameters on which those faces depend,
951 or when realized faces have been freed due to changing attributes
955 recompute_basic_faces (f
)
958 if (FRAME_FACE_CACHE (f
))
960 clear_face_cache (0);
961 if (!realize_basic_faces (f
))
967 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
968 try to free unused fonts, too. */
971 clear_face_cache (clear_fonts_p
)
974 #ifdef HAVE_WINDOW_SYSTEM
975 Lisp_Object tail
, frame
;
979 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
981 struct x_display_info
*dpyinfo
;
983 /* Fonts are common for frames on one display, i.e. on
985 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
986 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
987 clear_font_table (dpyinfo
);
989 /* From time to time see if we can unload some fonts. This also
990 frees all realized faces on all frames. Fonts needed by
991 faces will be loaded again when faces are realized again. */
992 clear_font_table_count
= 0;
994 FOR_EACH_FRAME (tail
, frame
)
996 struct frame
*f
= XFRAME (frame
);
997 if (FRAME_WINDOW_P (f
)
998 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
999 free_all_realized_faces (frame
);
1004 /* Clear GCs of realized faces. */
1005 FOR_EACH_FRAME (tail
, frame
)
1008 if (FRAME_WINDOW_P (f
))
1010 clear_face_gcs (FRAME_FACE_CACHE (f
));
1011 clear_image_cache (f
, 0);
1015 #endif /* HAVE_WINDOW_SYSTEM */
1019 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1020 doc
: /* Clear face caches on all frames.
1021 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1023 Lisp_Object thoroughly
;
1025 clear_face_cache (!NILP (thoroughly
));
1026 ++face_change_count
;
1027 ++windows_or_buffers_changed
;
1033 #ifdef HAVE_WINDOW_SYSTEM
1036 /* Remove fonts from the font table of DPYINFO except for the default
1037 ASCII fonts of frames on that display. Called from clear_face_cache
1038 from time to time. */
1041 clear_font_table (dpyinfo
)
1042 struct x_display_info
*dpyinfo
;
1046 /* Free those fonts that are not used by frames on DPYINFO. */
1047 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1049 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1050 Lisp_Object tail
, frame
;
1052 /* Check if slot is already free. */
1053 if (font_info
->name
== NULL
)
1056 /* Don't free a default font of some frame on this display. */
1057 FOR_EACH_FRAME (tail
, frame
)
1059 struct frame
*f
= XFRAME (frame
);
1060 if (FRAME_WINDOW_P (f
)
1061 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1062 && font_info
->font
== FRAME_FONT (f
))
1070 if (font_info
->full_name
!= font_info
->name
)
1071 xfree (font_info
->full_name
);
1072 xfree (font_info
->name
);
1074 /* Free the font. */
1076 #ifdef HAVE_X_WINDOWS
1077 XFreeFont (dpyinfo
->display
, font_info
->font
);
1080 w32_unload_font (dpyinfo
, font_info
->font
);
1084 /* Mark font table slot free. */
1085 font_info
->font
= NULL
;
1086 font_info
->name
= font_info
->full_name
= NULL
;
1090 #endif /* HAVE_WINDOW_SYSTEM */
1094 /***********************************************************************
1096 ***********************************************************************/
1098 #ifdef HAVE_WINDOW_SYSTEM
1100 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1101 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1102 A bitmap specification is either a string, a file name, or a list
1103 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1104 HEIGHT is its height, and DATA is a string containing the bits of
1105 the pixmap. Bits are stored row by row, each row occupies
1106 \(WIDTH + 7)/8 bytes. */)
1112 if (STRINGP (object
))
1113 /* If OBJECT is a string, it's a file name. */
1115 else if (CONSP (object
))
1117 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1118 HEIGHT must be integers > 0, and DATA must be string large
1119 enough to hold a bitmap of the specified size. */
1120 Lisp_Object width
, height
, data
;
1122 height
= width
= data
= Qnil
;
1126 width
= XCAR (object
);
1127 object
= XCDR (object
);
1130 height
= XCAR (object
);
1131 object
= XCDR (object
);
1133 data
= XCAR (object
);
1137 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1139 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1141 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1146 return pixmap_p
? Qt
: Qnil
;
1150 /* Load a bitmap according to NAME (which is either a file name or a
1151 pixmap spec) for use on frame F. Value is the bitmap_id (see
1152 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1153 bitmap cannot be loaded, display a message saying so, and return
1154 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1155 if these pointers are not null. */
1158 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1161 unsigned int *w_ptr
, *h_ptr
;
1169 tem
= Fbitmap_spec_p (name
);
1171 wrong_type_argument (Qbitmap_spec_p
, name
);
1176 /* Decode a bitmap spec into a bitmap. */
1181 w
= XINT (Fcar (name
));
1182 h
= XINT (Fcar (Fcdr (name
)));
1183 bits
= Fcar (Fcdr (Fcdr (name
)));
1185 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1190 /* It must be a string -- a file name. */
1191 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1197 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1208 ++npixmaps_allocated
;
1211 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1214 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1220 #endif /* HAVE_WINDOW_SYSTEM */
1224 /***********************************************************************
1226 ***********************************************************************/
1228 #ifdef HAVE_WINDOW_SYSTEM
1230 /* Update the line_height of frame F. Return non-zero if line height
1234 frame_update_line_height (f
)
1237 int line_height
, changed_p
;
1239 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1240 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1241 FRAME_LINE_HEIGHT (f
) = line_height
;
1245 #endif /* HAVE_WINDOW_SYSTEM */
1248 /***********************************************************************
1250 ***********************************************************************/
1252 #ifdef HAVE_WINDOW_SYSTEM
1254 /* Load font of face FACE which is used on frame F to display
1255 character C. The name of the font to load is determined by lface
1256 and fontset of FACE. */
1259 load_face_font (f
, face
, c
)
1264 struct font_info
*font_info
= NULL
;
1267 face
->font_info_id
= -1;
1270 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1275 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1280 face
->font_info_id
= font_info
->font_idx
;
1281 face
->font
= font_info
->font
;
1282 face
->font_name
= font_info
->full_name
;
1285 x_free_gc (f
, face
->gc
);
1290 add_to_log ("Unable to load font %s",
1291 build_string (font_name
), Qnil
);
1295 #endif /* HAVE_WINDOW_SYSTEM */
1299 /***********************************************************************
1301 ***********************************************************************/
1303 /* A version of defined_color for non-X frames. */
1306 tty_defined_color (f
, color_name
, color_def
, alloc
)
1312 Lisp_Object color_desc
;
1313 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1314 unsigned long red
= 0, green
= 0, blue
= 0;
1317 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1321 XSETFRAME (frame
, f
);
1323 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1324 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1326 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1327 if (CONSP (XCDR (XCDR (color_desc
))))
1329 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1330 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1331 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1335 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1336 /* We were called early during startup, and the colors are not
1337 yet set up in tty-defined-color-alist. Don't return a failure
1338 indication, since this produces the annoying "Unable to
1339 load color" messages in the *Messages* buffer. */
1342 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1344 if (strcmp (color_name
, "unspecified-fg") == 0)
1345 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1346 else if (strcmp (color_name
, "unspecified-bg") == 0)
1347 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1350 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1353 color_def
->pixel
= color_idx
;
1354 color_def
->red
= red
;
1355 color_def
->green
= green
;
1356 color_def
->blue
= blue
;
1362 /* Decide if color named COLOR_NAME is valid for the display
1363 associated with the frame F; if so, return the rgb values in
1364 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1366 This does the right thing for any type of frame. */
1369 defined_color (f
, color_name
, color_def
, alloc
)
1375 if (!FRAME_WINDOW_P (f
))
1376 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1377 #ifdef HAVE_X_WINDOWS
1378 else if (FRAME_X_P (f
))
1379 return x_defined_color (f
, color_name
, color_def
, alloc
);
1382 else if (FRAME_W32_P (f
))
1383 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1386 else if (FRAME_MAC_P (f
))
1387 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1394 /* Given the index IDX of a tty color on frame F, return its name, a
1398 tty_color_name (f
, idx
)
1402 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1405 Lisp_Object coldesc
;
1407 XSETFRAME (frame
, f
);
1408 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1410 if (!NILP (coldesc
))
1411 return XCAR (coldesc
);
1414 /* We can have an MSDOG frame under -nw for a short window of
1415 opportunity before internal_terminal_init is called. DTRT. */
1416 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1417 return msdos_stdcolor_name (idx
);
1420 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1421 return build_string (unspecified_fg
);
1422 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1423 return build_string (unspecified_bg
);
1426 return vga_stdcolor_name (idx
);
1429 return Qunspecified
;
1433 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1434 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1437 face_color_gray_p (f
, color_name
)
1444 if (defined_color (f
, color_name
, &color
, 0))
1445 gray_p
= ((abs (color
.red
- color
.green
)
1446 < max (color
.red
, color
.green
) / 20)
1447 && (abs (color
.green
- color
.blue
)
1448 < max (color
.green
, color
.blue
) / 20)
1449 && (abs (color
.blue
- color
.red
)
1450 < max (color
.blue
, color
.red
) / 20));
1458 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1459 BACKGROUND_P non-zero means the color will be used as background
1463 face_color_supported_p (f
, color_name
, background_p
)
1471 XSETFRAME (frame
, f
);
1472 return (FRAME_WINDOW_P (f
)
1473 ? (!NILP (Fxw_display_color_p (frame
))
1474 || xstricmp (color_name
, "black") == 0
1475 || xstricmp (color_name
, "white") == 0
1477 && face_color_gray_p (f
, color_name
))
1478 || (!NILP (Fx_display_grayscale_p (frame
))
1479 && face_color_gray_p (f
, color_name
)))
1480 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1484 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1485 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1486 FRAME specifies the frame and thus the display for interpreting COLOR.
1487 If FRAME is nil or omitted, use the selected frame. */)
1489 Lisp_Object color
, frame
;
1493 CHECK_FRAME (frame
, 0);
1494 CHECK_STRING (color
, 0);
1496 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1500 DEFUN ("color-supported-p", Fcolor_supported_p
,
1501 Scolor_supported_p
, 2, 3, 0,
1502 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1503 BACKGROUND-P non-nil means COLOR is used as a background.
1504 If FRAME is nil or omitted, use the selected frame.
1505 COLOR must be a valid color name. */)
1506 (color
, frame
, background_p
)
1507 Lisp_Object frame
, color
, background_p
;
1511 CHECK_FRAME (frame
, 0);
1512 CHECK_STRING (color
, 0);
1514 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1520 /* Load color with name NAME for use by face FACE on frame F.
1521 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1522 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1523 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1524 pixel color. If color cannot be loaded, display a message, and
1525 return the foreground, background or underline color of F, but
1526 record that fact in flags of the face so that we don't try to free
1530 load_color (f
, face
, name
, target_index
)
1534 enum lface_attribute_index target_index
;
1538 xassert (STRINGP (name
));
1539 xassert (target_index
== LFACE_FOREGROUND_INDEX
1540 || target_index
== LFACE_BACKGROUND_INDEX
1541 || target_index
== LFACE_UNDERLINE_INDEX
1542 || target_index
== LFACE_OVERLINE_INDEX
1543 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1544 || target_index
== LFACE_BOX_INDEX
);
1546 /* if the color map is full, defined_color will return a best match
1547 to the values in an existing cell. */
1548 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1550 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1552 switch (target_index
)
1554 case LFACE_FOREGROUND_INDEX
:
1555 face
->foreground_defaulted_p
= 1;
1556 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1559 case LFACE_BACKGROUND_INDEX
:
1560 face
->background_defaulted_p
= 1;
1561 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1564 case LFACE_UNDERLINE_INDEX
:
1565 face
->underline_defaulted_p
= 1;
1566 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1569 case LFACE_OVERLINE_INDEX
:
1570 face
->overline_color_defaulted_p
= 1;
1571 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1574 case LFACE_STRIKE_THROUGH_INDEX
:
1575 face
->strike_through_color_defaulted_p
= 1;
1576 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1579 case LFACE_BOX_INDEX
:
1580 face
->box_color_defaulted_p
= 1;
1581 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1590 ++ncolors_allocated
;
1597 #ifdef HAVE_WINDOW_SYSTEM
1599 /* Load colors for face FACE which is used on frame F. Colors are
1600 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1601 of ATTRS. If the background color specified is not supported on F,
1602 try to emulate gray colors with a stipple from Vface_default_stipple. */
1605 load_face_colors (f
, face
, attrs
)
1612 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1613 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1615 /* Swap colors if face is inverse-video. */
1616 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1624 /* Check for support for foreground, not for background because
1625 face_color_supported_p is smart enough to know that grays are
1626 "supported" as background because we are supposed to use stipple
1628 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1629 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1631 x_destroy_bitmap (f
, face
->stipple
);
1632 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1633 &face
->pixmap_w
, &face
->pixmap_h
);
1636 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1637 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1641 /* Free color PIXEL on frame F. */
1644 unload_color (f
, pixel
)
1646 unsigned long pixel
;
1648 #ifdef HAVE_X_WINDOWS
1652 x_free_colors (f
, &pixel
, 1);
1659 /* Free colors allocated for FACE. */
1662 free_face_colors (f
, face
)
1666 #ifdef HAVE_X_WINDOWS
1669 if (!face
->foreground_defaulted_p
)
1671 x_free_colors (f
, &face
->foreground
, 1);
1672 IF_DEBUG (--ncolors_allocated
);
1675 if (!face
->background_defaulted_p
)
1677 x_free_colors (f
, &face
->background
, 1);
1678 IF_DEBUG (--ncolors_allocated
);
1681 if (face
->underline_p
1682 && !face
->underline_defaulted_p
)
1684 x_free_colors (f
, &face
->underline_color
, 1);
1685 IF_DEBUG (--ncolors_allocated
);
1688 if (face
->overline_p
1689 && !face
->overline_color_defaulted_p
)
1691 x_free_colors (f
, &face
->overline_color
, 1);
1692 IF_DEBUG (--ncolors_allocated
);
1695 if (face
->strike_through_p
1696 && !face
->strike_through_color_defaulted_p
)
1698 x_free_colors (f
, &face
->strike_through_color
, 1);
1699 IF_DEBUG (--ncolors_allocated
);
1702 if (face
->box
!= FACE_NO_BOX
1703 && !face
->box_color_defaulted_p
)
1705 x_free_colors (f
, &face
->box_color
, 1);
1706 IF_DEBUG (--ncolors_allocated
);
1710 #endif /* HAVE_X_WINDOWS */
1713 #endif /* HAVE_WINDOW_SYSTEM */
1717 /***********************************************************************
1719 ***********************************************************************/
1721 /* An enumerator for each field of an XLFD font name. */
1742 /* An enumerator for each possible slant value of a font. Taken from
1743 the XLFD specification. */
1751 XLFD_SLANT_REVERSE_ITALIC
,
1752 XLFD_SLANT_REVERSE_OBLIQUE
,
1756 /* Relative font weight according to XLFD documentation. */
1760 XLFD_WEIGHT_UNKNOWN
,
1761 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1762 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1763 XLFD_WEIGHT_LIGHT
, /* 30 */
1764 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1765 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1766 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1767 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1768 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1769 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1772 /* Relative proportionate width. */
1776 XLFD_SWIDTH_UNKNOWN
,
1777 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1778 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1779 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1780 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1781 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1782 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1783 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1784 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1785 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1788 /* Structure used for tables mapping XLFD weight, slant, and width
1789 names to numeric and symbolic values. */
1795 Lisp_Object
*symbol
;
1798 /* Table of XLFD slant names and their numeric and symbolic
1799 representations. This table must be sorted by slant names in
1802 static struct table_entry slant_table
[] =
1804 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1805 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1806 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1807 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1808 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1809 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1812 /* Table of XLFD weight names. This table must be sorted by weight
1813 names in ascending order. */
1815 static struct table_entry weight_table
[] =
1817 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1818 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1819 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1820 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1821 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1822 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1823 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1824 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1825 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1826 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1827 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1828 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1829 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1830 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1831 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1832 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1835 /* Table of XLFD width names. This table must be sorted by width
1836 names in ascending order. */
1838 static struct table_entry swidth_table
[] =
1840 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1841 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1842 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1843 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1844 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1845 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1846 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1847 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1848 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1849 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1850 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1851 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1852 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1853 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1854 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1857 /* Structure used to hold the result of splitting font names in XLFD
1858 format into their fields. */
1862 /* The original name which is modified destructively by
1863 split_font_name. The pointer is kept here to be able to free it
1864 if it was allocated from the heap. */
1867 /* Font name fields. Each vector element points into `name' above.
1868 Fields are NUL-terminated. */
1869 char *fields
[XLFD_LAST
];
1871 /* Numeric values for those fields that interest us. See
1872 split_font_name for which these are. */
1873 int numeric
[XLFD_LAST
];
1875 /* Lower value mean higher priority. */
1876 int registry_priority
;
1879 /* The frame in effect when sorting font names. Set temporarily in
1880 sort_fonts so that it is available in font comparison functions. */
1882 static struct frame
*font_frame
;
1884 /* Order by which font selection chooses fonts. The default values
1885 mean `first, find a best match for the font width, then for the
1886 font height, then for weight, then for slant.' This variable can be
1887 set via set-face-font-sort-order. */
1890 static int font_sort_order
[4] = {
1891 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1894 static int font_sort_order
[4];
1897 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1898 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1899 is a pointer to the matching table entry or null if no table entry
1902 static struct table_entry
*
1903 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1904 struct table_entry
*table
;
1906 struct font_name
*font
;
1909 /* Function split_font_name converts fields to lower-case, so there
1910 is no need to use xstrlwr or xstricmp here. */
1911 char *s
= font
->fields
[field_index
];
1912 int low
, mid
, high
, cmp
;
1919 mid
= (low
+ high
) / 2;
1920 cmp
= strcmp (table
[mid
].name
, s
);
1934 /* Return a numeric representation for font name field
1935 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1936 has DIM entries. Value is the numeric value found or DFLT if no
1937 table entry matches. This function is used to translate weight,
1938 slant, and swidth names of XLFD font names to numeric values. */
1941 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1942 struct table_entry
*table
;
1944 struct font_name
*font
;
1948 struct table_entry
*p
;
1949 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1950 return p
? p
->numeric
: dflt
;
1954 /* Return a symbolic representation for font name field
1955 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1956 has DIM entries. Value is the symbolic value found or DFLT if no
1957 table entry matches. This function is used to translate weight,
1958 slant, and swidth names of XLFD font names to symbols. */
1960 static INLINE Lisp_Object
1961 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1962 struct table_entry
*table
;
1964 struct font_name
*font
;
1968 struct table_entry
*p
;
1969 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1970 return p
? *p
->symbol
: dflt
;
1974 /* Return a numeric value for the slant of the font given by FONT. */
1977 xlfd_numeric_slant (font
)
1978 struct font_name
*font
;
1980 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1981 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1985 /* Return a symbol representing the weight of the font given by FONT. */
1987 static INLINE Lisp_Object
1988 xlfd_symbolic_slant (font
)
1989 struct font_name
*font
;
1991 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1992 font
, XLFD_SLANT
, Qnormal
);
1996 /* Return a numeric value for the weight of the font given by FONT. */
1999 xlfd_numeric_weight (font
)
2000 struct font_name
*font
;
2002 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2003 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2007 /* Return a symbol representing the slant of the font given by FONT. */
2009 static INLINE Lisp_Object
2010 xlfd_symbolic_weight (font
)
2011 struct font_name
*font
;
2013 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2014 font
, XLFD_WEIGHT
, Qnormal
);
2018 /* Return a numeric value for the swidth of the font whose XLFD font
2019 name fields are found in FONT. */
2022 xlfd_numeric_swidth (font
)
2023 struct font_name
*font
;
2025 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2026 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2030 /* Return a symbolic value for the swidth of FONT. */
2032 static INLINE Lisp_Object
2033 xlfd_symbolic_swidth (font
)
2034 struct font_name
*font
;
2036 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2037 font
, XLFD_SWIDTH
, Qnormal
);
2041 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2042 entries. Value is a pointer to the matching table entry or null if
2043 no element of TABLE contains SYMBOL. */
2045 static struct table_entry
*
2046 face_value (table
, dim
, symbol
)
2047 struct table_entry
*table
;
2053 xassert (SYMBOLP (symbol
));
2055 for (i
= 0; i
< dim
; ++i
)
2056 if (EQ (*table
[i
].symbol
, symbol
))
2059 return i
< dim
? table
+ i
: NULL
;
2063 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2064 entries. Value is -1 if SYMBOL is not found in TABLE. */
2067 face_numeric_value (table
, dim
, symbol
)
2068 struct table_entry
*table
;
2072 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2073 return p
? p
->numeric
: -1;
2077 /* Return a numeric value representing the weight specified by Lisp
2078 symbol WEIGHT. Value is one of the enumerators of enum
2082 face_numeric_weight (weight
)
2085 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2089 /* Return a numeric value representing the slant specified by Lisp
2090 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2093 face_numeric_slant (slant
)
2096 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2100 /* Return a numeric value representing the swidth specified by Lisp
2101 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2104 face_numeric_swidth (width
)
2107 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2111 #ifdef HAVE_WINDOW_SYSTEM
2113 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2117 struct font_name
*font
;
2119 /* Function split_font_name converts fields to lower-case, so there
2120 is no need to use tolower here. */
2121 return *font
->fields
[XLFD_SPACING
] != 'p';
2125 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2127 The actual height of the font when displayed on F depends on the
2128 resolution of both the font and frame. For example, a 10pt font
2129 designed for a 100dpi display will display larger than 10pt on a
2130 75dpi display. (It's not unusual to use fonts not designed for the
2131 display one is using. For example, some intlfonts are available in
2132 72dpi versions, only.)
2134 Value is the real point size of FONT on frame F, or 0 if it cannot
2138 xlfd_point_size (f
, font
)
2140 struct font_name
*font
;
2142 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2143 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2147 if (*pixel_field
== '[')
2149 /* The pixel size field is `[A B C D]' which specifies
2150 a transformation matrix.
2156 by which all glyphs of the font are transformed. The spec
2157 says that s scalar value N for the pixel size is equivalent
2158 to A = N * resx/resy, B = C = 0, D = N. */
2159 char *start
= pixel_field
+ 1, *end
;
2163 for (i
= 0; i
< 4; ++i
)
2165 matrix
[i
] = strtod (start
, &end
);
2172 pixel
= atoi (pixel_field
);
2177 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2183 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2184 of frame F. This function is used to guess a point size of font
2185 when only the pixel height of the font is available. */
2188 pixel_point_size (f
, pixel
)
2192 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2196 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2197 point size of one dot. */
2198 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2199 int_pt
= real_pt
+ 0.5;
2205 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2206 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2207 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2208 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2209 zero if the font name doesn't have the format we expect. The
2210 expected format is a font name that starts with a `-' and has
2211 XLFD_LAST fields separated by `-'. */
2214 split_font_name (f
, font
, numeric_p
)
2216 struct font_name
*font
;
2222 if (*font
->name
== '-')
2224 char *p
= xstrlwr (font
->name
) + 1;
2226 while (i
< XLFD_LAST
)
2228 font
->fields
[i
] = p
;
2231 /* Pixel and point size may be of the form `[....]'. For
2232 BNF, see XLFD spec, chapter 4. Negative values are
2233 indicated by tilde characters which we replace with
2234 `-' characters, here. */
2236 && (i
- 1 == XLFD_PIXEL_SIZE
2237 || i
- 1 == XLFD_POINT_SIZE
))
2242 for (++p
; *p
&& *p
!= ']'; ++p
)
2246 /* Check that the matrix contains 4 floating point
2248 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2251 if (strtod (start
, &end
) == 0 && start
== end
)
2258 while (*p
&& *p
!= '-')
2268 success_p
= i
== XLFD_LAST
;
2270 /* If requested, and font name was in the expected format,
2271 compute numeric values for some fields. */
2272 if (numeric_p
&& success_p
)
2274 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2275 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2276 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2277 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2278 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2279 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2282 /* Initialize it to zero. It will be overridden by font_list while
2283 trying alternate registries. */
2284 font
->registry_priority
= 0;
2290 /* Build an XLFD font name from font name fields in FONT. Value is a
2291 pointer to the font name, which is allocated via xmalloc. */
2294 build_font_name (font
)
2295 struct font_name
*font
;
2299 char *font_name
= (char *) xmalloc (size
);
2300 int total_length
= 0;
2302 for (i
= 0; i
< XLFD_LAST
; ++i
)
2304 /* Add 1 because of the leading `-'. */
2305 int len
= strlen (font
->fields
[i
]) + 1;
2307 /* Reallocate font_name if necessary. Add 1 for the final
2309 if (total_length
+ len
+ 1 >= size
)
2311 int new_size
= max (2 * size
, size
+ len
+ 1);
2312 int sz
= new_size
* sizeof *font_name
;
2313 font_name
= (char *) xrealloc (font_name
, sz
);
2317 font_name
[total_length
] = '-';
2318 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2319 total_length
+= len
;
2322 font_name
[total_length
] = 0;
2327 /* Free an array FONTS of N font_name structures. This frees FONTS
2328 itself and all `name' fields in its elements. */
2331 free_font_names (fonts
, n
)
2332 struct font_name
*fonts
;
2336 xfree (fonts
[--n
].name
);
2341 /* Sort vector FONTS of font_name structures which contains NFONTS
2342 elements using qsort and comparison function CMPFN. F is the frame
2343 on which the fonts will be used. The global variable font_frame
2344 is temporarily set to F to make it available in CMPFN. */
2347 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2349 struct font_name
*fonts
;
2351 int (*cmpfn
) P_ ((const void *, const void *));
2354 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2359 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2360 display in x_display_list. FONTS is a pointer to a vector of
2361 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2362 alternative patterns from Valternate_fontname_alist if no fonts are
2363 found matching PATTERN.
2365 For all fonts found, set FONTS[i].name to the name of the font,
2366 allocated via xmalloc, and split font names into fields. Ignore
2367 fonts that we can't parse. Value is the number of fonts found. */
2370 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2373 struct font_name
*fonts
;
2374 int nfonts
, try_alternatives_p
;
2378 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2379 better to do it the other way around. */
2381 Lisp_Object lpattern
, tem
;
2383 lpattern
= build_string (pattern
);
2385 /* Get the list of fonts matching PATTERN. */
2388 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2391 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2394 /* Make a copy of the font names we got from X, and
2395 split them into fields. */
2397 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2399 Lisp_Object elt
, tail
;
2400 char *name
= XSTRING (XCAR (tem
))->data
;
2402 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2403 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2407 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2416 /* Make a copy of the font name. */
2417 fonts
[n
].name
= xstrdup (name
);
2419 if (split_font_name (f
, fonts
+ n
, 1))
2421 if (font_scalable_p (fonts
+ n
)
2422 && !may_use_scalable_font_p (name
))
2425 xfree (fonts
[n
].name
);
2431 xfree (fonts
[n
].name
);
2434 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2435 if (n
== 0 && try_alternatives_p
)
2437 Lisp_Object list
= Valternate_fontname_alist
;
2439 while (CONSP (list
))
2441 Lisp_Object entry
= XCAR (list
);
2443 && STRINGP (XCAR (entry
))
2444 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2451 Lisp_Object patterns
= XCAR (list
);
2454 while (CONSP (patterns
)
2455 /* If list is screwed up, give up. */
2456 && (name
= XCAR (patterns
),
2458 /* Ignore patterns equal to PATTERN because we tried that
2459 already with no success. */
2460 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2461 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2464 patterns
= XCDR (patterns
);
2472 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2473 using comparison function CMPFN. Value is the number of fonts
2474 found. If value is non-zero, *FONTS is set to a vector of
2475 font_name structures allocated from the heap containing matching
2476 fonts. Each element of *FONTS contains a name member that is also
2477 allocated from the heap. Font names in these structures are split
2478 into fields. Use free_font_names to free such an array. */
2481 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2484 int (*cmpfn
) P_ ((const void *, const void *));
2485 struct font_name
**fonts
;
2489 /* Get the list of fonts matching pattern. 100 should suffice. */
2490 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2491 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2492 nfonts
= XFASTINT (Vfont_list_limit
);
2494 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2495 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2497 /* Sort the resulting array and return it in *FONTS. If no
2498 fonts were found, make sure to set *FONTS to null. */
2500 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2511 /* Compare two font_name structures *A and *B. Value is analogous to
2512 strcmp. Sort order is given by the global variable
2513 font_sort_order. Font names are sorted so that, everything else
2514 being equal, fonts with a resolution closer to that of the frame on
2515 which they are used are listed first. The global variable
2516 font_frame is the frame on which we operate. */
2519 cmp_font_names (a
, b
)
2522 struct font_name
*x
= (struct font_name
*) a
;
2523 struct font_name
*y
= (struct font_name
*) b
;
2526 /* All strings have been converted to lower-case by split_font_name,
2527 so we can use strcmp here. */
2528 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2533 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2535 int j
= font_sort_order
[i
];
2536 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2541 /* Everything else being equal, we prefer fonts with an
2542 y-resolution closer to that of the frame. */
2543 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2544 int x_resy
= x
->numeric
[XLFD_RESY
];
2545 int y_resy
= y
->numeric
[XLFD_RESY
];
2546 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2554 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2555 is non-nil list fonts matching that pattern. Otherwise, if
2556 REGISTRY is non-nil return only fonts with that registry, otherwise
2557 return fonts of any registry. Set *FONTS to a vector of font_name
2558 structures allocated from the heap containing the fonts found.
2559 Value is the number of fonts found. */
2562 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2564 Lisp_Object pattern
, family
, registry
;
2565 struct font_name
**fonts
;
2567 char *pattern_str
, *family_str
, *registry_str
;
2571 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2572 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2574 pattern_str
= (char *) alloca (strlen (family_str
)
2575 + strlen (registry_str
)
2577 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2578 strcat (pattern_str
, family_str
);
2579 strcat (pattern_str
, "-*-");
2580 strcat (pattern_str
, registry_str
);
2581 if (!index (registry_str
, '-'))
2583 if (registry_str
[strlen (registry_str
) - 1] == '*')
2584 strcat (pattern_str
, "-*");
2586 strcat (pattern_str
, "*-*");
2590 pattern_str
= (char *) XSTRING (pattern
)->data
;
2592 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2596 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2597 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2598 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2601 static struct font_name
*
2602 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2603 struct font_name
*fonts1
, *fonts2
;
2604 int nfonts1
, nfonts2
;
2606 int new_nfonts
= nfonts1
+ nfonts2
;
2607 struct font_name
*new_fonts
;
2609 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2610 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2611 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2618 /* Get a sorted list of fonts of family FAMILY on frame F.
2620 If PATTERN is non-nil list fonts matching that pattern.
2622 If REGISTRY is non-nil, return fonts with that registry and the
2623 alternative registries from Vface_alternative_font_registry_alist.
2625 If REGISTRY is nil return fonts of any registry.
2627 Set *FONTS to a vector of font_name structures allocated from the
2628 heap containing the fonts found. Value is the number of fonts
2632 font_list (f
, pattern
, family
, registry
, fonts
)
2634 Lisp_Object pattern
, family
, registry
;
2635 struct font_name
**fonts
;
2637 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2639 if (!NILP (registry
)
2640 && CONSP (Vface_alternative_font_registry_alist
))
2644 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2649 for (alter
= XCDR (alter
), reg_prio
= 1;
2651 alter
= XCDR (alter
), reg_prio
++)
2652 if (STRINGP (XCAR (alter
)))
2655 struct font_name
*fonts2
;
2657 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2659 for (i
= 0; i
< nfonts2
; i
++)
2660 fonts2
[i
].registry_priority
= reg_prio
;
2661 *fonts
= (nfonts
> 0
2662 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2673 /* Remove elements from LIST whose cars are `equal'. Called from
2674 x-family-fonts and x-font-family-list to remove duplicate font
2678 remove_duplicates (list
)
2681 Lisp_Object tail
= list
;
2683 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2685 Lisp_Object next
= XCDR (tail
);
2686 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2687 XSETCDR (tail
, XCDR (next
));
2694 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2695 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2696 If FAMILY is omitted or nil, list all families.
2697 Otherwise, FAMILY must be a string, possibly containing wildcards
2699 If FRAME is omitted or nil, use the selected frame.
2700 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2701 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2702 FAMILY is the font family name. POINT-SIZE is the size of the
2703 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2704 width, weight and slant of the font. These symbols are the same as for
2705 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2706 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2707 giving the registry and encoding of the font.
2708 The result list is sorted according to the current setting of
2709 the face font sort order. */)
2711 Lisp_Object family
, frame
;
2713 struct frame
*f
= check_x_frame (frame
);
2714 struct font_name
*fonts
;
2717 struct gcpro gcpro1
;
2720 CHECK_STRING (family
, 1);
2724 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2725 for (i
= nfonts
- 1; i
>= 0; --i
)
2727 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2730 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2731 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2732 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2733 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2734 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2735 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2736 tem
= build_font_name (fonts
+ i
);
2737 ASET (v
, 6, build_string (tem
));
2738 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2739 fonts
[i
].fields
[XLFD_ENCODING
]);
2740 ASET (v
, 7, build_string (tem
));
2743 result
= Fcons (v
, result
);
2746 remove_duplicates (result
);
2747 free_font_names (fonts
, nfonts
);
2753 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2755 doc
: /* Return a list of available font families on FRAME.
2756 If FRAME is omitted or nil, use the selected frame.
2757 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2758 is a font family, and FIXED-P is non-nil if fonts of that family
2759 are fixed-pitch. */)
2763 struct frame
*f
= check_x_frame (frame
);
2765 struct font_name
*fonts
;
2767 struct gcpro gcpro1
;
2768 int count
= specpdl_ptr
- specpdl
;
2771 /* Let's consider all fonts. Increase the limit for matching
2772 fonts until we have them all. */
2775 specbind (intern ("font-list-limit"), make_number (limit
));
2776 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2778 if (nfonts
== limit
)
2780 free_font_names (fonts
, nfonts
);
2789 for (i
= nfonts
- 1; i
>= 0; --i
)
2790 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2791 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2794 remove_duplicates (result
);
2795 free_font_names (fonts
, nfonts
);
2797 return unbind_to (count
, result
);
2801 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2802 doc
: /* Return a list of the names of available fonts matching PATTERN.
2803 If optional arguments FACE and FRAME are specified, return only fonts
2804 the same size as FACE on FRAME.
2805 PATTERN is a string, perhaps with wildcard characters;
2806 the * character matches any substring, and
2807 the ? character matches any single character.
2808 PATTERN is case-insensitive.
2809 FACE is a face name--a symbol.
2811 The return value is a list of strings, suitable as arguments to
2814 Fonts Emacs can't use may or may not be excluded
2815 even if they match PATTERN and FACE.
2816 The optional fourth argument MAXIMUM sets a limit on how many
2817 fonts to match. The first MAXIMUM fonts are reported.
2818 The optional fifth argument WIDTH, if specified, is a number of columns
2819 occupied by a character of a font. In that case, return only fonts
2820 the WIDTH times as wide as FACE on FRAME. */)
2821 (pattern
, face
, frame
, maximum
, width
)
2822 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2829 CHECK_STRING (pattern
, 0);
2835 CHECK_NATNUM (maximum
, 0);
2836 maxnames
= XINT (maximum
);
2840 CHECK_NUMBER (width
, 4);
2842 /* We can't simply call check_x_frame because this function may be
2843 called before any frame is created. */
2844 f
= frame_or_selected_frame (frame
, 2);
2845 if (!FRAME_WINDOW_P (f
))
2847 /* Perhaps we have not yet created any frame. */
2852 /* Determine the width standard for comparison with the fonts we find. */
2858 /* This is of limited utility since it works with character
2859 widths. Keep it for compatibility. --gerd. */
2860 int face_id
= lookup_named_face (f
, face
, 0);
2861 struct face
*face
= (face_id
< 0
2863 : FACE_FROM_ID (f
, face_id
));
2865 if (face
&& face
->font
)
2866 size
= FONT_WIDTH (face
->font
);
2868 size
= FONT_WIDTH (FRAME_FONT (f
));
2871 size
*= XINT (width
);
2875 Lisp_Object args
[2];
2877 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2879 /* We don't have to check fontsets. */
2881 args
[1] = list_fontsets (f
, pattern
, size
);
2882 return Fnconc (2, args
);
2886 #endif /* HAVE_WINDOW_SYSTEM */
2890 /***********************************************************************
2892 ***********************************************************************/
2894 /* Access face attributes of face LFACE, a Lisp vector. */
2896 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2897 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2898 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2899 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2900 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2901 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2902 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2903 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2904 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2905 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2906 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2907 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2908 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2909 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2910 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2911 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2913 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2914 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2916 #define LFACEP(LFACE) \
2918 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2919 && EQ (AREF (LFACE, 0), Qface))
2924 /* Check consistency of Lisp face attribute vector ATTRS. */
2927 check_lface_attrs (attrs
)
2930 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2931 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2932 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2933 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2934 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2935 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2936 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2937 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2938 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2939 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2940 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2941 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2942 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2943 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2944 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2945 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2946 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2947 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2948 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2949 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2950 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2952 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2953 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2954 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2955 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2956 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2957 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2958 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2959 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2960 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2961 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2962 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2963 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2964 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2965 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2966 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2967 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2968 #ifdef HAVE_WINDOW_SYSTEM
2969 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2970 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2971 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2972 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2973 || NILP (attrs
[LFACE_FONT_INDEX
])
2974 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2979 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2987 xassert (LFACEP (lface
));
2988 check_lface_attrs (XVECTOR (lface
)->contents
);
2992 #else /* GLYPH_DEBUG == 0 */
2994 #define check_lface_attrs(attrs) (void) 0
2995 #define check_lface(lface) (void) 0
2997 #endif /* GLYPH_DEBUG == 0 */
3000 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3001 to make it a symvol. If FACE_NAME is an alias for another face,
3002 return that face's name. */
3005 resolve_face_name (face_name
)
3006 Lisp_Object face_name
;
3008 Lisp_Object aliased
;
3010 if (STRINGP (face_name
))
3011 face_name
= intern (XSTRING (face_name
)->data
);
3013 while (SYMBOLP (face_name
))
3015 aliased
= Fget (face_name
, Qface_alias
);
3019 face_name
= aliased
;
3026 /* Return the face definition of FACE_NAME on frame F. F null means
3027 return the definition for new frames. FACE_NAME may be a string or
3028 a symbol (apparently Emacs 20.2 allowed strings as face names in
3029 face text properties; Ediff uses that). If FACE_NAME is an alias
3030 for another face, return that face's definition. If SIGNAL_P is
3031 non-zero, signal an error if FACE_NAME is not a valid face name.
3032 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3035 static INLINE Lisp_Object
3036 lface_from_face_name (f
, face_name
, signal_p
)
3038 Lisp_Object face_name
;
3043 face_name
= resolve_face_name (face_name
);
3046 lface
= assq_no_quit (face_name
, f
->face_alist
);
3048 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3051 lface
= XCDR (lface
);
3053 signal_error ("Invalid face", face_name
);
3055 check_lface (lface
);
3060 /* Get face attributes of face FACE_NAME from frame-local faces on
3061 frame F. Store the resulting attributes in ATTRS which must point
3062 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3063 is non-zero, signal an error if FACE_NAME does not name a face.
3064 Otherwise, value is zero if FACE_NAME is not a face. */
3067 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3069 Lisp_Object face_name
;
3076 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3079 bcopy (XVECTOR (lface
)->contents
, attrs
,
3080 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3090 /* Non-zero if all attributes in face attribute vector ATTRS are
3091 specified, i.e. are non-nil. */
3094 lface_fully_specified_p (attrs
)
3099 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3100 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3101 && i
!= LFACE_AVGWIDTH_INDEX
)
3102 if (UNSPECIFIEDP (attrs
[i
]))
3105 return i
== LFACE_VECTOR_SIZE
;
3108 #ifdef HAVE_WINDOW_SYSTEM
3110 /* Set font-related attributes of Lisp face LFACE from the fullname of
3111 the font opened by FONTNAME. If FORCE_P is zero, set only
3112 unspecified attributes of LFACE. The exception is `font'
3113 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3115 If FONTNAME is not available on frame F,
3116 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3117 If the fullname is not in a valid XLFD format,
3118 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3119 in LFACE and return 1.
3120 Otherwise, return 1. */
3123 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3126 Lisp_Object fontname
;
3127 int force_p
, may_fail_p
;
3129 struct font_name font
;
3134 char *font_name
= XSTRING (fontname
)->data
;
3135 struct font_info
*font_info
;
3137 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3138 fontset
= fs_query_fontset (fontname
, 0);
3140 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3142 /* Check if FONT_NAME is surely available on the system. Usually
3143 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3144 returns quickly. But, even if FONT_NAME is not yet cached,
3145 caching it now is not futail because we anyway load the font
3148 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3158 font
.name
= STRDUPA (font_info
->full_name
);
3159 have_xlfd_p
= split_font_name (f
, &font
, 1);
3161 /* Set attributes only if unspecified, otherwise face defaults for
3162 new frames would never take effect. If we couldn't get a font
3163 name conforming to XLFD, set normal values. */
3165 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3170 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3171 + strlen (font
.fields
[XLFD_FOUNDRY
])
3173 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3174 font
.fields
[XLFD_FAMILY
]);
3175 val
= build_string (buffer
);
3178 val
= build_string ("*");
3179 LFACE_FAMILY (lface
) = val
;
3182 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3185 pt
= xlfd_point_size (f
, &font
);
3187 pt
= pixel_point_size (f
, font_info
->height
* 10);
3189 LFACE_HEIGHT (lface
) = make_number (pt
);
3192 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3193 LFACE_SWIDTH (lface
)
3194 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3196 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3197 LFACE_AVGWIDTH (lface
)
3199 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3202 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3203 LFACE_WEIGHT (lface
)
3204 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3206 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3208 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3210 LFACE_FONT (lface
) = fontname
;
3215 #endif /* HAVE_WINDOW_SYSTEM */
3218 /* Merges the face height FROM with the face height TO, and returns the
3219 merged height. If FROM is an invalid height, then INVALID is
3220 returned instead. FROM may be a either an absolute face height or a
3221 `relative' height, and TO must be an absolute height. The returned
3222 value is always an absolute height. GCPRO is a lisp value that will
3223 be protected from garbage-collection if this function makes a call
3227 merge_face_heights (from
, to
, invalid
, gcpro
)
3228 Lisp_Object from
, to
, invalid
, gcpro
;
3232 if (INTEGERP (from
))
3233 result
= XINT (from
);
3234 else if (NUMBERP (from
))
3235 result
= XFLOATINT (from
) * XINT (to
);
3236 #if 0 /* Probably not so useful. */
3237 else if (CONSP (from
) && CONSP (XCDR (from
)))
3239 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3241 if (INTEGERP (XCAR (XCDR (from
))))
3243 int inc
= XINT (XCAR (XCDR (from
)));
3244 if (EQ (XCAR (from
), Qminus
))
3247 result
= XFASTINT (to
);
3248 if (result
+ inc
> 0)
3249 /* Note that `underflows' don't mean FROM is invalid, so
3250 we just pin the result at TO if it would otherwise be
3257 else if (FUNCTIONP (from
))
3259 /* Call function with current height as argument.
3260 From is the new height. */
3261 Lisp_Object args
[2], height
;
3262 struct gcpro gcpro1
;
3268 height
= safe_call (2, args
);
3272 if (NUMBERP (height
))
3273 result
= XFLOATINT (height
);
3277 return make_number (result
);
3283 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3284 store the resulting attributes in TO, which must be already be
3285 completely specified and contain only absolute attributes. Every
3286 specified attribute of FROM overrides the corresponding attribute of
3287 TO; relative attributes in FROM are merged with the absolute value in
3288 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3289 face inheritance; it should be Qnil when called from other places. */
3292 merge_face_vectors (f
, from
, to
, cycle_check
)
3294 Lisp_Object
*from
, *to
;
3295 Lisp_Object cycle_check
;
3299 /* If FROM inherits from some other faces, merge their attributes into
3300 TO before merging FROM's direct attributes. Note that an :inherit
3301 attribute of `unspecified' is the same as one of nil; we never
3302 merge :inherit attributes, so nil is more correct, but lots of
3303 other code uses `unspecified' as a generic value for face attributes. */
3304 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3305 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3306 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3308 /* If TO specifies a :font attribute, and FROM specifies some
3309 font-related attribute, we need to clear TO's :font attribute
3310 (because it will be inconsistent with whatever FROM specifies, and
3311 FROM takes precedence). */
3312 if (!NILP (to
[LFACE_FONT_INDEX
])
3313 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3314 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3315 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3316 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3317 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3318 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3319 to
[LFACE_FONT_INDEX
] = Qnil
;
3321 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3322 if (!UNSPECIFIEDP (from
[i
]))
3323 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3324 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3328 /* TO is always an absolute face, which should inherit from nothing.
3329 We blindly copy the :inherit attribute above and fix it up here. */
3330 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3334 /* Checks the `cycle check' variable CHECK to see if it indicates that
3335 EL is part of a cycle; CHECK must be either Qnil or a value returned
3336 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3337 elements after which a cycle might be suspected; after that many
3338 elements, this macro begins consing in order to keep more precise
3341 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3344 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3345 the caller should make sure that's ok. */
3347 #define CYCLE_CHECK(check, el, suspicious) \
3350 : (INTEGERP (check) \
3351 ? (XFASTINT (check) < (suspicious) \
3352 ? make_number (XFASTINT (check) + 1) \
3353 : Fcons (el, Qnil)) \
3354 : (!NILP (Fmemq ((el), (check))) \
3356 : Fcons ((el), (check)))))
3359 /* Merge face attributes from the face on frame F whose name is
3360 INHERITS, into the vector of face attributes TO; INHERITS may also be
3361 a list of face names, in which case they are applied in order.
3362 CYCLE_CHECK is used to detect loops in face inheritance.
3363 Returns true if any of the inherited attributes are `font-related'. */
3366 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3368 Lisp_Object inherit
;
3370 Lisp_Object cycle_check
;
3372 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3373 /* Inherit from the named face INHERIT. */
3377 /* Make sure we're not in an inheritance loop. */
3378 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3379 if (NILP (cycle_check
))
3380 /* Cycle detected, ignore any further inheritance. */
3383 lface
= lface_from_face_name (f
, inherit
, 0);
3385 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3387 else if (CONSP (inherit
))
3388 /* Handle a list of inherited faces by calling ourselves recursively
3389 on each element. Note that we only do so for symbol elements, so
3390 it's not possible to infinitely recurse. */
3392 while (CONSP (inherit
))
3394 if (SYMBOLP (XCAR (inherit
)))
3395 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3397 /* Check for a circular inheritance list. */
3398 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3399 if (NILP (cycle_check
))
3400 /* Cycle detected. */
3403 inherit
= XCDR (inherit
);
3409 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3410 is a face property, determine the resulting face attributes on
3411 frame F, and store them in TO. PROP may be a single face
3412 specification or a list of such specifications. Each face
3413 specification can be
3415 1. A symbol or string naming a Lisp face.
3417 2. A property list of the form (KEYWORD VALUE ...) where each
3418 KEYWORD is a face attribute name, and value is an appropriate value
3421 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3422 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3423 for compatibility with 20.2.
3425 Face specifications earlier in lists take precedence over later
3429 merge_face_vector_with_property (f
, to
, prop
)
3436 Lisp_Object first
= XCAR (prop
);
3438 if (EQ (first
, Qforeground_color
)
3439 || EQ (first
, Qbackground_color
))
3441 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3442 . COLOR). COLOR must be a string. */
3443 Lisp_Object color_name
= XCDR (prop
);
3444 Lisp_Object color
= first
;
3446 if (STRINGP (color_name
))
3448 if (EQ (color
, Qforeground_color
))
3449 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3451 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3454 add_to_log ("Invalid face color", color_name
, Qnil
);
3456 else if (SYMBOLP (first
)
3457 && *XSYMBOL (first
)->name
->data
== ':')
3459 /* Assume this is the property list form. */
3460 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3462 Lisp_Object keyword
= XCAR (prop
);
3463 Lisp_Object value
= XCAR (XCDR (prop
));
3465 if (EQ (keyword
, QCfamily
))
3467 if (STRINGP (value
))
3468 to
[LFACE_FAMILY_INDEX
] = value
;
3470 add_to_log ("Invalid face font family", value
, Qnil
);
3472 else if (EQ (keyword
, QCheight
))
3474 Lisp_Object new_height
=
3475 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3478 if (NILP (new_height
))
3479 add_to_log ("Invalid face font height", value
, Qnil
);
3481 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3483 else if (EQ (keyword
, QCweight
))
3486 && face_numeric_weight (value
) >= 0)
3487 to
[LFACE_WEIGHT_INDEX
] = value
;
3489 add_to_log ("Invalid face weight", value
, Qnil
);
3491 else if (EQ (keyword
, QCslant
))
3494 && face_numeric_slant (value
) >= 0)
3495 to
[LFACE_SLANT_INDEX
] = value
;
3497 add_to_log ("Invalid face slant", value
, Qnil
);
3499 else if (EQ (keyword
, QCunderline
))
3504 to
[LFACE_UNDERLINE_INDEX
] = value
;
3506 add_to_log ("Invalid face underline", value
, Qnil
);
3508 else if (EQ (keyword
, QCoverline
))
3513 to
[LFACE_OVERLINE_INDEX
] = value
;
3515 add_to_log ("Invalid face overline", value
, Qnil
);
3517 else if (EQ (keyword
, QCstrike_through
))
3522 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3524 add_to_log ("Invalid face strike-through", value
, Qnil
);
3526 else if (EQ (keyword
, QCbox
))
3529 value
= make_number (1);
3530 if (INTEGERP (value
)
3534 to
[LFACE_BOX_INDEX
] = value
;
3536 add_to_log ("Invalid face box", value
, Qnil
);
3538 else if (EQ (keyword
, QCinverse_video
)
3539 || EQ (keyword
, QCreverse_video
))
3541 if (EQ (value
, Qt
) || NILP (value
))
3542 to
[LFACE_INVERSE_INDEX
] = value
;
3544 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3546 else if (EQ (keyword
, QCforeground
))
3548 if (STRINGP (value
))
3549 to
[LFACE_FOREGROUND_INDEX
] = value
;
3551 add_to_log ("Invalid face foreground", value
, Qnil
);
3553 else if (EQ (keyword
, QCbackground
))
3555 if (STRINGP (value
))
3556 to
[LFACE_BACKGROUND_INDEX
] = value
;
3558 add_to_log ("Invalid face background", value
, Qnil
);
3560 else if (EQ (keyword
, QCstipple
))
3562 #ifdef HAVE_X_WINDOWS
3563 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3564 if (!NILP (pixmap_p
))
3565 to
[LFACE_STIPPLE_INDEX
] = value
;
3567 add_to_log ("Invalid face stipple", value
, Qnil
);
3570 else if (EQ (keyword
, QCwidth
))
3573 && face_numeric_swidth (value
) >= 0)
3574 to
[LFACE_SWIDTH_INDEX
] = value
;
3576 add_to_log ("Invalid face width", value
, Qnil
);
3578 else if (EQ (keyword
, QCinherit
))
3580 if (SYMBOLP (value
))
3581 to
[LFACE_INHERIT_INDEX
] = value
;
3585 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3586 if (!SYMBOLP (XCAR (tail
)))
3589 to
[LFACE_INHERIT_INDEX
] = value
;
3591 add_to_log ("Invalid face inherit", value
, Qnil
);
3595 add_to_log ("Invalid attribute %s in face property",
3598 prop
= XCDR (XCDR (prop
));
3603 /* This is a list of face specs. Specifications at the
3604 beginning of the list take precedence over later
3605 specifications, so we have to merge starting with the
3606 last specification. */
3607 Lisp_Object next
= XCDR (prop
);
3609 merge_face_vector_with_property (f
, to
, next
);
3610 merge_face_vector_with_property (f
, to
, first
);
3615 /* PROP ought to be a face name. */
3616 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3618 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3620 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3625 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3626 Sinternal_make_lisp_face
, 1, 2, 0,
3627 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3628 If FACE was not known as a face before, create a new one.
3629 If optional argument FRAME is specified, make a frame-local face
3630 for that frame. Otherwise operate on the global face definition.
3631 Value is a vector of face attributes. */)
3633 Lisp_Object face
, frame
;
3635 Lisp_Object global_lface
, lface
;
3639 CHECK_SYMBOL (face
, 0);
3640 global_lface
= lface_from_face_name (NULL
, face
, 0);
3644 CHECK_LIVE_FRAME (frame
, 1);
3646 lface
= lface_from_face_name (f
, face
, 0);
3649 f
= NULL
, lface
= Qnil
;
3651 /* Add a global definition if there is none. */
3652 if (NILP (global_lface
))
3654 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3656 AREF (global_lface
, 0) = Qface
;
3657 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3658 Vface_new_frame_defaults
);
3660 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3661 face id to Lisp face is given by the vector lface_id_to_name.
3662 The mapping from Lisp face to Lisp face id is given by the
3663 property `face' of the Lisp face name. */
3664 if (next_lface_id
== lface_id_to_name_size
)
3666 int new_size
= max (50, 2 * lface_id_to_name_size
);
3667 int sz
= new_size
* sizeof *lface_id_to_name
;
3668 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3669 lface_id_to_name_size
= new_size
;
3672 lface_id_to_name
[next_lface_id
] = face
;
3673 Fput (face
, Qface
, make_number (next_lface_id
));
3677 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3678 AREF (global_lface
, i
) = Qunspecified
;
3680 /* Add a frame-local definition. */
3685 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3687 AREF (lface
, 0) = Qface
;
3688 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3691 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3692 AREF (lface
, i
) = Qunspecified
;
3695 lface
= global_lface
;
3697 xassert (LFACEP (lface
));
3698 check_lface (lface
);
3703 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3704 Sinternal_lisp_face_p
, 1, 2, 0,
3705 doc
: /* Return non-nil if FACE names a face.
3706 If optional second parameter FRAME is non-nil, check for the
3707 existence of a frame-local face with name FACE on that frame.
3708 Otherwise check for the existence of a global face. */)
3710 Lisp_Object face
, frame
;
3716 CHECK_LIVE_FRAME (frame
, 1);
3717 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3720 lface
= lface_from_face_name (NULL
, face
, 0);
3726 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3727 Sinternal_copy_lisp_face
, 4, 4, 0,
3728 doc
: /* Copy face FROM to TO.
3729 If FRAME it t, copy the global face definition of FROM to the
3730 global face definition of TO. Otherwise, copy the frame-local
3731 definition of FROM on FRAME to the frame-local definition of TO
3732 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3735 (from
, to
, frame
, new_frame
)
3736 Lisp_Object from
, to
, frame
, new_frame
;
3738 Lisp_Object lface
, copy
;
3740 CHECK_SYMBOL (from
, 0);
3741 CHECK_SYMBOL (to
, 1);
3742 if (NILP (new_frame
))
3747 /* Copy global definition of FROM. We don't make copies of
3748 strings etc. because 20.2 didn't do it either. */
3749 lface
= lface_from_face_name (NULL
, from
, 1);
3750 copy
= Finternal_make_lisp_face (to
, Qnil
);
3754 /* Copy frame-local definition of FROM. */
3755 CHECK_LIVE_FRAME (frame
, 2);
3756 CHECK_LIVE_FRAME (new_frame
, 3);
3757 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3758 copy
= Finternal_make_lisp_face (to
, new_frame
);
3761 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3762 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3768 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3769 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3770 doc
: /* Set attribute ATTR of FACE to VALUE.
3771 FRAME being a frame means change the face on that frame.
3772 FRAME nil means change the face of the selected frame.
3773 FRAME t means change the default for new frames.
3774 FRAME 0 means change the face on all frames, and change the default
3776 (face
, attr
, value
, frame
)
3777 Lisp_Object face
, attr
, value
, frame
;
3780 Lisp_Object old_value
= Qnil
;
3781 /* Set 1 if ATTR is QCfont. */
3782 int font_attr_p
= 0;
3783 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3784 int font_related_attr_p
= 0;
3786 CHECK_SYMBOL (face
, 0);
3787 CHECK_SYMBOL (attr
, 1);
3789 face
= resolve_face_name (face
);
3791 /* If FRAME is 0, change face on all frames, and change the
3792 default for new frames. */
3793 if (INTEGERP (frame
) && XINT (frame
) == 0)
3796 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3797 FOR_EACH_FRAME (tail
, frame
)
3798 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3802 /* Set lface to the Lisp attribute vector of FACE. */
3804 lface
= lface_from_face_name (NULL
, face
, 1);
3808 frame
= selected_frame
;
3810 CHECK_LIVE_FRAME (frame
, 3);
3811 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3813 /* If a frame-local face doesn't exist yet, create one. */
3815 lface
= Finternal_make_lisp_face (face
, frame
);
3818 if (EQ (attr
, QCfamily
))
3820 if (!UNSPECIFIEDP (value
))
3822 CHECK_STRING (value
, 3);
3823 if (XSTRING (value
)->size
== 0)
3824 signal_error ("Invalid face family", value
);
3826 old_value
= LFACE_FAMILY (lface
);
3827 LFACE_FAMILY (lface
) = value
;
3828 font_related_attr_p
= 1;
3830 else if (EQ (attr
, QCheight
))
3832 if (!UNSPECIFIEDP (value
))
3836 test
= (EQ (face
, Qdefault
)
3838 /* The default face must have an absolute size,
3839 otherwise, we do a test merge with a random
3840 height to see if VALUE's ok. */
3841 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3843 if (!INTEGERP (test
) || XINT (test
) <= 0)
3844 signal_error ("Invalid face height", value
);
3847 old_value
= LFACE_HEIGHT (lface
);
3848 LFACE_HEIGHT (lface
) = value
;
3849 font_related_attr_p
= 1;
3851 else if (EQ (attr
, QCweight
))
3853 if (!UNSPECIFIEDP (value
))
3855 CHECK_SYMBOL (value
, 3);
3856 if (face_numeric_weight (value
) < 0)
3857 signal_error ("Invalid face weight", value
);
3859 old_value
= LFACE_WEIGHT (lface
);
3860 LFACE_WEIGHT (lface
) = value
;
3861 font_related_attr_p
= 1;
3863 else if (EQ (attr
, QCslant
))
3865 if (!UNSPECIFIEDP (value
))
3867 CHECK_SYMBOL (value
, 3);
3868 if (face_numeric_slant (value
) < 0)
3869 signal_error ("Invalid face slant", value
);
3871 old_value
= LFACE_SLANT (lface
);
3872 LFACE_SLANT (lface
) = value
;
3873 font_related_attr_p
= 1;
3875 else if (EQ (attr
, QCunderline
))
3877 if (!UNSPECIFIEDP (value
))
3878 if ((SYMBOLP (value
)
3880 && !EQ (value
, Qnil
))
3881 /* Underline color. */
3883 && XSTRING (value
)->size
== 0))
3884 signal_error ("Invalid face underline", value
);
3886 old_value
= LFACE_UNDERLINE (lface
);
3887 LFACE_UNDERLINE (lface
) = value
;
3889 else if (EQ (attr
, QCoverline
))
3891 if (!UNSPECIFIEDP (value
))
3892 if ((SYMBOLP (value
)
3894 && !EQ (value
, Qnil
))
3895 /* Overline color. */
3897 && XSTRING (value
)->size
== 0))
3898 signal_error ("Invalid face overline", value
);
3900 old_value
= LFACE_OVERLINE (lface
);
3901 LFACE_OVERLINE (lface
) = value
;
3903 else if (EQ (attr
, QCstrike_through
))
3905 if (!UNSPECIFIEDP (value
))
3906 if ((SYMBOLP (value
)
3908 && !EQ (value
, Qnil
))
3909 /* Strike-through color. */
3911 && XSTRING (value
)->size
== 0))
3912 signal_error ("Invalid face strike-through", value
);
3914 old_value
= LFACE_STRIKE_THROUGH (lface
);
3915 LFACE_STRIKE_THROUGH (lface
) = value
;
3917 else if (EQ (attr
, QCbox
))
3921 /* Allow t meaning a simple box of width 1 in foreground color
3924 value
= make_number (1);
3926 if (UNSPECIFIEDP (value
))
3928 else if (NILP (value
))
3930 else if (INTEGERP (value
))
3931 valid_p
= XINT (value
) != 0;
3932 else if (STRINGP (value
))
3933 valid_p
= XSTRING (value
)->size
> 0;
3934 else if (CONSP (value
))
3950 if (EQ (k
, QCline_width
))
3952 if (!INTEGERP (v
) || XINT (v
) == 0)
3955 else if (EQ (k
, QCcolor
))
3957 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3960 else if (EQ (k
, QCstyle
))
3962 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3969 valid_p
= NILP (tem
);
3975 signal_error ("Invalid face box", value
);
3977 old_value
= LFACE_BOX (lface
);
3978 LFACE_BOX (lface
) = value
;
3980 else if (EQ (attr
, QCinverse_video
)
3981 || EQ (attr
, QCreverse_video
))
3983 if (!UNSPECIFIEDP (value
))
3985 CHECK_SYMBOL (value
, 3);
3986 if (!EQ (value
, Qt
) && !NILP (value
))
3987 signal_error ("Invalid inverse-video face attribute value", value
);
3989 old_value
= LFACE_INVERSE (lface
);
3990 LFACE_INVERSE (lface
) = value
;
3992 else if (EQ (attr
, QCforeground
))
3994 if (!UNSPECIFIEDP (value
))
3996 /* Don't check for valid color names here because it depends
3997 on the frame (display) whether the color will be valid
3998 when the face is realized. */
3999 CHECK_STRING (value
, 3);
4000 if (XSTRING (value
)->size
== 0)
4001 signal_error ("Empty foreground color value", value
);
4003 old_value
= LFACE_FOREGROUND (lface
);
4004 LFACE_FOREGROUND (lface
) = value
;
4006 else if (EQ (attr
, QCbackground
))
4008 if (!UNSPECIFIEDP (value
))
4010 /* Don't check for valid color names here because it depends
4011 on the frame (display) whether the color will be valid
4012 when the face is realized. */
4013 CHECK_STRING (value
, 3);
4014 if (XSTRING (value
)->size
== 0)
4015 signal_error ("Empty background color value", value
);
4017 old_value
= LFACE_BACKGROUND (lface
);
4018 LFACE_BACKGROUND (lface
) = value
;
4020 else if (EQ (attr
, QCstipple
))
4022 #ifdef HAVE_X_WINDOWS
4023 if (!UNSPECIFIEDP (value
)
4025 && NILP (Fbitmap_spec_p (value
)))
4026 signal_error ("Invalid stipple attribute", value
);
4027 old_value
= LFACE_STIPPLE (lface
);
4028 LFACE_STIPPLE (lface
) = value
;
4029 #endif /* HAVE_X_WINDOWS */
4031 else if (EQ (attr
, QCwidth
))
4033 if (!UNSPECIFIEDP (value
))
4035 CHECK_SYMBOL (value
, 3);
4036 if (face_numeric_swidth (value
) < 0)
4037 signal_error ("Invalid face width", value
);
4039 old_value
= LFACE_SWIDTH (lface
);
4040 LFACE_SWIDTH (lface
) = value
;
4041 font_related_attr_p
= 1;
4043 else if (EQ (attr
, QCfont
))
4045 #ifdef HAVE_WINDOW_SYSTEM
4046 if (FRAME_WINDOW_P (f
))
4048 /* Set font-related attributes of the Lisp face from an XLFD
4053 CHECK_STRING (value
, 3);
4055 f
= SELECTED_FRAME ();
4057 f
= check_x_frame (frame
);
4059 /* VALUE may be a fontset name or an alias of fontset. In
4060 such a case, use the base fontset name. */
4061 tmp
= Fquery_fontset (value
, Qnil
);
4065 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4066 signal_error ("Invalid font or fontset name", value
);
4070 #endif /* HAVE_WINDOW_SYSTEM */
4072 else if (EQ (attr
, QCinherit
))
4075 if (SYMBOLP (value
))
4078 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4079 if (!SYMBOLP (XCAR (tail
)))
4082 LFACE_INHERIT (lface
) = value
;
4084 signal_error ("Invalid face inheritance", value
);
4086 else if (EQ (attr
, QCbold
))
4088 old_value
= LFACE_WEIGHT (lface
);
4089 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4090 font_related_attr_p
= 1;
4092 else if (EQ (attr
, QCitalic
))
4094 old_value
= LFACE_SLANT (lface
);
4095 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4096 font_related_attr_p
= 1;
4099 signal_error ("Invalid face attribute name", attr
);
4101 if (font_related_attr_p
4102 && !UNSPECIFIEDP (value
))
4103 /* If a font-related attribute other than QCfont is specified, the
4104 original `font' attribute nor that of default face is useless
4105 to determine a new font. Thus, we set it to nil so that font
4106 selection mechanism doesn't use it. */
4107 LFACE_FONT (lface
) = Qnil
;
4109 /* Changing a named face means that all realized faces depending on
4110 that face are invalid. Since we cannot tell which realized faces
4111 depend on the face, make sure they are all removed. This is done
4112 by incrementing face_change_count. The next call to
4113 init_iterator will then free realized faces. */
4115 && (EQ (attr
, QCfont
)
4116 || NILP (Fequal (old_value
, value
))))
4118 ++face_change_count
;
4119 ++windows_or_buffers_changed
;
4122 if (!UNSPECIFIEDP (value
)
4123 && NILP (Fequal (old_value
, value
)))
4129 if (EQ (face
, Qdefault
))
4131 #ifdef HAVE_WINDOW_SYSTEM
4132 /* Changed font-related attributes of the `default' face are
4133 reflected in changed `font' frame parameters. */
4135 && (font_related_attr_p
|| font_attr_p
)
4136 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4137 set_font_frame_param (frame
, lface
);
4139 #endif /* HAVE_WINDOW_SYSTEM */
4141 if (EQ (attr
, QCforeground
))
4142 param
= Qforeground_color
;
4143 else if (EQ (attr
, QCbackground
))
4144 param
= Qbackground_color
;
4146 #ifdef HAVE_WINDOW_SYSTEM
4148 else if (EQ (face
, Qscroll_bar
))
4150 /* Changing the colors of `scroll-bar' sets frame parameters
4151 `scroll-bar-foreground' and `scroll-bar-background'. */
4152 if (EQ (attr
, QCforeground
))
4153 param
= Qscroll_bar_foreground
;
4154 else if (EQ (attr
, QCbackground
))
4155 param
= Qscroll_bar_background
;
4157 #endif /* not WINDOWSNT */
4158 else if (EQ (face
, Qborder
))
4160 /* Changing background color of `border' sets frame parameter
4162 if (EQ (attr
, QCbackground
))
4163 param
= Qborder_color
;
4165 else if (EQ (face
, Qcursor
))
4167 /* Changing background color of `cursor' sets frame parameter
4169 if (EQ (attr
, QCbackground
))
4170 param
= Qcursor_color
;
4172 else if (EQ (face
, Qmouse
))
4174 /* Changing background color of `mouse' sets frame parameter
4176 if (EQ (attr
, QCbackground
))
4177 param
= Qmouse_color
;
4179 #endif /* HAVE_WINDOW_SYSTEM */
4180 else if (EQ (face
, Qmenu
))
4182 /* Indicate that we have to update the menu bar when
4183 realizing faces on FRAME. FRAME t change the
4184 default for new frames. We do this by setting
4185 setting the flag in new face caches */
4188 struct frame
*f
= XFRAME (frame
);
4189 if (FRAME_FACE_CACHE (f
) == NULL
)
4190 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4191 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4194 menu_face_changed_default
= 1;
4199 /* Update `default-frame-alist', which is used for new frames. */
4201 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4204 /* Update the current frame's parameters. */
4207 cons
= XCAR (Vparam_value_alist
);
4208 XSETCAR (cons
, param
);
4209 XSETCDR (cons
, value
);
4210 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4218 #ifdef HAVE_WINDOW_SYSTEM
4220 /* Set the `font' frame parameter of FRAME determined from `default'
4221 face attributes LFACE. If a face or fontset name is explicitely
4222 specfied in LFACE, use it as is. Otherwise, determine a font name
4223 from the other font-related atrributes of LFACE. In that case, if
4224 there's no matching font, signals an error. */
4227 set_font_frame_param (frame
, lface
)
4228 Lisp_Object frame
, lface
;
4230 struct frame
*f
= XFRAME (frame
);
4232 if (FRAME_WINDOW_P (f
))
4234 Lisp_Object font_name
;
4237 if (STRINGP (LFACE_FONT (lface
)))
4238 font_name
= LFACE_FONT (lface
);
4241 /* Choose a font name that reflects LFACE's attributes and has
4242 the registry and encoding pattern specified in the default
4243 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4244 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4246 error ("No font matches the specified attribute");
4247 font_name
= build_string (font
);
4251 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4256 /* Update the corresponding face when frame parameter PARAM on frame F
4257 has been assigned the value NEW_VALUE. */
4260 update_face_from_frame_parameter (f
, param
, new_value
)
4262 Lisp_Object param
, new_value
;
4266 /* If there are no faces yet, give up. This is the case when called
4267 from Fx_create_frame, and we do the necessary things later in
4268 face-set-after-frame-defaults. */
4269 if (NILP (f
->face_alist
))
4272 if (EQ (param
, Qforeground_color
))
4274 lface
= lface_from_face_name (f
, Qdefault
, 1);
4275 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4276 ? new_value
: Qunspecified
);
4277 realize_basic_faces (f
);
4279 else if (EQ (param
, Qbackground_color
))
4283 /* Changing the background color might change the background
4284 mode, so that we have to load new defface specs. Call
4285 frame-update-face-colors to do that. */
4286 XSETFRAME (frame
, f
);
4287 call1 (Qframe_update_face_colors
, frame
);
4289 lface
= lface_from_face_name (f
, Qdefault
, 1);
4290 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4291 ? new_value
: Qunspecified
);
4292 realize_basic_faces (f
);
4294 if (EQ (param
, Qborder_color
))
4296 lface
= lface_from_face_name (f
, Qborder
, 1);
4297 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4298 ? new_value
: Qunspecified
);
4300 else if (EQ (param
, Qcursor_color
))
4302 lface
= lface_from_face_name (f
, Qcursor
, 1);
4303 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4304 ? new_value
: Qunspecified
);
4306 else if (EQ (param
, Qmouse_color
))
4308 lface
= lface_from_face_name (f
, Qmouse
, 1);
4309 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4310 ? new_value
: Qunspecified
);
4315 /* Get the value of X resource RESOURCE, class CLASS for the display
4316 of frame FRAME. This is here because ordinary `x-get-resource'
4317 doesn't take a frame argument. */
4319 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4320 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4321 (resource
, class, frame
)
4322 Lisp_Object resource
, class, frame
;
4324 Lisp_Object value
= Qnil
;
4327 CHECK_STRING (resource
, 0);
4328 CHECK_STRING (class, 1);
4329 CHECK_LIVE_FRAME (frame
, 2);
4331 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4332 resource
, class, Qnil
, Qnil
);
4334 #endif /* not macintosh */
4335 #endif /* not WINDOWSNT */
4340 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4341 If VALUE is "on" or "true", return t. If VALUE is "off" or
4342 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4343 error; if SIGNAL_P is zero, return 0. */
4346 face_boolean_x_resource_value (value
, signal_p
)
4350 Lisp_Object result
= make_number (0);
4352 xassert (STRINGP (value
));
4354 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4355 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4357 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4358 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4360 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4361 result
= Qunspecified
;
4363 signal_error ("Invalid face attribute value from X resource", value
);
4369 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4370 Finternal_set_lisp_face_attribute_from_resource
,
4371 Sinternal_set_lisp_face_attribute_from_resource
,
4372 3, 4, 0, doc
: /* */)
4373 (face
, attr
, value
, frame
)
4374 Lisp_Object face
, attr
, value
, frame
;
4376 CHECK_SYMBOL (face
, 0);
4377 CHECK_SYMBOL (attr
, 1);
4378 CHECK_STRING (value
, 2);
4380 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4381 value
= Qunspecified
;
4382 else if (EQ (attr
, QCheight
))
4384 value
= Fstring_to_number (value
, make_number (10));
4385 if (XINT (value
) <= 0)
4386 signal_error ("Invalid face height from X resource", value
);
4388 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4389 value
= face_boolean_x_resource_value (value
, 1);
4390 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4391 value
= intern (XSTRING (value
)->data
);
4392 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4393 value
= face_boolean_x_resource_value (value
, 1);
4394 else if (EQ (attr
, QCunderline
)
4395 || EQ (attr
, QCoverline
)
4396 || EQ (attr
, QCstrike_through
)
4397 || EQ (attr
, QCbox
))
4399 Lisp_Object boolean_value
;
4401 /* If the result of face_boolean_x_resource_value is t or nil,
4402 VALUE does NOT specify a color. */
4403 boolean_value
= face_boolean_x_resource_value (value
, 0);
4404 if (SYMBOLP (boolean_value
))
4405 value
= boolean_value
;
4408 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4411 #endif /* HAVE_WINDOW_SYSTEM */
4414 /***********************************************************************
4416 ***********************************************************************/
4418 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4420 /* Make menus on frame F appear as specified by the `menu' face. */
4423 x_update_menu_appearance (f
)
4426 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4430 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4434 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4435 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4436 char *myname
= XSTRING (Vx_resource_name
)->data
;
4439 const char *popup_path
= "popup_menu";
4441 const char *popup_path
= "menu.popup";
4444 if (STRINGP (LFACE_FOREGROUND (lface
)))
4446 sprintf (line
, "%s.%s*foreground: %s",
4448 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4449 XrmPutLineResource (&rdb
, line
);
4450 sprintf (line
, "%s.pane.menubar*foreground: %s",
4451 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4452 XrmPutLineResource (&rdb
, line
);
4456 if (STRINGP (LFACE_BACKGROUND (lface
)))
4458 sprintf (line
, "%s.%s*background: %s",
4460 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4461 XrmPutLineResource (&rdb
, line
);
4462 sprintf (line
, "%s.pane.menubar*background: %s",
4463 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4464 XrmPutLineResource (&rdb
, line
);
4469 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4470 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4471 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4472 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4473 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4474 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4477 const char *suffix
= "List";
4479 const char *suffix
= "";
4481 sprintf (line
, "%s.pane.menubar*font%s: %s",
4482 myname
, suffix
, face
->font_name
);
4483 XrmPutLineResource (&rdb
, line
);
4484 sprintf (line
, "%s.%s*font%s: %s",
4485 myname
, popup_path
, suffix
, face
->font_name
);
4486 XrmPutLineResource (&rdb
, line
);
4490 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4491 free_frame_menubar (f
);
4495 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4499 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4500 Sinternal_get_lisp_face_attribute
,
4502 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4503 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4504 face attribute name, signal an error.
4505 If the optional argument FRAME is given, report on face FACE in that
4506 frame. If FRAME is t, report on the defaults for face FACE (for new
4507 frames). If FRAME is omitted or nil, use the selected frame. */)
4508 (symbol
, keyword
, frame
)
4509 Lisp_Object symbol
, keyword
, frame
;
4511 Lisp_Object lface
, value
= Qnil
;
4513 CHECK_SYMBOL (symbol
, 0);
4514 CHECK_SYMBOL (keyword
, 1);
4517 lface
= lface_from_face_name (NULL
, symbol
, 1);
4521 frame
= selected_frame
;
4522 CHECK_LIVE_FRAME (frame
, 2);
4523 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4526 if (EQ (keyword
, QCfamily
))
4527 value
= LFACE_FAMILY (lface
);
4528 else if (EQ (keyword
, QCheight
))
4529 value
= LFACE_HEIGHT (lface
);
4530 else if (EQ (keyword
, QCweight
))
4531 value
= LFACE_WEIGHT (lface
);
4532 else if (EQ (keyword
, QCslant
))
4533 value
= LFACE_SLANT (lface
);
4534 else if (EQ (keyword
, QCunderline
))
4535 value
= LFACE_UNDERLINE (lface
);
4536 else if (EQ (keyword
, QCoverline
))
4537 value
= LFACE_OVERLINE (lface
);
4538 else if (EQ (keyword
, QCstrike_through
))
4539 value
= LFACE_STRIKE_THROUGH (lface
);
4540 else if (EQ (keyword
, QCbox
))
4541 value
= LFACE_BOX (lface
);
4542 else if (EQ (keyword
, QCinverse_video
)
4543 || EQ (keyword
, QCreverse_video
))
4544 value
= LFACE_INVERSE (lface
);
4545 else if (EQ (keyword
, QCforeground
))
4546 value
= LFACE_FOREGROUND (lface
);
4547 else if (EQ (keyword
, QCbackground
))
4548 value
= LFACE_BACKGROUND (lface
);
4549 else if (EQ (keyword
, QCstipple
))
4550 value
= LFACE_STIPPLE (lface
);
4551 else if (EQ (keyword
, QCwidth
))
4552 value
= LFACE_SWIDTH (lface
);
4553 else if (EQ (keyword
, QCinherit
))
4554 value
= LFACE_INHERIT (lface
);
4555 else if (EQ (keyword
, QCfont
))
4556 value
= LFACE_FONT (lface
);
4558 signal_error ("Invalid face attribute name", keyword
);
4564 DEFUN ("internal-lisp-face-attribute-values",
4565 Finternal_lisp_face_attribute_values
,
4566 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4567 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4568 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4572 Lisp_Object result
= Qnil
;
4574 CHECK_SYMBOL (attr
, 0);
4576 if (EQ (attr
, QCweight
)
4577 || EQ (attr
, QCslant
)
4578 || EQ (attr
, QCwidth
))
4580 /* Extract permissible symbols from tables. */
4581 struct table_entry
*table
;
4584 if (EQ (attr
, QCweight
))
4585 table
= weight_table
, dim
= DIM (weight_table
);
4586 else if (EQ (attr
, QCslant
))
4587 table
= slant_table
, dim
= DIM (slant_table
);
4589 table
= swidth_table
, dim
= DIM (swidth_table
);
4591 for (i
= 0; i
< dim
; ++i
)
4593 Lisp_Object symbol
= *table
[i
].symbol
;
4594 Lisp_Object tail
= result
;
4597 && !EQ (XCAR (tail
), symbol
))
4601 result
= Fcons (symbol
, result
);
4604 else if (EQ (attr
, QCunderline
))
4605 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4606 else if (EQ (attr
, QCoverline
))
4607 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4608 else if (EQ (attr
, QCstrike_through
))
4609 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4610 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4611 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4617 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4618 Sinternal_merge_in_global_face
, 2, 2, 0,
4619 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4620 Default face attributes override any local face attributes. */)
4622 Lisp_Object face
, frame
;
4625 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4627 CHECK_LIVE_FRAME (frame
, 1);
4628 global_lface
= lface_from_face_name (NULL
, face
, 1);
4629 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4630 if (NILP (local_lface
))
4631 local_lface
= Finternal_make_lisp_face (face
, frame
);
4633 /* Make every specified global attribute override the local one.
4634 BEWARE!! This is only used from `face-set-after-frame-default' where
4635 the local frame is defined from default specs in `face-defface-spec'
4636 and those should be overridden by global settings. Hence the strange
4637 "global before local" priority. */
4638 lvec
= XVECTOR (local_lface
)->contents
;
4639 gvec
= XVECTOR (global_lface
)->contents
;
4640 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4641 if (! UNSPECIFIEDP (gvec
[i
]))
4648 /* The following function is implemented for compatibility with 20.2.
4649 The function is used in x-resolve-fonts when it is asked to
4650 return fonts with the same size as the font of a face. This is
4651 done in fontset.el. */
4653 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4654 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4655 If the optional argument FRAME is given, report on face FACE in that frame.
4656 If FRAME is t, report on the defaults for face FACE (for new frames).
4657 The font default for a face is either nil, or a list
4658 of the form (bold), (italic) or (bold italic).
4659 If FRAME is omitted or nil, use the selected frame. */)
4661 Lisp_Object face
, frame
;
4665 Lisp_Object result
= Qnil
;
4666 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4668 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4669 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4670 result
= Fcons (Qbold
, result
);
4672 if (!NILP (LFACE_SLANT (lface
))
4673 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4674 result
= Fcons (Qitalic
, result
);
4680 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4681 int face_id
= lookup_named_face (f
, face
, 0);
4682 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4683 return face
? build_string (face
->font_name
) : Qnil
;
4688 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4689 all attributes are `equal'. Tries to be fast because this function
4690 is called quite often. */
4693 lface_equal_p (v1
, v2
)
4694 Lisp_Object
*v1
, *v2
;
4698 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4700 Lisp_Object a
= v1
[i
];
4701 Lisp_Object b
= v2
[i
];
4703 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4704 and the other is specified. */
4705 equal_p
= XTYPE (a
) == XTYPE (b
);
4714 equal_p
= ((STRING_BYTES (XSTRING (a
))
4715 == STRING_BYTES (XSTRING (b
)))
4716 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4717 STRING_BYTES (XSTRING (a
))) == 0);
4726 equal_p
= !NILP (Fequal (a
, b
));
4736 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4737 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4738 doc
: /* True if FACE1 and FACE2 are equal.
4739 If the optional argument FRAME is given, report on face FACE in that frame.
4740 If FRAME is t, report on the defaults for face FACE (for new frames).
4741 If FRAME is omitted or nil, use the selected frame. */)
4742 (face1
, face2
, frame
)
4743 Lisp_Object face1
, face2
, frame
;
4747 Lisp_Object lface1
, lface2
;
4752 /* Don't use check_x_frame here because this function is called
4753 before X frames exist. At that time, if FRAME is nil,
4754 selected_frame will be used which is the frame dumped with
4755 Emacs. That frame is not an X frame. */
4756 f
= frame_or_selected_frame (frame
, 2);
4758 lface1
= lface_from_face_name (NULL
, face1
, 1);
4759 lface2
= lface_from_face_name (NULL
, face2
, 1);
4760 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4761 XVECTOR (lface2
)->contents
);
4762 return equal_p
? Qt
: Qnil
;
4766 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4767 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4768 doc
: /* True if FACE has no attribute specified.
4769 If the optional argument FRAME is given, report on face FACE in that frame.
4770 If FRAME is t, report on the defaults for face FACE (for new frames).
4771 If FRAME is omitted or nil, use the selected frame. */)
4773 Lisp_Object face
, frame
;
4780 frame
= selected_frame
;
4781 CHECK_LIVE_FRAME (frame
, 0);
4785 lface
= lface_from_face_name (NULL
, face
, 1);
4787 lface
= lface_from_face_name (f
, face
, 1);
4789 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4790 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4793 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4797 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4799 doc
: /* Return an alist of frame-local faces defined on FRAME.
4800 For internal use only. */)
4804 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4805 return f
->face_alist
;
4809 /* Return a hash code for Lisp string STRING with case ignored. Used
4810 below in computing a hash value for a Lisp face. */
4812 static INLINE
unsigned
4813 hash_string_case_insensitive (string
)
4818 xassert (STRINGP (string
));
4819 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4820 hash
= (hash
<< 1) ^ tolower (*s
);
4825 /* Return a hash code for face attribute vector V. */
4827 static INLINE
unsigned
4831 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4832 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4833 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4834 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4835 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4836 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4837 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4841 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4842 considering charsets/registries). They do if they specify the same
4843 family, point size, weight, width, slant, and fontset. Both LFACE1
4844 and LFACE2 must be fully-specified. */
4847 lface_same_font_attributes_p (lface1
, lface2
)
4848 Lisp_Object
*lface1
, *lface2
;
4850 xassert (lface_fully_specified_p (lface1
)
4851 && lface_fully_specified_p (lface2
));
4852 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4853 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4854 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4855 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4856 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4857 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4858 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4859 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4860 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4861 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4862 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4863 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4868 /***********************************************************************
4870 ***********************************************************************/
4872 /* Allocate and return a new realized face for Lisp face attribute
4875 static struct face
*
4876 make_realized_face (attr
)
4879 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4880 bzero (face
, sizeof *face
);
4881 face
->ascii_face
= face
;
4882 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4887 /* Free realized face FACE, including its X resources. FACE may
4891 free_realized_face (f
, face
)
4897 #ifdef HAVE_WINDOW_SYSTEM
4898 if (FRAME_WINDOW_P (f
))
4900 /* Free fontset of FACE if it is ASCII face. */
4901 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4902 free_face_fontset (f
, face
);
4905 x_free_gc (f
, face
->gc
);
4909 free_face_colors (f
, face
);
4910 x_destroy_bitmap (f
, face
->stipple
);
4912 #endif /* HAVE_WINDOW_SYSTEM */
4919 /* Prepare face FACE for subsequent display on frame F. This
4920 allocated GCs if they haven't been allocated yet or have been freed
4921 by clearing the face cache. */
4924 prepare_face_for_display (f
, face
)
4928 #ifdef HAVE_WINDOW_SYSTEM
4929 xassert (FRAME_WINDOW_P (f
));
4934 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4936 xgcv
.foreground
= face
->foreground
;
4937 xgcv
.background
= face
->background
;
4938 #ifdef HAVE_X_WINDOWS
4939 xgcv
.graphics_exposures
= False
;
4941 /* The font of FACE may be null if we couldn't load it. */
4944 #ifdef HAVE_X_WINDOWS
4945 xgcv
.font
= face
->font
->fid
;
4948 xgcv
.font
= face
->font
;
4951 xgcv
.font
= face
->font
;
4957 #ifdef HAVE_X_WINDOWS
4960 xgcv
.fill_style
= FillOpaqueStippled
;
4961 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4962 mask
|= GCFillStyle
| GCStipple
;
4965 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4968 #endif /* HAVE_WINDOW_SYSTEM */
4972 /***********************************************************************
4974 ***********************************************************************/
4976 /* Return a new face cache for frame F. */
4978 static struct face_cache
*
4982 struct face_cache
*c
;
4985 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4986 bzero (c
, sizeof *c
);
4987 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4988 c
->buckets
= (struct face
**) xmalloc (size
);
4989 bzero (c
->buckets
, size
);
4991 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4993 c
->menu_face_changed_p
= menu_face_changed_default
;
4998 /* Clear out all graphics contexts for all realized faces, except for
4999 the basic faces. This should be done from time to time just to avoid
5000 keeping too many graphics contexts that are no longer needed. */
5004 struct face_cache
*c
;
5006 if (c
&& FRAME_WINDOW_P (c
->f
))
5008 #ifdef HAVE_WINDOW_SYSTEM
5010 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5012 struct face
*face
= c
->faces_by_id
[i
];
5013 if (face
&& face
->gc
)
5015 x_free_gc (c
->f
, face
->gc
);
5019 #endif /* HAVE_WINDOW_SYSTEM */
5024 /* Free all realized faces in face cache C, including basic faces. C
5025 may be null. If faces are freed, make sure the frame's current
5026 matrix is marked invalid, so that a display caused by an expose
5027 event doesn't try to use faces we destroyed. */
5030 free_realized_faces (c
)
5031 struct face_cache
*c
;
5036 struct frame
*f
= c
->f
;
5038 /* We must block input here because we can't process X events
5039 safely while only some faces are freed, or when the frame's
5040 current matrix still references freed faces. */
5043 for (i
= 0; i
< c
->used
; ++i
)
5045 free_realized_face (f
, c
->faces_by_id
[i
]);
5046 c
->faces_by_id
[i
] = NULL
;
5050 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5051 bzero (c
->buckets
, size
);
5053 /* Must do a thorough redisplay the next time. Mark current
5054 matrices as invalid because they will reference faces freed
5055 above. This function is also called when a frame is
5056 destroyed. In this case, the root window of F is nil. */
5057 if (WINDOWP (f
->root_window
))
5059 clear_current_matrices (f
);
5060 ++windows_or_buffers_changed
;
5068 /* Free all faces realized for multibyte characters on frame F that
5072 free_realized_multibyte_face (f
, fontset
)
5076 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5080 /* We must block input here because we can't process X events safely
5081 while only some faces are freed, or when the frame's current
5082 matrix still references freed faces. */
5085 for (i
= 0; i
< cache
->used
; i
++)
5087 face
= cache
->faces_by_id
[i
];
5089 && face
!= face
->ascii_face
5090 && face
->fontset
== fontset
)
5092 uncache_face (cache
, face
);
5093 free_realized_face (f
, face
);
5097 /* Must do a thorough redisplay the next time. Mark current
5098 matrices as invalid because they will reference faces freed
5099 above. This function is also called when a frame is destroyed.
5100 In this case, the root window of F is nil. */
5101 if (WINDOWP (f
->root_window
))
5103 clear_current_matrices (f
);
5104 ++windows_or_buffers_changed
;
5111 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5112 This is done after attributes of a named face have been changed,
5113 because we can't tell which realized faces depend on that face. */
5116 free_all_realized_faces (frame
)
5122 FOR_EACH_FRAME (rest
, frame
)
5123 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5126 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5130 /* Free face cache C and faces in it, including their X resources. */
5134 struct face_cache
*c
;
5138 free_realized_faces (c
);
5140 xfree (c
->faces_by_id
);
5146 /* Cache realized face FACE in face cache C. HASH is the hash value
5147 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5148 collision list of the face hash table of C. This is done because
5149 otherwise lookup_face would find FACE for every character, even if
5150 faces with the same attributes but for specific characters exist. */
5153 cache_face (c
, face
, hash
)
5154 struct face_cache
*c
;
5158 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5162 if (face
->fontset
>= 0)
5164 struct face
*last
= c
->buckets
[i
];
5175 c
->buckets
[i
] = face
;
5176 face
->prev
= face
->next
= NULL
;
5182 face
->next
= c
->buckets
[i
];
5184 face
->next
->prev
= face
;
5185 c
->buckets
[i
] = face
;
5188 /* Find a free slot in C->faces_by_id and use the index of the free
5189 slot as FACE->id. */
5190 for (i
= 0; i
< c
->used
; ++i
)
5191 if (c
->faces_by_id
[i
] == NULL
)
5195 /* Maybe enlarge C->faces_by_id. */
5196 if (i
== c
->used
&& c
->used
== c
->size
)
5198 int new_size
= 2 * c
->size
;
5199 int sz
= new_size
* sizeof *c
->faces_by_id
;
5200 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5205 /* Check that FACE got a unique id. */
5210 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5211 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5217 #endif /* GLYPH_DEBUG */
5219 c
->faces_by_id
[i
] = face
;
5225 /* Remove face FACE from cache C. */
5228 uncache_face (c
, face
)
5229 struct face_cache
*c
;
5232 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5235 face
->prev
->next
= face
->next
;
5237 c
->buckets
[i
] = face
->next
;
5240 face
->next
->prev
= face
->prev
;
5242 c
->faces_by_id
[face
->id
] = NULL
;
5243 if (face
->id
== c
->used
)
5248 /* Look up a realized face with face attributes ATTR in the face cache
5249 of frame F. The face will be used to display character C. Value
5250 is the ID of the face found. If no suitable face is found, realize
5251 a new one. In that case, if C is a multibyte character, BASE_FACE
5252 is a face that has the same attributes. */
5255 lookup_face (f
, attr
, c
, base_face
)
5259 struct face
*base_face
;
5261 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5266 xassert (cache
!= NULL
);
5267 check_lface_attrs (attr
);
5269 /* Look up ATTR in the face cache. */
5270 hash
= lface_hash (attr
);
5271 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5273 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5274 if (face
->hash
== hash
5275 && (!FRAME_WINDOW_P (f
)
5276 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5277 && lface_equal_p (face
->lface
, attr
))
5280 /* If not found, realize a new face. */
5282 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5285 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5287 /* When this function is called from face_for_char (in this case, C is
5288 a multibyte character), a fontset of a face returned by
5289 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5290 C) is not sutisfied. The fontset is set for this face by
5291 face_for_char later. */
5293 if (FRAME_WINDOW_P (f
))
5294 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5296 #endif /* GLYPH_DEBUG */
5302 /* Return the face id of the realized face for named face SYMBOL on
5303 frame F suitable for displaying character C. Value is -1 if the
5304 face couldn't be determined, which might happen if the default face
5305 isn't realized and cannot be realized. */
5308 lookup_named_face (f
, symbol
, c
)
5313 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5314 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5315 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5317 if (default_face
== NULL
)
5319 if (!realize_basic_faces (f
))
5321 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5324 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5325 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5326 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5327 return lookup_face (f
, attrs
, c
, NULL
);
5331 /* Return the ID of the realized ASCII face of Lisp face with ID
5332 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5335 ascii_face_of_lisp_face (f
, lface_id
)
5341 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5343 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5344 face_id
= lookup_named_face (f
, face_name
, 0);
5353 /* Return a face for charset ASCII that is like the face with id
5354 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5355 STEPS < 0 means larger. Value is the id of the face. */
5358 smaller_face (f
, face_id
, steps
)
5362 #ifdef HAVE_WINDOW_SYSTEM
5364 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5365 int pt
, last_pt
, last_height
;
5368 struct face
*new_face
;
5370 /* If not called for an X frame, just return the original face. */
5371 if (FRAME_TERMCAP_P (f
))
5374 /* Try in increments of 1/2 pt. */
5375 delta
= steps
< 0 ? 5 : -5;
5376 steps
= abs (steps
);
5378 face
= FACE_FROM_ID (f
, face_id
);
5379 bcopy (face
->lface
, attrs
, sizeof attrs
);
5380 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5381 new_face_id
= face_id
;
5382 last_height
= FONT_HEIGHT (face
->font
);
5386 /* Give up if we cannot find a font within 10pt. */
5387 && abs (last_pt
- pt
) < 100)
5389 /* Look up a face for a slightly smaller/larger font. */
5391 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5392 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5393 new_face
= FACE_FROM_ID (f
, new_face_id
);
5395 /* If height changes, count that as one step. */
5396 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5397 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5400 last_height
= FONT_HEIGHT (new_face
->font
);
5407 #else /* not HAVE_WINDOW_SYSTEM */
5411 #endif /* not HAVE_WINDOW_SYSTEM */
5415 /* Return a face for charset ASCII that is like the face with id
5416 FACE_ID on frame F, but has height HEIGHT. */
5419 face_with_height (f
, face_id
, height
)
5424 #ifdef HAVE_WINDOW_SYSTEM
5426 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5428 if (FRAME_TERMCAP_P (f
)
5432 face
= FACE_FROM_ID (f
, face_id
);
5433 bcopy (face
->lface
, attrs
, sizeof attrs
);
5434 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5435 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5436 #endif /* HAVE_WINDOW_SYSTEM */
5442 /* Return the face id of the realized face for named face SYMBOL on
5443 frame F suitable for displaying character C, and use attributes of
5444 the face FACE_ID for attributes that aren't completely specified by
5445 SYMBOL. This is like lookup_named_face, except that the default
5446 attributes come from FACE_ID, not from the default face. FACE_ID
5447 is assumed to be already realized. */
5450 lookup_derived_face (f
, symbol
, c
, face_id
)
5456 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5457 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5458 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5463 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5464 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5465 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5466 return lookup_face (f
, attrs
, c
, default_face
);
5471 /***********************************************************************
5473 ***********************************************************************/
5475 DEFUN ("internal-set-font-selection-order",
5476 Finternal_set_font_selection_order
,
5477 Sinternal_set_font_selection_order
, 1, 1, 0,
5478 doc
: /* Set font selection order for face font selection to ORDER.
5479 ORDER must be a list of length 4 containing the symbols `:width',
5480 `:height', `:weight', and `:slant'. Face attributes appearing
5481 first in ORDER are matched first, e.g. if `:height' appears before
5482 `:weight' in ORDER, font selection first tries to find a font with
5483 a suitable height, and then tries to match the font weight.
5490 int indices
[DIM (font_sort_order
)];
5492 CHECK_LIST (order
, 0);
5493 bzero (indices
, sizeof indices
);
5497 CONSP (list
) && i
< DIM (indices
);
5498 list
= XCDR (list
), ++i
)
5500 Lisp_Object attr
= XCAR (list
);
5503 if (EQ (attr
, QCwidth
))
5505 else if (EQ (attr
, QCheight
))
5506 xlfd
= XLFD_POINT_SIZE
;
5507 else if (EQ (attr
, QCweight
))
5509 else if (EQ (attr
, QCslant
))
5514 if (indices
[i
] != 0)
5519 if (!NILP (list
) || i
!= DIM (indices
))
5520 signal_error ("Invalid font sort order", order
);
5521 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5522 if (indices
[i
] == 0)
5523 signal_error ("Invalid font sort order", order
);
5525 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5527 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5528 free_all_realized_faces (Qnil
);
5535 DEFUN ("internal-set-alternative-font-family-alist",
5536 Finternal_set_alternative_font_family_alist
,
5537 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5538 doc
: /* Define alternative font families to try in face font selection.
5539 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5540 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5541 be found. Value is ALIST. */)
5545 CHECK_LIST (alist
, 0);
5546 Vface_alternative_font_family_alist
= alist
;
5547 free_all_realized_faces (Qnil
);
5552 DEFUN ("internal-set-alternative-font-registry-alist",
5553 Finternal_set_alternative_font_registry_alist
,
5554 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5555 doc
: /* Define alternative font registries to try in face font selection.
5556 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5557 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5558 be found. Value is ALIST. */)
5562 CHECK_LIST (alist
, 0);
5563 Vface_alternative_font_registry_alist
= alist
;
5564 free_all_realized_faces (Qnil
);
5569 #ifdef HAVE_WINDOW_SYSTEM
5571 /* Value is non-zero if FONT is the name of a scalable font. The
5572 X11R6 XLFD spec says that point size, pixel size, and average width
5573 are zero for scalable fonts. Intlfonts contain at least one
5574 scalable font ("*-muleindian-1") for which this isn't true, so we
5575 just test average width. */
5578 font_scalable_p (font
)
5579 struct font_name
*font
;
5581 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5582 return (*s
== '0' && *(s
+ 1) == '\0')
5584 /* Windows implementation of XLFD is slightly broken for backward
5585 compatibility with previous broken versions, so test for
5586 wildcards as well as 0. */
5593 /* Ignore the difference of font point size less than this value. */
5595 #define FONT_POINT_SIZE_QUANTUM 5
5597 /* Value is non-zero if FONT1 is a better match for font attributes
5598 VALUES than FONT2. VALUES is an array of face attribute values in
5599 font sort order. COMPARE_PT_P zero means don't compare point
5600 sizes. AVGWIDTH, if not zero, is a specified font average width
5604 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5606 struct font_name
*font1
, *font2
;
5607 int compare_pt_p
, avgwidth
;
5611 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5613 int xlfd_idx
= font_sort_order
[i
];
5615 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5617 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5618 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5620 if (xlfd_idx
== XLFD_POINT_SIZE
5621 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5623 if (delta1
> delta2
)
5625 else if (delta1
< delta2
)
5629 /* The difference may be equal because, e.g., the face
5630 specifies `italic' but we have only `regular' and
5631 `oblique'. Prefer `oblique' in this case. */
5632 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5633 && font1
->numeric
[xlfd_idx
] > values
[i
]
5634 && font2
->numeric
[xlfd_idx
] < values
[i
])
5642 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5643 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5644 if (delta1
> delta2
)
5646 else if (delta1
< delta2
)
5650 return font1
->registry_priority
< font2
->registry_priority
;
5654 /* Value is non-zero if FONT is an exact match for face attributes in
5655 SPECIFIED. SPECIFIED is an array of face attribute values in font
5656 sort order. AVGWIDTH, if non-zero, is an average width to compare
5660 exact_face_match_p (specified
, font
, avgwidth
)
5662 struct font_name
*font
;
5667 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5668 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5671 return (i
== DIM (font_sort_order
)
5673 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5677 /* Value is the name of a scaled font, generated from scalable font
5678 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5679 Value is allocated from heap. */
5682 build_scalable_font_name (f
, font
, specified_pt
)
5684 struct font_name
*font
;
5687 char point_size
[20], pixel_size
[20];
5689 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5692 /* If scalable font is for a specific resolution, compute
5693 the point size we must specify from the resolution of
5694 the display and the specified resolution of the font. */
5695 if (font
->numeric
[XLFD_RESY
] != 0)
5697 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5698 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5703 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5706 /* Set point size of the font. */
5707 sprintf (point_size
, "%d", (int) pt
);
5708 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5709 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5711 /* Set pixel size. */
5712 sprintf (pixel_size
, "%d", pixel_value
);
5713 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5714 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5716 /* If font doesn't specify its resolution, use the
5717 resolution of the display. */
5718 if (font
->numeric
[XLFD_RESY
] == 0)
5721 sprintf (buffer
, "%d", (int) resy
);
5722 font
->fields
[XLFD_RESY
] = buffer
;
5723 font
->numeric
[XLFD_RESY
] = resy
;
5726 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5729 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5730 sprintf (buffer
, "%d", resx
);
5731 font
->fields
[XLFD_RESX
] = buffer
;
5732 font
->numeric
[XLFD_RESX
] = resx
;
5735 return build_font_name (font
);
5739 /* Value is non-zero if we are allowed to use scalable font FONT. We
5740 can't run a Lisp function here since this function may be called
5741 with input blocked. */
5744 may_use_scalable_font_p (font
)
5747 if (EQ (Vscalable_fonts_allowed
, Qt
))
5749 else if (CONSP (Vscalable_fonts_allowed
))
5751 Lisp_Object tail
, regexp
;
5753 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5755 regexp
= XCAR (tail
);
5756 if (STRINGP (regexp
)
5757 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5767 /* Return the name of the best matching font for face attributes ATTRS
5768 in the array of font_name structures FONTS which contains NFONTS
5769 elements. WIDTH_RATIO is a factor with which to multiply average
5770 widths if ATTRS specifies such a width.
5772 Value is a font name which is allocated from the heap. FONTS is
5773 freed by this function. */
5776 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5779 struct font_name
*fonts
;
5784 struct font_name
*best
;
5787 int exact_p
, avgwidth
;
5792 /* Make specified font attributes available in `specified',
5793 indexed by sort order. */
5794 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5796 int xlfd_idx
= font_sort_order
[i
];
5798 if (xlfd_idx
== XLFD_SWIDTH
)
5799 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5800 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5801 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5802 else if (xlfd_idx
== XLFD_WEIGHT
)
5803 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5804 else if (xlfd_idx
== XLFD_SLANT
)
5805 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5810 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5812 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5816 /* Start with the first non-scalable font in the list. */
5817 for (i
= 0; i
< nfonts
; ++i
)
5818 if (!font_scalable_p (fonts
+ i
))
5821 /* Find the best match among the non-scalable fonts. */
5826 for (i
= 1; i
< nfonts
; ++i
)
5827 if (!font_scalable_p (fonts
+ i
)
5828 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5832 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5841 /* Unless we found an exact match among non-scalable fonts, see if
5842 we can find a better match among scalable fonts. */
5845 /* A scalable font is better if
5847 1. its weight, slant, swidth attributes are better, or.
5849 2. the best non-scalable font doesn't have the required
5850 point size, and the scalable fonts weight, slant, swidth
5853 int non_scalable_has_exact_height_p
;
5855 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5856 non_scalable_has_exact_height_p
= 1;
5858 non_scalable_has_exact_height_p
= 0;
5860 for (i
= 0; i
< nfonts
; ++i
)
5861 if (font_scalable_p (fonts
+ i
))
5864 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5865 || (!non_scalable_has_exact_height_p
5866 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5871 if (font_scalable_p (best
))
5872 font_name
= build_scalable_font_name (f
, best
, pt
);
5874 font_name
= build_font_name (best
);
5876 /* Free font_name structures. */
5877 free_font_names (fonts
, nfonts
);
5883 /* Get a list of matching fonts on frame F, considering FAMILY
5884 and alternative font families from Vface_alternative_font_registry_alist.
5886 FAMILY is the font family whose alternatives are considered.
5888 REGISTRY, if a string, specifies a font registry and encoding to
5889 match. A value of nil means include fonts of any registry and
5892 Return in *FONTS a pointer to a vector of font_name structures for
5893 the fonts matched. Value is the number of fonts found. */
5896 try_alternative_families (f
, family
, registry
, fonts
)
5898 Lisp_Object family
, registry
;
5899 struct font_name
**fonts
;
5904 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5907 /* Try alternative font families. */
5908 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5911 for (alter
= XCDR (alter
);
5912 CONSP (alter
) && nfonts
== 0;
5913 alter
= XCDR (alter
))
5915 if (STRINGP (XCAR (alter
)))
5916 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5920 /* Try scalable fonts before giving up. */
5921 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5923 int count
= BINDING_STACK_SIZE ();
5924 specbind (Qscalable_fonts_allowed
, Qt
);
5925 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5926 unbind_to (count
, Qnil
);
5933 /* Get a list of matching fonts on frame F.
5935 FAMILY, if a string, specifies a font family derived from the fontset.
5936 It is only used if the face does not specify any family in ATTRS or
5937 if we cannot find any font of the face's family.
5939 REGISTRY, if a string, specifies a font registry and encoding to
5940 match. A value of nil means include fonts of any registry and
5943 Return in *FONTS a pointer to a vector of font_name structures for
5944 the fonts matched. Value is the number of fonts found. */
5947 try_font_list (f
, attrs
, family
, registry
, fonts
)
5950 Lisp_Object family
, registry
;
5951 struct font_name
**fonts
;
5954 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
5956 if (STRINGP (face_family
))
5957 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
5959 if (nfonts
== 0 && !NILP (family
))
5960 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5962 /* Try font family of the default face or "fixed". */
5965 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5967 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
5969 family
= build_string ("fixed");
5970 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5973 /* Try any family with the given registry. */
5975 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5981 /* Return the fontset id of the base fontset name or alias name given
5982 by the fontset attribute of ATTRS. Value is -1 if the fontset
5983 attribute of ATTRS doesn't name a fontset. */
5986 face_fontset (attrs
)
5991 name
= attrs
[LFACE_FONT_INDEX
];
5992 if (!STRINGP (name
))
5994 return fs_query_fontset (name
, 0);
5998 /* Choose a name of font to use on frame F to display character C with
5999 Lisp face attributes specified by ATTRS. The font name is
6000 determined by the font-related attributes in ATTRS and the name
6001 pattern for C in FONTSET. Value is the font name which is
6002 allocated from the heap and must be freed by the caller, or NULL if
6003 we can get no information about the font name of C. It is assured
6004 that we always get some information for a single byte
6008 choose_face_font (f
, attrs
, fontset
, c
)
6013 Lisp_Object pattern
;
6014 char *font_name
= NULL
;
6015 struct font_name
*fonts
;
6016 int nfonts
, width_ratio
;
6018 /* Get (foundry and) family name and registry (and encoding) name of
6020 pattern
= fontset_font_pattern (f
, fontset
, c
);
6023 xassert (!SINGLE_BYTE_CHAR_P (c
));
6027 /* If what we got is a name pattern, return it. */
6028 if (STRINGP (pattern
))
6029 return xstrdup (XSTRING (pattern
)->data
);
6031 /* Get a list of fonts matching that pattern and choose the
6032 best match for the specified face attributes from it. */
6033 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6034 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6036 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6037 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6041 #endif /* HAVE_WINDOW_SYSTEM */
6045 /***********************************************************************
6047 ***********************************************************************/
6049 /* Realize basic faces on frame F. Value is zero if frame parameters
6050 of F don't contain enough information needed to realize the default
6054 realize_basic_faces (f
)
6058 int count
= BINDING_STACK_SIZE ();
6060 /* Block input here so that we won't be surprised by an X expose
6061 event, for instance, without having the faces set up. */
6063 specbind (Qscalable_fonts_allowed
, Qt
);
6065 if (realize_default_face (f
))
6067 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6068 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6069 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6070 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6071 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6072 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6073 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6074 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6075 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6077 /* Reflect changes in the `menu' face in menu bars. */
6078 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6080 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6081 #ifdef USE_X_TOOLKIT
6082 x_update_menu_appearance (f
);
6089 unbind_to (count
, Qnil
);
6095 /* Realize the default face on frame F. If the face is not fully
6096 specified, make it fully-specified. Attributes of the default face
6097 that are not explicitly specified are taken from frame parameters. */
6100 realize_default_face (f
)
6103 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6105 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6106 Lisp_Object frame_font
;
6109 /* If the `default' face is not yet known, create it. */
6110 lface
= lface_from_face_name (f
, Qdefault
, 0);
6114 XSETFRAME (frame
, f
);
6115 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6118 #ifdef HAVE_WINDOW_SYSTEM
6119 if (FRAME_WINDOW_P (f
))
6121 /* Set frame_font to the value of the `font' frame parameter. */
6122 frame_font
= Fassq (Qfont
, f
->param_alist
);
6123 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6124 frame_font
= XCDR (frame_font
);
6125 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6127 #endif /* HAVE_WINDOW_SYSTEM */
6129 if (!FRAME_WINDOW_P (f
))
6131 LFACE_FAMILY (lface
) = build_string ("default");
6132 LFACE_SWIDTH (lface
) = Qnormal
;
6133 LFACE_HEIGHT (lface
) = make_number (1);
6134 LFACE_WEIGHT (lface
) = Qnormal
;
6135 LFACE_SLANT (lface
) = Qnormal
;
6136 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6139 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6140 LFACE_UNDERLINE (lface
) = Qnil
;
6142 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6143 LFACE_OVERLINE (lface
) = Qnil
;
6145 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6146 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6148 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6149 LFACE_BOX (lface
) = Qnil
;
6151 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6152 LFACE_INVERSE (lface
) = Qnil
;
6154 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6156 /* This function is called so early that colors are not yet
6157 set in the frame parameter list. */
6158 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6160 if (CONSP (color
) && STRINGP (XCDR (color
)))
6161 LFACE_FOREGROUND (lface
) = XCDR (color
);
6162 else if (FRAME_WINDOW_P (f
))
6164 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6165 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6170 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6172 /* This function is called so early that colors are not yet
6173 set in the frame parameter list. */
6174 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6175 if (CONSP (color
) && STRINGP (XCDR (color
)))
6176 LFACE_BACKGROUND (lface
) = XCDR (color
);
6177 else if (FRAME_WINDOW_P (f
))
6179 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6180 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6185 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6186 LFACE_STIPPLE (lface
) = Qnil
;
6188 /* Realize the face; it must be fully-specified now. */
6189 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6190 check_lface (lface
);
6191 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6192 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6197 /* Realize basic faces other than the default face in face cache C.
6198 SYMBOL is the face name, ID is the face id the realized face must
6199 have. The default face must have been realized already. */
6202 realize_named_face (f
, symbol
, id
)
6207 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6208 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6209 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6210 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6211 struct face
*new_face
;
6213 /* The default face must exist and be fully specified. */
6214 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6215 check_lface_attrs (attrs
);
6216 xassert (lface_fully_specified_p (attrs
));
6218 /* If SYMBOL isn't know as a face, create it. */
6222 XSETFRAME (frame
, f
);
6223 lface
= Finternal_make_lisp_face (symbol
, frame
);
6226 /* Merge SYMBOL's face with the default face. */
6227 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6228 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6230 /* Realize the face. */
6231 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6235 /* Realize the fully-specified face with attributes ATTRS in face
6236 cache CACHE for character C. If C is a multibyte character,
6237 BASE_FACE is a face that has the same attributes. Otherwise,
6238 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6239 ID of face to remove before caching the new face. Value is a
6240 pointer to the newly created realized face. */
6242 static struct face
*
6243 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6244 struct face_cache
*cache
;
6247 struct face
*base_face
;
6252 /* LFACE must be fully specified. */
6253 xassert (cache
!= NULL
);
6254 check_lface_attrs (attrs
);
6256 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6258 /* Remove the former face. */
6259 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6260 uncache_face (cache
, former_face
);
6261 free_realized_face (cache
->f
, former_face
);
6264 if (FRAME_WINDOW_P (cache
->f
))
6265 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6266 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6267 face
= realize_tty_face (cache
, attrs
, c
);
6271 /* Insert the new face. */
6272 cache_face (cache
, face
, lface_hash (attrs
));
6273 #ifdef HAVE_WINDOW_SYSTEM
6274 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6275 load_face_font (cache
->f
, face
, c
);
6276 #endif /* HAVE_WINDOW_SYSTEM */
6281 /* Realize the fully-specified face with attributes ATTRS in face
6282 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6283 a multibyte character, BASE_FACE is a face that has the same
6284 attributes. Otherwise, BASE_FACE is ignored. If the new face
6285 doesn't share font with the default face, a fontname is allocated
6286 from the heap and set in `font_name' of the new face, but it is not
6287 yet loaded here. Value is a pointer to the newly created realized
6290 static struct face
*
6291 realize_x_face (cache
, attrs
, c
, base_face
)
6292 struct face_cache
*cache
;
6295 struct face
*base_face
;
6297 #ifdef HAVE_WINDOW_SYSTEM
6298 struct face
*face
, *default_face
;
6300 Lisp_Object stipple
, overline
, strike_through
, box
;
6302 xassert (FRAME_WINDOW_P (cache
->f
));
6303 xassert (SINGLE_BYTE_CHAR_P (c
)
6306 /* Allocate a new realized face. */
6307 face
= make_realized_face (attrs
);
6311 /* If C is a multibyte character, we share all face attirbutes with
6312 BASE_FACE including the realized fontset. But, we must load a
6314 if (!SINGLE_BYTE_CHAR_P (c
))
6316 bcopy (base_face
, face
, sizeof *face
);
6319 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6320 face
->foreground_defaulted_p
= 1;
6321 face
->background_defaulted_p
= 1;
6322 face
->underline_defaulted_p
= 1;
6323 face
->overline_color_defaulted_p
= 1;
6324 face
->strike_through_color_defaulted_p
= 1;
6325 face
->box_color_defaulted_p
= 1;
6327 /* to force realize_face to load font */
6332 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6334 /* Determine the font to use. Most of the time, the font will be
6335 the same as the font of the default face, so try that first. */
6336 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6338 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6339 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6341 face
->font
= default_face
->font
;
6342 face
->fontset
= default_face
->fontset
;
6343 face
->font_info_id
= default_face
->font_info_id
;
6344 face
->font_name
= default_face
->font_name
;
6345 face
->ascii_face
= face
;
6347 /* But, as we can't share the fontset, make a new realized
6348 fontset that has the same base fontset as of the default
6351 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6355 /* If the face attribute ATTRS specifies a fontset, use it as
6356 the base of a new realized fontset. Otherwise, use the same
6357 base fontset as of the default face. The base determines
6358 registry and encoding of a font. It may also determine
6359 foundry and family. The other fields of font name pattern
6360 are constructed from ATTRS. */
6361 int fontset
= face_fontset (attrs
);
6363 if ((fontset
== -1) && default_face
)
6364 fontset
= default_face
->fontset
;
6365 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6366 face
->font
= NULL
; /* to force realize_face to load font */
6369 /* Load the font if it is specified in ATTRS. This fixes
6370 changing frame font on the Mac. */
6371 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6373 struct font_info
*font_info
=
6374 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6376 face
->font
= font_info
->font
;
6381 /* Load colors, and set remaining attributes. */
6383 load_face_colors (f
, face
, attrs
);
6386 box
= attrs
[LFACE_BOX_INDEX
];
6389 /* A simple box of line width 1 drawn in color given by
6391 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6393 face
->box
= FACE_SIMPLE_BOX
;
6394 face
->box_line_width
= 1;
6396 else if (INTEGERP (box
))
6398 /* Simple box of specified line width in foreground color of the
6400 xassert (XINT (box
) != 0);
6401 face
->box
= FACE_SIMPLE_BOX
;
6402 face
->box_line_width
= XINT (box
);
6403 face
->box_color
= face
->foreground
;
6404 face
->box_color_defaulted_p
= 1;
6406 else if (CONSP (box
))
6408 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6409 being one of `raised' or `sunken'. */
6410 face
->box
= FACE_SIMPLE_BOX
;
6411 face
->box_color
= face
->foreground
;
6412 face
->box_color_defaulted_p
= 1;
6413 face
->box_line_width
= 1;
6417 Lisp_Object keyword
, value
;
6419 keyword
= XCAR (box
);
6427 if (EQ (keyword
, QCline_width
))
6429 if (INTEGERP (value
) && XINT (value
) != 0)
6430 face
->box_line_width
= XINT (value
);
6432 else if (EQ (keyword
, QCcolor
))
6434 if (STRINGP (value
))
6436 face
->box_color
= load_color (f
, face
, value
,
6438 face
->use_box_color_for_shadows_p
= 1;
6441 else if (EQ (keyword
, QCstyle
))
6443 if (EQ (value
, Qreleased_button
))
6444 face
->box
= FACE_RAISED_BOX
;
6445 else if (EQ (value
, Qpressed_button
))
6446 face
->box
= FACE_SUNKEN_BOX
;
6451 /* Text underline, overline, strike-through. */
6453 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6455 /* Use default color (same as foreground color). */
6456 face
->underline_p
= 1;
6457 face
->underline_defaulted_p
= 1;
6458 face
->underline_color
= 0;
6460 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6462 /* Use specified color. */
6463 face
->underline_p
= 1;
6464 face
->underline_defaulted_p
= 0;
6465 face
->underline_color
6466 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6467 LFACE_UNDERLINE_INDEX
);
6469 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6471 face
->underline_p
= 0;
6472 face
->underline_defaulted_p
= 0;
6473 face
->underline_color
= 0;
6476 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6477 if (STRINGP (overline
))
6479 face
->overline_color
6480 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6481 LFACE_OVERLINE_INDEX
);
6482 face
->overline_p
= 1;
6484 else if (EQ (overline
, Qt
))
6486 face
->overline_color
= face
->foreground
;
6487 face
->overline_color_defaulted_p
= 1;
6488 face
->overline_p
= 1;
6491 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6492 if (STRINGP (strike_through
))
6494 face
->strike_through_color
6495 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6496 LFACE_STRIKE_THROUGH_INDEX
);
6497 face
->strike_through_p
= 1;
6499 else if (EQ (strike_through
, Qt
))
6501 face
->strike_through_color
= face
->foreground
;
6502 face
->strike_through_color_defaulted_p
= 1;
6503 face
->strike_through_p
= 1;
6506 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6507 if (!NILP (stipple
))
6508 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6510 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6512 #endif /* HAVE_WINDOW_SYSTEM */
6516 /* Map a specified color of face FACE on frame F to a tty color index.
6517 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6518 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6519 default foreground/background colors. */
6522 map_tty_color (f
, face
, idx
, defaulted
)
6525 enum lface_attribute_index idx
;
6528 Lisp_Object frame
, color
, def
;
6529 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6530 unsigned long default_pixel
, default_other_pixel
, pixel
;
6532 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6536 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6537 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6541 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6542 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6545 XSETFRAME (frame
, f
);
6546 color
= face
->lface
[idx
];
6549 && XSTRING (color
)->size
6550 && CONSP (Vtty_defined_color_alist
)
6551 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6554 /* Associations in tty-defined-color-alist are of the form
6555 (NAME INDEX R G B). We need the INDEX part. */
6556 pixel
= XINT (XCAR (XCDR (def
)));
6559 if (pixel
== default_pixel
&& STRINGP (color
))
6561 pixel
= load_color (f
, face
, color
, idx
);
6563 #if defined (MSDOS) || defined (WINDOWSNT)
6564 /* If the foreground of the default face is the default color,
6565 use the foreground color defined by the frame. */
6567 if (FRAME_MSDOS_P (f
))
6570 if (pixel
== default_pixel
6571 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6574 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6576 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6577 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6580 else if (pixel
== default_other_pixel
)
6583 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6585 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6586 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6592 #endif /* MSDOS or WINDOWSNT */
6596 face
->foreground
= pixel
;
6598 face
->background
= pixel
;
6602 /* Realize the fully-specified face with attributes ATTRS in face
6603 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6604 pointer to the newly created realized face. */
6606 static struct face
*
6607 realize_tty_face (cache
, attrs
, c
)
6608 struct face_cache
*cache
;
6614 int face_colors_defaulted
= 0;
6615 struct frame
*f
= cache
->f
;
6617 /* Frame must be a termcap frame. */
6618 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6620 /* Allocate a new realized face. */
6621 face
= make_realized_face (attrs
);
6622 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6624 /* Map face attributes to TTY appearances. We map slant to
6625 dimmed text because we want italic text to appear differently
6626 and because dimmed text is probably used infrequently. */
6627 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6628 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6630 if (weight
> XLFD_WEIGHT_MEDIUM
)
6631 face
->tty_bold_p
= 1;
6632 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6633 face
->tty_dim_p
= 1;
6634 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6635 face
->tty_underline_p
= 1;
6636 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6637 face
->tty_reverse_p
= 1;
6639 /* Map color names to color indices. */
6640 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6641 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6643 /* Swap colors if face is inverse-video. If the colors are taken
6644 from the frame colors, they are already inverted, since the
6645 frame-creation function calls x-handle-reverse-video. */
6646 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6648 unsigned long tem
= face
->foreground
;
6649 face
->foreground
= face
->background
;
6650 face
->background
= tem
;
6653 if (tty_suppress_bold_inverse_default_colors_p
6655 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6656 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6657 face
->tty_bold_p
= 0;
6663 DEFUN ("tty-suppress-bold-inverse-default-colors",
6664 Ftty_suppress_bold_inverse_default_colors
,
6665 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6666 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6667 SUPPRESS non-nil means suppress it.
6668 This affects bold faces on TTYs whose foreground is the default background
6669 color of the display and whose background is the default foreground color.
6670 For such faces, the bold face attribute is ignored if this variable
6673 Lisp_Object suppress
;
6675 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6676 ++face_change_count
;
6682 /***********************************************************************
6684 ***********************************************************************/
6686 /* Return the ID of the face to use to display character CH with face
6687 property PROP on frame F in current_buffer. */
6690 compute_char_face (f
, ch
, prop
)
6697 if (NILP (current_buffer
->enable_multibyte_characters
))
6702 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6703 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6707 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6708 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6709 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6710 merge_face_vector_with_property (f
, attrs
, prop
);
6711 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6718 /* Return the face ID associated with buffer position POS for
6719 displaying ASCII characters. Return in *ENDPTR the position at
6720 which a different face is needed, as far as text properties and
6721 overlays are concerned. W is a window displaying current_buffer.
6723 REGION_BEG, REGION_END delimit the region, so it can be
6726 LIMIT is a position not to scan beyond. That is to limit the time
6727 this function can take.
6729 If MOUSE is non-zero, use the character's mouse-face, not its face.
6731 The face returned is suitable for displaying ASCII characters. */
6734 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6735 endptr
, limit
, mouse
)
6738 int region_beg
, region_end
;
6743 struct frame
*f
= XFRAME (w
->frame
);
6744 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6745 Lisp_Object prop
, position
;
6747 Lisp_Object
*overlay_vec
;
6750 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6751 Lisp_Object limit1
, end
;
6752 struct face
*default_face
;
6754 /* W must display the current buffer. We could write this function
6755 to use the frame and buffer of W, but right now it doesn't. */
6756 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6758 XSETFRAME (frame
, f
);
6759 XSETFASTINT (position
, pos
);
6762 if (pos
< region_beg
&& region_beg
< endpos
)
6763 endpos
= region_beg
;
6765 /* Get the `face' or `mouse_face' text property at POS, and
6766 determine the next position at which the property changes. */
6767 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6768 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6769 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6771 endpos
= XINT (end
);
6773 /* Look at properties from overlays. */
6778 /* First try with room for 40 overlays. */
6780 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6781 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6782 &next_overlay
, NULL
, 0);
6784 /* If there are more than 40, make enough space for all, and try
6786 if (noverlays
> len
)
6789 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6790 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6791 &next_overlay
, NULL
, 0);
6794 if (next_overlay
< endpos
)
6795 endpos
= next_overlay
;
6800 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6802 /* Optimize common cases where we can use the default face. */
6805 && !(pos
>= region_beg
&& pos
< region_end
))
6806 return DEFAULT_FACE_ID
;
6808 /* Begin with attributes from the default face. */
6809 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6811 /* Merge in attributes specified via text properties. */
6813 merge_face_vector_with_property (f
, attrs
, prop
);
6815 /* Now merge the overlay data. */
6816 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6817 for (i
= 0; i
< noverlays
; i
++)
6822 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6824 merge_face_vector_with_property (f
, attrs
, prop
);
6826 oend
= OVERLAY_END (overlay_vec
[i
]);
6827 oendpos
= OVERLAY_POSITION (oend
);
6828 if (oendpos
< endpos
)
6832 /* If in the region, merge in the region face. */
6833 if (pos
>= region_beg
&& pos
< region_end
)
6835 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6836 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6838 if (region_end
< endpos
)
6839 endpos
= region_end
;
6844 /* Look up a realized face with the given face attributes,
6845 or realize a new one for ASCII characters. */
6846 return lookup_face (f
, attrs
, 0, NULL
);
6850 /* Compute the face at character position POS in Lisp string STRING on
6851 window W, for ASCII characters.
6853 If STRING is an overlay string, it comes from position BUFPOS in
6854 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6855 not an overlay string. W must display the current buffer.
6856 REGION_BEG and REGION_END give the start and end positions of the
6857 region; both are -1 if no region is visible.
6859 BASE_FACE_ID is the id of a face to merge with. For strings coming
6860 from overlays or the `display' property it is the face at BUFPOS.
6862 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6864 Set *ENDPTR to the next position where to check for faces in
6865 STRING; -1 if the face is constant from POS to the end of the
6868 Value is the id of the face to use. The face returned is suitable
6869 for displaying ASCII characters. */
6872 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6873 region_end
, endptr
, base_face_id
, mouse_p
)
6877 int region_beg
, region_end
;
6879 enum face_id base_face_id
;
6882 Lisp_Object prop
, position
, end
, limit
;
6883 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6884 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6885 struct face
*base_face
;
6886 int multibyte_p
= STRING_MULTIBYTE (string
);
6887 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6889 /* Get the value of the face property at the current position within
6890 STRING. Value is nil if there is no face property. */
6891 XSETFASTINT (position
, pos
);
6892 prop
= Fget_text_property (position
, prop_name
, string
);
6894 /* Get the next position at which to check for faces. Value of end
6895 is nil if face is constant all the way to the end of the string.
6896 Otherwise it is a string position where to check faces next.
6897 Limit is the maximum position up to which to check for property
6898 changes in Fnext_single_property_change. Strings are usually
6899 short, so set the limit to the end of the string. */
6900 XSETFASTINT (limit
, XSTRING (string
)->size
);
6901 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6903 *endptr
= XFASTINT (end
);
6907 base_face
= FACE_FROM_ID (f
, base_face_id
);
6908 xassert (base_face
);
6910 /* Optimize the default case that there is no face property and we
6911 are not in the region. */
6913 && (base_face_id
!= DEFAULT_FACE_ID
6914 /* BUFPOS <= 0 means STRING is not an overlay string, so
6915 that the region doesn't have to be taken into account. */
6917 || bufpos
< region_beg
6918 || bufpos
>= region_end
)
6920 /* We can't realize faces for different charsets differently
6921 if we don't have fonts, so we can stop here if not working
6922 on a window-system frame. */
6923 || !FRAME_WINDOW_P (f
)
6924 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6925 return base_face
->id
;
6927 /* Begin with attributes from the base face. */
6928 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6930 /* Merge in attributes specified via text properties. */
6932 merge_face_vector_with_property (f
, attrs
, prop
);
6934 /* If in the region, merge in the region face. */
6936 && bufpos
>= region_beg
6937 && bufpos
< region_end
)
6939 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6940 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6943 /* Look up a realized face with the given face attributes,
6944 or realize a new one for ASCII characters. */
6945 return lookup_face (f
, attrs
, 0, NULL
);
6950 /***********************************************************************
6952 ***********************************************************************/
6956 /* Print the contents of the realized face FACE to stderr. */
6959 dump_realized_face (face
)
6962 fprintf (stderr
, "ID: %d\n", face
->id
);
6963 #ifdef HAVE_X_WINDOWS
6964 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6966 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6968 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6969 fprintf (stderr
, "background: 0x%lx (%s)\n",
6971 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6972 fprintf (stderr
, "font_name: %s (%s)\n",
6974 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6975 #ifdef HAVE_X_WINDOWS
6976 fprintf (stderr
, "font = %p\n", face
->font
);
6978 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6979 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6980 fprintf (stderr
, "underline: %d (%s)\n",
6982 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6983 fprintf (stderr
, "hash: %d\n", face
->hash
);
6984 fprintf (stderr
, "charset: %d\n", face
->charset
);
6988 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
6996 fprintf (stderr
, "font selection order: ");
6997 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6998 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6999 fprintf (stderr
, "\n");
7001 fprintf (stderr
, "alternative fonts: ");
7002 debug_print (Vface_alternative_font_family_alist
);
7003 fprintf (stderr
, "\n");
7005 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7006 Fdump_face (make_number (i
));
7011 CHECK_NUMBER (n
, 0);
7012 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7014 error ("Not a valid face");
7015 dump_realized_face (face
);
7022 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7023 0, 0, 0, doc
: /* */)
7026 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7027 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7028 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7032 #endif /* GLYPH_DEBUG != 0 */
7036 /***********************************************************************
7038 ***********************************************************************/
7043 Qface
= intern ("face");
7045 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7046 staticpro (&Qbitmap_spec_p
);
7047 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7048 staticpro (&Qframe_update_face_colors
);
7050 /* Lisp face attribute keywords. */
7051 QCfamily
= intern (":family");
7052 staticpro (&QCfamily
);
7053 QCheight
= intern (":height");
7054 staticpro (&QCheight
);
7055 QCweight
= intern (":weight");
7056 staticpro (&QCweight
);
7057 QCslant
= intern (":slant");
7058 staticpro (&QCslant
);
7059 QCunderline
= intern (":underline");
7060 staticpro (&QCunderline
);
7061 QCinverse_video
= intern (":inverse-video");
7062 staticpro (&QCinverse_video
);
7063 QCreverse_video
= intern (":reverse-video");
7064 staticpro (&QCreverse_video
);
7065 QCforeground
= intern (":foreground");
7066 staticpro (&QCforeground
);
7067 QCbackground
= intern (":background");
7068 staticpro (&QCbackground
);
7069 QCstipple
= intern (":stipple");;
7070 staticpro (&QCstipple
);
7071 QCwidth
= intern (":width");
7072 staticpro (&QCwidth
);
7073 QCfont
= intern (":font");
7074 staticpro (&QCfont
);
7075 QCbold
= intern (":bold");
7076 staticpro (&QCbold
);
7077 QCitalic
= intern (":italic");
7078 staticpro (&QCitalic
);
7079 QCoverline
= intern (":overline");
7080 staticpro (&QCoverline
);
7081 QCstrike_through
= intern (":strike-through");
7082 staticpro (&QCstrike_through
);
7083 QCbox
= intern (":box");
7085 QCinherit
= intern (":inherit");
7086 staticpro (&QCinherit
);
7088 /* Symbols used for Lisp face attribute values. */
7089 QCcolor
= intern (":color");
7090 staticpro (&QCcolor
);
7091 QCline_width
= intern (":line-width");
7092 staticpro (&QCline_width
);
7093 QCstyle
= intern (":style");
7094 staticpro (&QCstyle
);
7095 Qreleased_button
= intern ("released-button");
7096 staticpro (&Qreleased_button
);
7097 Qpressed_button
= intern ("pressed-button");
7098 staticpro (&Qpressed_button
);
7099 Qnormal
= intern ("normal");
7100 staticpro (&Qnormal
);
7101 Qultra_light
= intern ("ultra-light");
7102 staticpro (&Qultra_light
);
7103 Qextra_light
= intern ("extra-light");
7104 staticpro (&Qextra_light
);
7105 Qlight
= intern ("light");
7106 staticpro (&Qlight
);
7107 Qsemi_light
= intern ("semi-light");
7108 staticpro (&Qsemi_light
);
7109 Qsemi_bold
= intern ("semi-bold");
7110 staticpro (&Qsemi_bold
);
7111 Qbold
= intern ("bold");
7113 Qextra_bold
= intern ("extra-bold");
7114 staticpro (&Qextra_bold
);
7115 Qultra_bold
= intern ("ultra-bold");
7116 staticpro (&Qultra_bold
);
7117 Qoblique
= intern ("oblique");
7118 staticpro (&Qoblique
);
7119 Qitalic
= intern ("italic");
7120 staticpro (&Qitalic
);
7121 Qreverse_oblique
= intern ("reverse-oblique");
7122 staticpro (&Qreverse_oblique
);
7123 Qreverse_italic
= intern ("reverse-italic");
7124 staticpro (&Qreverse_italic
);
7125 Qultra_condensed
= intern ("ultra-condensed");
7126 staticpro (&Qultra_condensed
);
7127 Qextra_condensed
= intern ("extra-condensed");
7128 staticpro (&Qextra_condensed
);
7129 Qcondensed
= intern ("condensed");
7130 staticpro (&Qcondensed
);
7131 Qsemi_condensed
= intern ("semi-condensed");
7132 staticpro (&Qsemi_condensed
);
7133 Qsemi_expanded
= intern ("semi-expanded");
7134 staticpro (&Qsemi_expanded
);
7135 Qexpanded
= intern ("expanded");
7136 staticpro (&Qexpanded
);
7137 Qextra_expanded
= intern ("extra-expanded");
7138 staticpro (&Qextra_expanded
);
7139 Qultra_expanded
= intern ("ultra-expanded");
7140 staticpro (&Qultra_expanded
);
7141 Qbackground_color
= intern ("background-color");
7142 staticpro (&Qbackground_color
);
7143 Qforeground_color
= intern ("foreground-color");
7144 staticpro (&Qforeground_color
);
7145 Qunspecified
= intern ("unspecified");
7146 staticpro (&Qunspecified
);
7148 Qface_alias
= intern ("face-alias");
7149 staticpro (&Qface_alias
);
7150 Qdefault
= intern ("default");
7151 staticpro (&Qdefault
);
7152 Qtool_bar
= intern ("tool-bar");
7153 staticpro (&Qtool_bar
);
7154 Qregion
= intern ("region");
7155 staticpro (&Qregion
);
7156 Qfringe
= intern ("fringe");
7157 staticpro (&Qfringe
);
7158 Qheader_line
= intern ("header-line");
7159 staticpro (&Qheader_line
);
7160 Qscroll_bar
= intern ("scroll-bar");
7161 staticpro (&Qscroll_bar
);
7162 Qmenu
= intern ("menu");
7164 Qcursor
= intern ("cursor");
7165 staticpro (&Qcursor
);
7166 Qborder
= intern ("border");
7167 staticpro (&Qborder
);
7168 Qmouse
= intern ("mouse");
7169 staticpro (&Qmouse
);
7170 Qtty_color_desc
= intern ("tty-color-desc");
7171 staticpro (&Qtty_color_desc
);
7172 Qtty_color_by_index
= intern ("tty-color-by-index");
7173 staticpro (&Qtty_color_by_index
);
7174 Qtty_color_alist
= intern ("tty-color-alist");
7175 staticpro (&Qtty_color_alist
);
7176 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7177 staticpro (&Qscalable_fonts_allowed
);
7179 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7180 staticpro (&Vparam_value_alist
);
7181 Vface_alternative_font_family_alist
= Qnil
;
7182 staticpro (&Vface_alternative_font_family_alist
);
7183 Vface_alternative_font_registry_alist
= Qnil
;
7184 staticpro (&Vface_alternative_font_registry_alist
);
7186 defsubr (&Sinternal_make_lisp_face
);
7187 defsubr (&Sinternal_lisp_face_p
);
7188 defsubr (&Sinternal_set_lisp_face_attribute
);
7189 #ifdef HAVE_WINDOW_SYSTEM
7190 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7192 defsubr (&Scolor_gray_p
);
7193 defsubr (&Scolor_supported_p
);
7194 defsubr (&Sinternal_get_lisp_face_attribute
);
7195 defsubr (&Sinternal_lisp_face_attribute_values
);
7196 defsubr (&Sinternal_lisp_face_equal_p
);
7197 defsubr (&Sinternal_lisp_face_empty_p
);
7198 defsubr (&Sinternal_copy_lisp_face
);
7199 defsubr (&Sinternal_merge_in_global_face
);
7200 defsubr (&Sface_font
);
7201 defsubr (&Sframe_face_alist
);
7202 defsubr (&Sinternal_set_font_selection_order
);
7203 defsubr (&Sinternal_set_alternative_font_family_alist
);
7204 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7206 defsubr (&Sdump_face
);
7207 defsubr (&Sshow_face_resources
);
7208 #endif /* GLYPH_DEBUG */
7209 defsubr (&Sclear_face_cache
);
7210 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7212 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7213 defsubr (&Sdump_colors
);
7216 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7217 doc
: /* *Limit for font matching.
7218 If an integer > 0, font matching functions won't load more than
7219 that number of fonts when searching for a matching font. */);
7220 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7222 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7223 doc
: /* List of global face definitions (for internal use only.) */);
7224 Vface_new_frame_defaults
= Qnil
;
7226 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7227 doc
: /* *Default stipple pattern used on monochrome displays.
7228 This stipple pattern is used on monochrome displays
7229 instead of shades of gray for a face background color.
7230 See `set-face-stipple' for possible values for this variable. */);
7231 Vface_default_stipple
= build_string ("gray3");
7233 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7234 doc
: /* An alist of defined terminal colors and their RGB values. */);
7235 Vtty_defined_color_alist
= Qnil
;
7237 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7238 doc
: /* Allowed scalable fonts.
7239 A value of nil means don't allow any scalable fonts.
7240 A value of t means allow any scalable font.
7241 Otherwise, value must be a list of regular expressions. A font may be
7242 scaled if its name matches a regular expression in the list.
7243 Note that if value is nil, a scalable font might still be used, if no
7244 other font of the appropriate family and registry is available. */);
7245 Vscalable_fonts_allowed
= Qnil
;
7247 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7248 doc
: /* List of ignored fonts.
7249 Each element is a regular expression that matches names of fonts to
7251 Vface_ignored_fonts
= Qnil
;
7253 #ifdef HAVE_WINDOW_SYSTEM
7254 defsubr (&Sbitmap_spec_p
);
7255 defsubr (&Sx_list_fonts
);
7256 defsubr (&Sinternal_face_x_get_resource
);
7257 defsubr (&Sx_family_fonts
);
7258 defsubr (&Sx_font_family_list
);
7259 #endif /* HAVE_WINDOW_SYSTEM */