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 Lisp_Object Qmode_line_inactive
;
368 extern Lisp_Object Qmode_line
;
370 /* The symbol `face-alias'. A symbols having that property is an
371 alias for another face. Value of the property is the name of
374 Lisp_Object Qface_alias
;
376 /* Names of frame parameters related to faces. */
378 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
379 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
381 /* Default stipple pattern used on monochrome displays. This stipple
382 pattern is used on monochrome displays instead of shades of gray
383 for a face background color. See `set-face-stipple' for possible
384 values for this variable. */
386 Lisp_Object Vface_default_stipple
;
388 /* Alist of alternative font families. Each element is of the form
389 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
390 try FAMILY1, then FAMILY2, ... */
392 Lisp_Object Vface_alternative_font_family_alist
;
394 /* Alist of alternative font registries. Each element is of the form
395 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
396 loaded, try REGISTRY1, then REGISTRY2, ... */
398 Lisp_Object Vface_alternative_font_registry_alist
;
400 /* Allowed scalable fonts. A value of nil means don't allow any
401 scalable fonts. A value of t means allow the use of any scalable
402 font. Otherwise, value must be a list of regular expressions. A
403 font may be scaled if its name matches a regular expression in the
406 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
408 /* List of regular expressions that matches names of fonts to ignore. */
410 Lisp_Object Vface_ignored_fonts
;
412 /* Maximum number of fonts to consider in font_list. If not an
413 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
415 Lisp_Object Vfont_list_limit
;
416 #define DEFAULT_FONT_LIST_LIMIT 100
418 /* The symbols `foreground-color' and `background-color' which can be
419 used as part of a `face' property. This is for compatibility with
422 Lisp_Object Qforeground_color
, Qbackground_color
;
424 /* The symbols `face' and `mouse-face' used as text properties. */
427 extern Lisp_Object Qmouse_face
;
429 /* Error symbol for wrong_type_argument in load_pixmap. */
431 Lisp_Object Qbitmap_spec_p
;
433 /* Alist of global face definitions. Each element is of the form
434 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
435 is a Lisp vector of face attributes. These faces are used
436 to initialize faces for new frames. */
438 Lisp_Object Vface_new_frame_defaults
;
440 /* The next ID to assign to Lisp faces. */
442 static int next_lface_id
;
444 /* A vector mapping Lisp face Id's to face names. */
446 static Lisp_Object
*lface_id_to_name
;
447 static int lface_id_to_name_size
;
449 /* TTY color-related functions (defined in tty-colors.el). */
451 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
453 /* The name of the function used to compute colors on TTYs. */
455 Lisp_Object Qtty_color_alist
;
457 /* An alist of defined terminal colors and their RGB values. */
459 Lisp_Object Vtty_defined_color_alist
;
461 /* Counter for calls to clear_face_cache. If this counter reaches
462 CLEAR_FONT_TABLE_COUNT, and a frame has more than
463 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
465 static int clear_font_table_count
;
466 #define CLEAR_FONT_TABLE_COUNT 100
467 #define CLEAR_FONT_TABLE_NFONTS 10
469 /* Non-zero means face attributes have been changed since the last
470 redisplay. Used in redisplay_internal. */
472 int face_change_count
;
474 /* Non-zero means don't display bold text if a face's foreground
475 and background colors are the inverse of the default colors of the
476 display. This is a kluge to suppress `bold black' foreground text
477 which is hard to read on an LCD monitor. */
479 int tty_suppress_bold_inverse_default_colors_p
;
481 /* A list of the form `((x . y))' used to avoid consing in
482 Finternal_set_lisp_face_attribute. */
484 static Lisp_Object Vparam_value_alist
;
486 /* The total number of colors currently allocated. */
489 static int ncolors_allocated
;
490 static int npixmaps_allocated
;
494 /* Non-zero means the definition of the `menu' face for new frames has
497 int menu_face_changed_default
;
500 /* Function prototypes. */
505 static void map_tty_color
P_ ((struct frame
*, struct face
*,
506 enum lface_attribute_index
, int *));
507 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
508 static int may_use_scalable_font_p
P_ ((char *));
509 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
510 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
512 static int x_face_list_fonts
P_ ((struct frame
*, char *,
513 struct font_name
*, int, int));
514 static int font_scalable_p
P_ ((struct font_name
*));
515 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
516 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
517 static unsigned char *xstrlwr
P_ ((unsigned char *));
518 static void signal_error
P_ ((char *, Lisp_Object
));
519 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
520 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
521 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
522 static void free_face_colors
P_ ((struct frame
*, struct face
*));
523 static int face_color_gray_p
P_ ((struct frame
*, char *));
524 static char *build_font_name
P_ ((struct font_name
*));
525 static void free_font_names
P_ ((struct font_name
*, int));
526 static int sorted_font_list
P_ ((struct frame
*, char *,
527 int (*cmpfn
) P_ ((const void *, const void *)),
528 struct font_name
**));
529 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
530 Lisp_Object
, struct font_name
**));
531 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
532 Lisp_Object
, struct font_name
**));
533 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
534 Lisp_Object
, Lisp_Object
, struct font_name
**));
535 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
536 Lisp_Object
, struct font_name
**));
537 static int cmp_font_names
P_ ((const void *, const void *));
538 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
539 struct face
*, int));
540 static struct face
*realize_x_face
P_ ((struct face_cache
*,
541 Lisp_Object
*, int, struct face
*));
542 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
543 Lisp_Object
*, int));
544 static int realize_basic_faces
P_ ((struct frame
*));
545 static int realize_default_face
P_ ((struct frame
*));
546 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
547 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
548 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
549 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
550 static unsigned lface_hash
P_ ((Lisp_Object
*));
551 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
552 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
553 static void free_realized_face
P_ ((struct frame
*, struct face
*));
554 static void clear_face_gcs
P_ ((struct face_cache
*));
555 static void free_face_cache
P_ ((struct face_cache
*));
556 static int face_numeric_weight
P_ ((Lisp_Object
));
557 static int face_numeric_slant
P_ ((Lisp_Object
));
558 static int face_numeric_swidth
P_ ((Lisp_Object
));
559 static int face_fontset
P_ ((Lisp_Object
*));
560 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
561 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
562 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
563 Lisp_Object
*, Lisp_Object
));
564 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
566 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
567 Lisp_Object
, int, int));
568 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
569 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
570 static void free_realized_faces
P_ ((struct face_cache
*));
571 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
572 struct font_name
*, int, int));
573 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
574 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
575 static int xlfd_numeric_slant
P_ ((struct font_name
*));
576 static int xlfd_numeric_weight
P_ ((struct font_name
*));
577 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
578 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
579 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
580 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
581 static int xlfd_fixed_p
P_ ((struct font_name
*));
582 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
584 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
585 struct font_name
*, int,
587 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
588 struct font_name
*, int));
590 #ifdef HAVE_WINDOW_SYSTEM
592 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
593 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
594 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
595 int (*cmpfn
) P_ ((const void *, const void *))));
596 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
597 static void x_free_gc
P_ ((struct frame
*, GC
));
598 static void clear_font_table
P_ ((struct x_display_info
*));
601 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
602 #endif /* WINDOWSNT */
605 static void x_update_menu_appearance
P_ ((struct frame
*));
607 extern void free_frame_menubar
P_ ((struct frame
*));
608 #endif /* USE_X_TOOLKIT */
610 #endif /* HAVE_WINDOW_SYSTEM */
613 /***********************************************************************
615 ***********************************************************************/
617 #ifdef HAVE_X_WINDOWS
619 #ifdef DEBUG_X_COLORS
621 /* The following is a poor mans infrastructure for debugging X color
622 allocation problems on displays with PseudoColor-8. Some X servers
623 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
624 color reference counts completely so that they don't signal an
625 error when a color is freed whose reference count is already 0.
626 Other X servers do. To help me debug this, the following code
627 implements a simple reference counting schema of its own, for a
628 single display/screen. --gerd. */
630 /* Reference counts for pixel colors. */
632 int color_count
[256];
634 /* Register color PIXEL as allocated. */
637 register_color (pixel
)
640 xassert (pixel
< 256);
641 ++color_count
[pixel
];
645 /* Register color PIXEL as deallocated. */
648 unregister_color (pixel
)
651 xassert (pixel
< 256);
652 if (color_count
[pixel
] > 0)
653 --color_count
[pixel
];
659 /* Register N colors from PIXELS as deallocated. */
662 unregister_colors (pixels
, n
)
663 unsigned long *pixels
;
667 for (i
= 0; i
< n
; ++i
)
668 unregister_color (pixels
[i
]);
672 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
673 doc
: /* Dump currently allocated colors to stderr. */)
678 fputc ('\n', stderr
);
680 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
683 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
686 fputc ('\n', stderr
);
688 fputc ('\t', stderr
);
692 fputc ('\n', stderr
);
696 #endif /* DEBUG_X_COLORS */
699 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
700 color values. Interrupt input must be blocked when this function
704 x_free_colors (f
, pixels
, npixels
)
706 unsigned long *pixels
;
709 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
711 /* If display has an immutable color map, freeing colors is not
712 necessary and some servers don't allow it. So don't do it. */
713 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
715 #ifdef DEBUG_X_COLORS
716 unregister_colors (pixels
, npixels
);
718 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
724 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
725 color values. Interrupt input must be blocked when this function
729 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
733 unsigned long *pixels
;
736 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
737 int class = dpyinfo
->visual
->class;
739 /* If display has an immutable color map, freeing colors is not
740 necessary and some servers don't allow it. So don't do it. */
741 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
743 #ifdef DEBUG_X_COLORS
744 unregister_colors (pixels
, npixels
);
746 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
751 /* Create and return a GC for use on frame F. GC values and mask
752 are given by XGCV and MASK. */
755 x_create_gc (f
, mask
, xgcv
)
762 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
769 /* Free GC which was used on frame F. */
777 xassert (--ngcs
>= 0);
778 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
782 #endif /* HAVE_X_WINDOWS */
785 /* W32 emulation of GCs */
788 x_create_gc (f
, mask
, xgcv
)
795 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
802 /* Free GC which was used on frame F. */
810 xassert (--ngcs
>= 0);
815 #endif /* WINDOWSNT */
817 /* Like stricmp. Used to compare parts of font names which are in
822 unsigned char *s1
, *s2
;
826 unsigned char c1
= tolower (*s1
);
827 unsigned char c2
= tolower (*s2
);
829 return c1
< c2
? -1 : 1;
834 return *s2
== 0 ? 0 : -1;
839 /* Like strlwr, which might not always be available. */
841 static unsigned char *
845 unsigned char *p
= s
;
854 /* Signal `error' with message S, and additional argument ARG. */
857 signal_error (s
, arg
)
861 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
865 /* If FRAME is nil, return a pointer to the selected frame.
866 Otherwise, check that FRAME is a live frame, and return a pointer
867 to it. NPARAM is the parameter number of FRAME, for
868 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
869 Lisp function definitions. */
871 static INLINE
struct frame
*
872 frame_or_selected_frame (frame
, nparam
)
877 frame
= selected_frame
;
879 CHECK_LIVE_FRAME (frame
);
880 return XFRAME (frame
);
884 /***********************************************************************
886 ***********************************************************************/
888 /* Initialize face cache and basic faces for frame F. */
894 /* Make a face cache, if F doesn't have one. */
895 if (FRAME_FACE_CACHE (f
) == NULL
)
896 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
898 #ifdef HAVE_WINDOW_SYSTEM
899 /* Make the image cache. */
900 if (FRAME_WINDOW_P (f
))
902 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
903 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
904 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
906 #endif /* HAVE_WINDOW_SYSTEM */
908 /* Realize basic faces. Must have enough information in frame
909 parameters to realize basic faces at this point. */
910 #ifdef HAVE_X_WINDOWS
911 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
914 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
916 if (!realize_basic_faces (f
))
921 /* Free face cache of frame F. Called from Fdelete_frame. */
927 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
931 free_face_cache (face_cache
);
932 FRAME_FACE_CACHE (f
) = NULL
;
935 #ifdef HAVE_WINDOW_SYSTEM
936 if (FRAME_WINDOW_P (f
))
938 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
941 --image_cache
->refcount
;
942 if (image_cache
->refcount
== 0)
943 free_image_cache (f
);
946 #endif /* HAVE_WINDOW_SYSTEM */
950 /* Clear face caches, and recompute basic faces for frame F. Call
951 this after changing frame parameters on which those faces depend,
952 or when realized faces have been freed due to changing attributes
956 recompute_basic_faces (f
)
959 if (FRAME_FACE_CACHE (f
))
961 clear_face_cache (0);
962 if (!realize_basic_faces (f
))
968 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
969 try to free unused fonts, too. */
972 clear_face_cache (clear_fonts_p
)
975 #ifdef HAVE_WINDOW_SYSTEM
976 Lisp_Object tail
, frame
;
980 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
982 struct x_display_info
*dpyinfo
;
984 /* Fonts are common for frames on one display, i.e. on
986 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
987 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
988 clear_font_table (dpyinfo
);
990 /* From time to time see if we can unload some fonts. This also
991 frees all realized faces on all frames. Fonts needed by
992 faces will be loaded again when faces are realized again. */
993 clear_font_table_count
= 0;
995 FOR_EACH_FRAME (tail
, frame
)
997 struct frame
*f
= XFRAME (frame
);
998 if (FRAME_WINDOW_P (f
)
999 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1000 free_all_realized_faces (frame
);
1005 /* Clear GCs of realized faces. */
1006 FOR_EACH_FRAME (tail
, frame
)
1009 if (FRAME_WINDOW_P (f
))
1011 clear_face_gcs (FRAME_FACE_CACHE (f
));
1012 clear_image_cache (f
, 0);
1016 #endif /* HAVE_WINDOW_SYSTEM */
1020 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1021 doc
: /* Clear face caches on all frames.
1022 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1024 Lisp_Object thoroughly
;
1026 clear_face_cache (!NILP (thoroughly
));
1027 ++face_change_count
;
1028 ++windows_or_buffers_changed
;
1034 #ifdef HAVE_WINDOW_SYSTEM
1037 /* Remove fonts from the font table of DPYINFO except for the default
1038 ASCII fonts of frames on that display. Called from clear_face_cache
1039 from time to time. */
1042 clear_font_table (dpyinfo
)
1043 struct x_display_info
*dpyinfo
;
1047 /* Free those fonts that are not used by frames on DPYINFO. */
1048 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1050 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1051 Lisp_Object tail
, frame
;
1053 /* Check if slot is already free. */
1054 if (font_info
->name
== NULL
)
1057 /* Don't free a default font of some frame. */
1058 FOR_EACH_FRAME (tail
, frame
)
1060 struct frame
*f
= XFRAME (frame
);
1061 if (FRAME_WINDOW_P (f
)
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
);
1494 CHECK_STRING (color
);
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
);
1512 CHECK_STRING (color
);
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
1667 if (face
->colors_copied_bitwise_p
)
1672 if (!face
->foreground_defaulted_p
)
1674 x_free_colors (f
, &face
->foreground
, 1);
1675 IF_DEBUG (--ncolors_allocated
);
1678 if (!face
->background_defaulted_p
)
1680 x_free_colors (f
, &face
->background
, 1);
1681 IF_DEBUG (--ncolors_allocated
);
1684 if (face
->underline_p
1685 && !face
->underline_defaulted_p
)
1687 x_free_colors (f
, &face
->underline_color
, 1);
1688 IF_DEBUG (--ncolors_allocated
);
1691 if (face
->overline_p
1692 && !face
->overline_color_defaulted_p
)
1694 x_free_colors (f
, &face
->overline_color
, 1);
1695 IF_DEBUG (--ncolors_allocated
);
1698 if (face
->strike_through_p
1699 && !face
->strike_through_color_defaulted_p
)
1701 x_free_colors (f
, &face
->strike_through_color
, 1);
1702 IF_DEBUG (--ncolors_allocated
);
1705 if (face
->box
!= FACE_NO_BOX
1706 && !face
->box_color_defaulted_p
)
1708 x_free_colors (f
, &face
->box_color
, 1);
1709 IF_DEBUG (--ncolors_allocated
);
1713 #endif /* HAVE_X_WINDOWS */
1716 #endif /* HAVE_WINDOW_SYSTEM */
1720 /***********************************************************************
1722 ***********************************************************************/
1724 /* An enumerator for each field of an XLFD font name. */
1745 /* An enumerator for each possible slant value of a font. Taken from
1746 the XLFD specification. */
1754 XLFD_SLANT_REVERSE_ITALIC
,
1755 XLFD_SLANT_REVERSE_OBLIQUE
,
1759 /* Relative font weight according to XLFD documentation. */
1763 XLFD_WEIGHT_UNKNOWN
,
1764 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1765 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1766 XLFD_WEIGHT_LIGHT
, /* 30 */
1767 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1768 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1769 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1770 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1771 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1772 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1775 /* Relative proportionate width. */
1779 XLFD_SWIDTH_UNKNOWN
,
1780 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1781 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1782 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1783 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1784 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1785 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1786 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1787 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1788 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1791 /* Structure used for tables mapping XLFD weight, slant, and width
1792 names to numeric and symbolic values. */
1798 Lisp_Object
*symbol
;
1801 /* Table of XLFD slant names and their numeric and symbolic
1802 representations. This table must be sorted by slant names in
1805 static struct table_entry slant_table
[] =
1807 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1808 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1809 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1810 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1811 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1812 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1815 /* Table of XLFD weight names. This table must be sorted by weight
1816 names in ascending order. */
1818 static struct table_entry weight_table
[] =
1820 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1821 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1822 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1823 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1824 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1825 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1826 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1827 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1828 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1829 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1830 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1831 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1832 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1833 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1834 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1835 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1838 /* Table of XLFD width names. This table must be sorted by width
1839 names in ascending order. */
1841 static struct table_entry swidth_table
[] =
1843 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1844 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1845 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1846 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1847 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1848 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1849 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1850 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1851 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1852 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1853 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1854 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1855 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1856 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1857 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1860 /* Structure used to hold the result of splitting font names in XLFD
1861 format into their fields. */
1865 /* The original name which is modified destructively by
1866 split_font_name. The pointer is kept here to be able to free it
1867 if it was allocated from the heap. */
1870 /* Font name fields. Each vector element points into `name' above.
1871 Fields are NUL-terminated. */
1872 char *fields
[XLFD_LAST
];
1874 /* Numeric values for those fields that interest us. See
1875 split_font_name for which these are. */
1876 int numeric
[XLFD_LAST
];
1878 /* Lower value mean higher priority. */
1879 int registry_priority
;
1882 /* The frame in effect when sorting font names. Set temporarily in
1883 sort_fonts so that it is available in font comparison functions. */
1885 static struct frame
*font_frame
;
1887 /* Order by which font selection chooses fonts. The default values
1888 mean `first, find a best match for the font width, then for the
1889 font height, then for weight, then for slant.' This variable can be
1890 set via set-face-font-sort-order. */
1893 static int font_sort_order
[4] = {
1894 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1897 static int font_sort_order
[4];
1900 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1901 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1902 is a pointer to the matching table entry or null if no table entry
1905 static struct table_entry
*
1906 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1907 struct table_entry
*table
;
1909 struct font_name
*font
;
1912 /* Function split_font_name converts fields to lower-case, so there
1913 is no need to use xstrlwr or xstricmp here. */
1914 char *s
= font
->fields
[field_index
];
1915 int low
, mid
, high
, cmp
;
1922 mid
= (low
+ high
) / 2;
1923 cmp
= strcmp (table
[mid
].name
, s
);
1937 /* Return a numeric representation for font name field
1938 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1939 has DIM entries. Value is the numeric value found or DFLT if no
1940 table entry matches. This function is used to translate weight,
1941 slant, and swidth names of XLFD font names to numeric values. */
1944 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1945 struct table_entry
*table
;
1947 struct font_name
*font
;
1951 struct table_entry
*p
;
1952 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1953 return p
? p
->numeric
: dflt
;
1957 /* Return a symbolic representation for font name field
1958 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1959 has DIM entries. Value is the symbolic value found or DFLT if no
1960 table entry matches. This function is used to translate weight,
1961 slant, and swidth names of XLFD font names to symbols. */
1963 static INLINE Lisp_Object
1964 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1965 struct table_entry
*table
;
1967 struct font_name
*font
;
1971 struct table_entry
*p
;
1972 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1973 return p
? *p
->symbol
: dflt
;
1977 /* Return a numeric value for the slant of the font given by FONT. */
1980 xlfd_numeric_slant (font
)
1981 struct font_name
*font
;
1983 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1984 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1988 /* Return a symbol representing the weight of the font given by FONT. */
1990 static INLINE Lisp_Object
1991 xlfd_symbolic_slant (font
)
1992 struct font_name
*font
;
1994 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1995 font
, XLFD_SLANT
, Qnormal
);
1999 /* Return a numeric value for the weight of the font given by FONT. */
2002 xlfd_numeric_weight (font
)
2003 struct font_name
*font
;
2005 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2006 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2010 /* Return a symbol representing the slant of the font given by FONT. */
2012 static INLINE Lisp_Object
2013 xlfd_symbolic_weight (font
)
2014 struct font_name
*font
;
2016 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2017 font
, XLFD_WEIGHT
, Qnormal
);
2021 /* Return a numeric value for the swidth of the font whose XLFD font
2022 name fields are found in FONT. */
2025 xlfd_numeric_swidth (font
)
2026 struct font_name
*font
;
2028 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2029 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2033 /* Return a symbolic value for the swidth of FONT. */
2035 static INLINE Lisp_Object
2036 xlfd_symbolic_swidth (font
)
2037 struct font_name
*font
;
2039 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2040 font
, XLFD_SWIDTH
, Qnormal
);
2044 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2045 entries. Value is a pointer to the matching table entry or null if
2046 no element of TABLE contains SYMBOL. */
2048 static struct table_entry
*
2049 face_value (table
, dim
, symbol
)
2050 struct table_entry
*table
;
2056 xassert (SYMBOLP (symbol
));
2058 for (i
= 0; i
< dim
; ++i
)
2059 if (EQ (*table
[i
].symbol
, symbol
))
2062 return i
< dim
? table
+ i
: NULL
;
2066 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2067 entries. Value is -1 if SYMBOL is not found in TABLE. */
2070 face_numeric_value (table
, dim
, symbol
)
2071 struct table_entry
*table
;
2075 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2076 return p
? p
->numeric
: -1;
2080 /* Return a numeric value representing the weight specified by Lisp
2081 symbol WEIGHT. Value is one of the enumerators of enum
2085 face_numeric_weight (weight
)
2088 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2092 /* Return a numeric value representing the slant specified by Lisp
2093 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2096 face_numeric_slant (slant
)
2099 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2103 /* Return a numeric value representing the swidth specified by Lisp
2104 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2107 face_numeric_swidth (width
)
2110 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2114 #ifdef HAVE_WINDOW_SYSTEM
2116 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2120 struct font_name
*font
;
2122 /* Function split_font_name converts fields to lower-case, so there
2123 is no need to use tolower here. */
2124 return *font
->fields
[XLFD_SPACING
] != 'p';
2128 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2130 The actual height of the font when displayed on F depends on the
2131 resolution of both the font and frame. For example, a 10pt font
2132 designed for a 100dpi display will display larger than 10pt on a
2133 75dpi display. (It's not unusual to use fonts not designed for the
2134 display one is using. For example, some intlfonts are available in
2135 72dpi versions, only.)
2137 Value is the real point size of FONT on frame F, or 0 if it cannot
2141 xlfd_point_size (f
, font
)
2143 struct font_name
*font
;
2145 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2146 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2150 if (*pixel_field
== '[')
2152 /* The pixel size field is `[A B C D]' which specifies
2153 a transformation matrix.
2159 by which all glyphs of the font are transformed. The spec
2160 says that s scalar value N for the pixel size is equivalent
2161 to A = N * resx/resy, B = C = 0, D = N. */
2162 char *start
= pixel_field
+ 1, *end
;
2166 for (i
= 0; i
< 4; ++i
)
2168 matrix
[i
] = strtod (start
, &end
);
2175 pixel
= atoi (pixel_field
);
2180 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2186 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2187 of frame F. This function is used to guess a point size of font
2188 when only the pixel height of the font is available. */
2191 pixel_point_size (f
, pixel
)
2195 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2199 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2200 point size of one dot. */
2201 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2202 int_pt
= real_pt
+ 0.5;
2208 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2209 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2210 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2211 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2212 zero if the font name doesn't have the format we expect. The
2213 expected format is a font name that starts with a `-' and has
2214 XLFD_LAST fields separated by `-'. */
2217 split_font_name (f
, font
, numeric_p
)
2219 struct font_name
*font
;
2225 if (*font
->name
== '-')
2227 char *p
= xstrlwr (font
->name
) + 1;
2229 while (i
< XLFD_LAST
)
2231 font
->fields
[i
] = p
;
2234 /* Pixel and point size may be of the form `[....]'. For
2235 BNF, see XLFD spec, chapter 4. Negative values are
2236 indicated by tilde characters which we replace with
2237 `-' characters, here. */
2239 && (i
- 1 == XLFD_PIXEL_SIZE
2240 || i
- 1 == XLFD_POINT_SIZE
))
2245 for (++p
; *p
&& *p
!= ']'; ++p
)
2249 /* Check that the matrix contains 4 floating point
2251 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2254 if (strtod (start
, &end
) == 0 && start
== end
)
2261 while (*p
&& *p
!= '-')
2271 success_p
= i
== XLFD_LAST
;
2273 /* If requested, and font name was in the expected format,
2274 compute numeric values for some fields. */
2275 if (numeric_p
&& success_p
)
2277 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2278 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2279 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2280 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2281 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2282 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2285 /* Initialize it to zero. It will be overridden by font_list while
2286 trying alternate registries. */
2287 font
->registry_priority
= 0;
2293 /* Build an XLFD font name from font name fields in FONT. Value is a
2294 pointer to the font name, which is allocated via xmalloc. */
2297 build_font_name (font
)
2298 struct font_name
*font
;
2302 char *font_name
= (char *) xmalloc (size
);
2303 int total_length
= 0;
2305 for (i
= 0; i
< XLFD_LAST
; ++i
)
2307 /* Add 1 because of the leading `-'. */
2308 int len
= strlen (font
->fields
[i
]) + 1;
2310 /* Reallocate font_name if necessary. Add 1 for the final
2312 if (total_length
+ len
+ 1 >= size
)
2314 int new_size
= max (2 * size
, size
+ len
+ 1);
2315 int sz
= new_size
* sizeof *font_name
;
2316 font_name
= (char *) xrealloc (font_name
, sz
);
2320 font_name
[total_length
] = '-';
2321 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2322 total_length
+= len
;
2325 font_name
[total_length
] = 0;
2330 /* Free an array FONTS of N font_name structures. This frees FONTS
2331 itself and all `name' fields in its elements. */
2334 free_font_names (fonts
, n
)
2335 struct font_name
*fonts
;
2339 xfree (fonts
[--n
].name
);
2344 /* Sort vector FONTS of font_name structures which contains NFONTS
2345 elements using qsort and comparison function CMPFN. F is the frame
2346 on which the fonts will be used. The global variable font_frame
2347 is temporarily set to F to make it available in CMPFN. */
2350 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2352 struct font_name
*fonts
;
2354 int (*cmpfn
) P_ ((const void *, const void *));
2357 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2362 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2363 display in x_display_list. FONTS is a pointer to a vector of
2364 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2365 alternative patterns from Valternate_fontname_alist if no fonts are
2366 found matching PATTERN.
2368 For all fonts found, set FONTS[i].name to the name of the font,
2369 allocated via xmalloc, and split font names into fields. Ignore
2370 fonts that we can't parse. Value is the number of fonts found. */
2373 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2376 struct font_name
*fonts
;
2377 int nfonts
, try_alternatives_p
;
2381 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2382 better to do it the other way around. */
2384 Lisp_Object lpattern
, tem
;
2386 lpattern
= build_string (pattern
);
2388 /* Get the list of fonts matching PATTERN. */
2391 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2394 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2397 /* Make a copy of the font names we got from X, and
2398 split them into fields. */
2400 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2402 Lisp_Object elt
, tail
;
2403 char *name
= XSTRING (XCAR (tem
))->data
;
2405 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2406 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2410 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2419 /* Make a copy of the font name. */
2420 fonts
[n
].name
= xstrdup (name
);
2422 if (split_font_name (f
, fonts
+ n
, 1))
2424 if (font_scalable_p (fonts
+ n
)
2425 && !may_use_scalable_font_p (name
))
2428 xfree (fonts
[n
].name
);
2434 xfree (fonts
[n
].name
);
2437 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2438 if (n
== 0 && try_alternatives_p
)
2440 Lisp_Object list
= Valternate_fontname_alist
;
2442 while (CONSP (list
))
2444 Lisp_Object entry
= XCAR (list
);
2446 && STRINGP (XCAR (entry
))
2447 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2454 Lisp_Object patterns
= XCAR (list
);
2457 while (CONSP (patterns
)
2458 /* If list is screwed up, give up. */
2459 && (name
= XCAR (patterns
),
2461 /* Ignore patterns equal to PATTERN because we tried that
2462 already with no success. */
2463 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2464 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2467 patterns
= XCDR (patterns
);
2475 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2476 using comparison function CMPFN. Value is the number of fonts
2477 found. If value is non-zero, *FONTS is set to a vector of
2478 font_name structures allocated from the heap containing matching
2479 fonts. Each element of *FONTS contains a name member that is also
2480 allocated from the heap. Font names in these structures are split
2481 into fields. Use free_font_names to free such an array. */
2484 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2487 int (*cmpfn
) P_ ((const void *, const void *));
2488 struct font_name
**fonts
;
2492 /* Get the list of fonts matching pattern. 100 should suffice. */
2493 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2494 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2495 nfonts
= XFASTINT (Vfont_list_limit
);
2497 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2498 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2500 /* Sort the resulting array and return it in *FONTS. If no
2501 fonts were found, make sure to set *FONTS to null. */
2503 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2514 /* Compare two font_name structures *A and *B. Value is analogous to
2515 strcmp. Sort order is given by the global variable
2516 font_sort_order. Font names are sorted so that, everything else
2517 being equal, fonts with a resolution closer to that of the frame on
2518 which they are used are listed first. The global variable
2519 font_frame is the frame on which we operate. */
2522 cmp_font_names (a
, b
)
2525 struct font_name
*x
= (struct font_name
*) a
;
2526 struct font_name
*y
= (struct font_name
*) b
;
2529 /* All strings have been converted to lower-case by split_font_name,
2530 so we can use strcmp here. */
2531 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2536 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2538 int j
= font_sort_order
[i
];
2539 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2544 /* Everything else being equal, we prefer fonts with an
2545 y-resolution closer to that of the frame. */
2546 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2547 int x_resy
= x
->numeric
[XLFD_RESY
];
2548 int y_resy
= y
->numeric
[XLFD_RESY
];
2549 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2557 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2558 is non-nil list fonts matching that pattern. Otherwise, if
2559 REGISTRY is non-nil return only fonts with that registry, otherwise
2560 return fonts of any registry. Set *FONTS to a vector of font_name
2561 structures allocated from the heap containing the fonts found.
2562 Value is the number of fonts found. */
2565 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2567 Lisp_Object pattern
, family
, registry
;
2568 struct font_name
**fonts
;
2570 char *pattern_str
, *family_str
, *registry_str
;
2574 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2575 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2577 pattern_str
= (char *) alloca (strlen (family_str
)
2578 + strlen (registry_str
)
2580 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2581 strcat (pattern_str
, family_str
);
2582 strcat (pattern_str
, "-*-");
2583 strcat (pattern_str
, registry_str
);
2584 if (!index (registry_str
, '-'))
2586 if (registry_str
[strlen (registry_str
) - 1] == '*')
2587 strcat (pattern_str
, "-*");
2589 strcat (pattern_str
, "*-*");
2593 pattern_str
= (char *) XSTRING (pattern
)->data
;
2595 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2599 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2600 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2601 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2604 static struct font_name
*
2605 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2606 struct font_name
*fonts1
, *fonts2
;
2607 int nfonts1
, nfonts2
;
2609 int new_nfonts
= nfonts1
+ nfonts2
;
2610 struct font_name
*new_fonts
;
2612 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2613 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2614 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2621 /* Get a sorted list of fonts of family FAMILY on frame F.
2623 If PATTERN is non-nil list fonts matching that pattern.
2625 If REGISTRY is non-nil, return fonts with that registry and the
2626 alternative registries from Vface_alternative_font_registry_alist.
2628 If REGISTRY is nil return fonts of any registry.
2630 Set *FONTS to a vector of font_name structures allocated from the
2631 heap containing the fonts found. Value is the number of fonts
2635 font_list (f
, pattern
, family
, registry
, fonts
)
2637 Lisp_Object pattern
, family
, registry
;
2638 struct font_name
**fonts
;
2640 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2642 if (!NILP (registry
)
2643 && CONSP (Vface_alternative_font_registry_alist
))
2647 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2652 for (alter
= XCDR (alter
), reg_prio
= 1;
2654 alter
= XCDR (alter
), reg_prio
++)
2655 if (STRINGP (XCAR (alter
)))
2658 struct font_name
*fonts2
;
2660 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2662 for (i
= 0; i
< nfonts2
; i
++)
2663 fonts2
[i
].registry_priority
= reg_prio
;
2664 *fonts
= (nfonts
> 0
2665 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2676 /* Remove elements from LIST whose cars are `equal'. Called from
2677 x-family-fonts and x-font-family-list to remove duplicate font
2681 remove_duplicates (list
)
2684 Lisp_Object tail
= list
;
2686 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2688 Lisp_Object next
= XCDR (tail
);
2689 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2690 XSETCDR (tail
, XCDR (next
));
2697 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2698 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2699 If FAMILY is omitted or nil, list all families.
2700 Otherwise, FAMILY must be a string, possibly containing wildcards
2702 If FRAME is omitted or nil, use the selected frame.
2703 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2704 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2705 FAMILY is the font family name. POINT-SIZE is the size of the
2706 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2707 width, weight and slant of the font. These symbols are the same as for
2708 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2709 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2710 giving the registry and encoding of the font.
2711 The result list is sorted according to the current setting of
2712 the face font sort order. */)
2714 Lisp_Object family
, frame
;
2716 struct frame
*f
= check_x_frame (frame
);
2717 struct font_name
*fonts
;
2720 struct gcpro gcpro1
;
2723 CHECK_STRING (family
);
2727 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2728 for (i
= nfonts
- 1; i
>= 0; --i
)
2730 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2733 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2734 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2735 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2736 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2737 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2738 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2739 tem
= build_font_name (fonts
+ i
);
2740 ASET (v
, 6, build_string (tem
));
2741 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2742 fonts
[i
].fields
[XLFD_ENCODING
]);
2743 ASET (v
, 7, build_string (tem
));
2746 result
= Fcons (v
, result
);
2749 remove_duplicates (result
);
2750 free_font_names (fonts
, nfonts
);
2756 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2758 doc
: /* Return a list of available font families on FRAME.
2759 If FRAME is omitted or nil, use the selected frame.
2760 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2761 is a font family, and FIXED-P is non-nil if fonts of that family
2762 are fixed-pitch. */)
2766 struct frame
*f
= check_x_frame (frame
);
2768 struct font_name
*fonts
;
2770 struct gcpro gcpro1
;
2771 int count
= specpdl_ptr
- specpdl
;
2774 /* Let's consider all fonts. Increase the limit for matching
2775 fonts until we have them all. */
2778 specbind (intern ("font-list-limit"), make_number (limit
));
2779 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2781 if (nfonts
== limit
)
2783 free_font_names (fonts
, nfonts
);
2792 for (i
= nfonts
- 1; i
>= 0; --i
)
2793 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2794 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2797 remove_duplicates (result
);
2798 free_font_names (fonts
, nfonts
);
2800 return unbind_to (count
, result
);
2804 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2805 doc
: /* Return a list of the names of available fonts matching PATTERN.
2806 If optional arguments FACE and FRAME are specified, return only fonts
2807 the same size as FACE on FRAME.
2808 PATTERN is a string, perhaps with wildcard characters;
2809 the * character matches any substring, and
2810 the ? character matches any single character.
2811 PATTERN is case-insensitive.
2812 FACE is a face name--a symbol.
2814 The return value is a list of strings, suitable as arguments to
2817 Fonts Emacs can't use may or may not be excluded
2818 even if they match PATTERN and FACE.
2819 The optional fourth argument MAXIMUM sets a limit on how many
2820 fonts to match. The first MAXIMUM fonts are reported.
2821 The optional fifth argument WIDTH, if specified, is a number of columns
2822 occupied by a character of a font. In that case, return only fonts
2823 the WIDTH times as wide as FACE on FRAME. */)
2824 (pattern
, face
, frame
, maximum
, width
)
2825 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2832 CHECK_STRING (pattern
);
2838 CHECK_NATNUM (maximum
);
2839 maxnames
= XINT (maximum
);
2843 CHECK_NUMBER (width
);
2845 /* We can't simply call check_x_frame because this function may be
2846 called before any frame is created. */
2847 f
= frame_or_selected_frame (frame
, 2);
2848 if (!FRAME_WINDOW_P (f
))
2850 /* Perhaps we have not yet created any frame. */
2855 /* Determine the width standard for comparison with the fonts we find. */
2861 /* This is of limited utility since it works with character
2862 widths. Keep it for compatibility. --gerd. */
2863 int face_id
= lookup_named_face (f
, face
, 0);
2864 struct face
*face
= (face_id
< 0
2866 : FACE_FROM_ID (f
, face_id
));
2868 if (face
&& face
->font
)
2869 size
= FONT_WIDTH (face
->font
);
2871 size
= FONT_WIDTH (FRAME_FONT (f
));
2874 size
*= XINT (width
);
2878 Lisp_Object args
[2];
2880 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2882 /* We don't have to check fontsets. */
2884 args
[1] = list_fontsets (f
, pattern
, size
);
2885 return Fnconc (2, args
);
2889 #endif /* HAVE_WINDOW_SYSTEM */
2893 /***********************************************************************
2895 ***********************************************************************/
2897 /* Access face attributes of face LFACE, a Lisp vector. */
2899 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2900 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2901 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2902 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2903 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2904 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2905 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2906 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2907 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2908 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2909 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2910 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2911 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2912 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2913 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2914 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2916 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2917 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2919 #define LFACEP(LFACE) \
2921 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2922 && EQ (AREF (LFACE, 0), Qface))
2927 /* Check consistency of Lisp face attribute vector ATTRS. */
2930 check_lface_attrs (attrs
)
2933 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2934 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2935 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2936 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2937 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2938 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2939 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2940 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2941 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2942 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2943 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2944 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2945 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2946 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2947 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2948 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2949 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2950 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2951 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2952 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2953 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2954 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2955 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2956 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2957 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2958 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2959 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2960 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2961 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2962 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2963 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2964 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2965 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2966 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2967 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2968 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2969 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2970 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2971 #ifdef HAVE_WINDOW_SYSTEM
2972 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2973 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2974 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2975 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2976 || NILP (attrs
[LFACE_FONT_INDEX
])
2977 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2982 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2990 xassert (LFACEP (lface
));
2991 check_lface_attrs (XVECTOR (lface
)->contents
);
2995 #else /* GLYPH_DEBUG == 0 */
2997 #define check_lface_attrs(attrs) (void) 0
2998 #define check_lface(lface) (void) 0
3000 #endif /* GLYPH_DEBUG == 0 */
3003 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3004 to make it a symvol. If FACE_NAME is an alias for another face,
3005 return that face's name. */
3008 resolve_face_name (face_name
)
3009 Lisp_Object face_name
;
3011 Lisp_Object aliased
;
3013 if (STRINGP (face_name
))
3014 face_name
= intern (XSTRING (face_name
)->data
);
3016 while (SYMBOLP (face_name
))
3018 aliased
= Fget (face_name
, Qface_alias
);
3022 face_name
= aliased
;
3029 /* Return the face definition of FACE_NAME on frame F. F null means
3030 return the definition for new frames. FACE_NAME may be a string or
3031 a symbol (apparently Emacs 20.2 allowed strings as face names in
3032 face text properties; Ediff uses that). If FACE_NAME is an alias
3033 for another face, return that face's definition. If SIGNAL_P is
3034 non-zero, signal an error if FACE_NAME is not a valid face name.
3035 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3038 static INLINE Lisp_Object
3039 lface_from_face_name (f
, face_name
, signal_p
)
3041 Lisp_Object face_name
;
3046 face_name
= resolve_face_name (face_name
);
3049 lface
= assq_no_quit (face_name
, f
->face_alist
);
3051 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3054 lface
= XCDR (lface
);
3056 signal_error ("Invalid face", face_name
);
3058 check_lface (lface
);
3063 /* Get face attributes of face FACE_NAME from frame-local faces on
3064 frame F. Store the resulting attributes in ATTRS which must point
3065 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3066 is non-zero, signal an error if FACE_NAME does not name a face.
3067 Otherwise, value is zero if FACE_NAME is not a face. */
3070 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3072 Lisp_Object face_name
;
3079 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3082 bcopy (XVECTOR (lface
)->contents
, attrs
,
3083 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3093 /* Non-zero if all attributes in face attribute vector ATTRS are
3094 specified, i.e. are non-nil. */
3097 lface_fully_specified_p (attrs
)
3102 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3103 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3104 && i
!= LFACE_AVGWIDTH_INDEX
)
3105 if (UNSPECIFIEDP (attrs
[i
]))
3108 return i
== LFACE_VECTOR_SIZE
;
3111 #ifdef HAVE_WINDOW_SYSTEM
3113 /* Set font-related attributes of Lisp face LFACE from the fullname of
3114 the font opened by FONTNAME. If FORCE_P is zero, set only
3115 unspecified attributes of LFACE. The exception is `font'
3116 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3118 If FONTNAME is not available on frame F,
3119 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3120 If the fullname is not in a valid XLFD format,
3121 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3122 in LFACE and return 1.
3123 Otherwise, return 1. */
3126 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3129 Lisp_Object fontname
;
3130 int force_p
, may_fail_p
;
3132 struct font_name font
;
3137 char *font_name
= XSTRING (fontname
)->data
;
3138 struct font_info
*font_info
;
3140 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3141 fontset
= fs_query_fontset (fontname
, 0);
3143 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3145 /* Check if FONT_NAME is surely available on the system. Usually
3146 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3147 returns quickly. But, even if FONT_NAME is not yet cached,
3148 caching it now is not futail because we anyway load the font
3151 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3161 font
.name
= STRDUPA (font_info
->full_name
);
3162 have_xlfd_p
= split_font_name (f
, &font
, 1);
3164 /* Set attributes only if unspecified, otherwise face defaults for
3165 new frames would never take effect. If we couldn't get a font
3166 name conforming to XLFD, set normal values. */
3168 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3173 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3174 + strlen (font
.fields
[XLFD_FOUNDRY
])
3176 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3177 font
.fields
[XLFD_FAMILY
]);
3178 val
= build_string (buffer
);
3181 val
= build_string ("*");
3182 LFACE_FAMILY (lface
) = val
;
3185 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3188 pt
= xlfd_point_size (f
, &font
);
3190 pt
= pixel_point_size (f
, font_info
->height
* 10);
3192 LFACE_HEIGHT (lface
) = make_number (pt
);
3195 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3196 LFACE_SWIDTH (lface
)
3197 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3199 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3200 LFACE_AVGWIDTH (lface
)
3202 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3205 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3206 LFACE_WEIGHT (lface
)
3207 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3209 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3211 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3213 LFACE_FONT (lface
) = fontname
;
3218 #endif /* HAVE_WINDOW_SYSTEM */
3221 /* Merges the face height FROM with the face height TO, and returns the
3222 merged height. If FROM is an invalid height, then INVALID is
3223 returned instead. FROM and TO may be either absolute face heights or
3224 `relative' heights; the returned value is always an absolute height
3225 unless both FROM and TO are relative. GCPRO is a lisp value that
3226 will be protected from garbage-collection if this function makes a
3230 merge_face_heights (from
, to
, invalid
, gcpro
)
3231 Lisp_Object from
, to
, invalid
, gcpro
;
3233 Lisp_Object result
= invalid
;
3235 if (INTEGERP (from
))
3236 /* FROM is absolute, just use it as is. */
3238 else if (FLOATP (from
))
3239 /* FROM is a scale, use it to adjust TO. */
3242 /* relative X absolute => absolute */
3243 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3244 else if (FLOATP (to
))
3245 /* relative X relative => relative */
3246 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3248 else if (FUNCTIONP (from
))
3249 /* FROM is a function, which use to adjust TO. */
3251 /* Call function with current height as argument.
3252 From is the new height. */
3253 Lisp_Object args
[2];
3254 struct gcpro gcpro1
;
3260 result
= safe_call (2, args
);
3264 /* Ensure that if TO was absolute, so is the result. */
3265 if (INTEGERP (to
) && !INTEGERP (result
))
3273 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3274 store the resulting attributes in TO, which must be already be
3275 completely specified and contain only absolute attributes. Every
3276 specified attribute of FROM overrides the corresponding attribute of
3277 TO; relative attributes in FROM are merged with the absolute value in
3278 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3279 face inheritance; it should be Qnil when called from other places. */
3282 merge_face_vectors (f
, from
, to
, cycle_check
)
3284 Lisp_Object
*from
, *to
;
3285 Lisp_Object cycle_check
;
3289 /* If FROM inherits from some other faces, merge their attributes into
3290 TO before merging FROM's direct attributes. Note that an :inherit
3291 attribute of `unspecified' is the same as one of nil; we never
3292 merge :inherit attributes, so nil is more correct, but lots of
3293 other code uses `unspecified' as a generic value for face attributes. */
3294 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3295 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3296 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3298 /* If TO specifies a :font attribute, and FROM specifies some
3299 font-related attribute, we need to clear TO's :font attribute
3300 (because it will be inconsistent with whatever FROM specifies, and
3301 FROM takes precedence). */
3302 if (!NILP (to
[LFACE_FONT_INDEX
])
3303 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3304 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3305 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3306 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3307 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3308 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3309 to
[LFACE_FONT_INDEX
] = Qnil
;
3311 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3312 if (!UNSPECIFIEDP (from
[i
]))
3314 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3315 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3320 /* TO is always an absolute face, which should inherit from nothing.
3321 We blindly copy the :inherit attribute above and fix it up here. */
3322 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3326 /* Checks the `cycle check' variable CHECK to see if it indicates that
3327 EL is part of a cycle; CHECK must be either Qnil or a value returned
3328 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3329 elements after which a cycle might be suspected; after that many
3330 elements, this macro begins consing in order to keep more precise
3333 Returns nil if a cycle was detected, otherwise a new value for CHECK
3336 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3337 the caller should make sure that's ok. */
3339 #define CYCLE_CHECK(check, el, suspicious) \
3342 : (INTEGERP (check) \
3343 ? (XFASTINT (check) < (suspicious) \
3344 ? make_number (XFASTINT (check) + 1) \
3345 : Fcons (el, Qnil)) \
3346 : (!NILP (Fmemq ((el), (check))) \
3348 : Fcons ((el), (check)))))
3351 /* Merge face attributes from the face on frame F whose name is
3352 INHERITS, into the vector of face attributes TO; INHERITS may also be
3353 a list of face names, in which case they are applied in order.
3354 CYCLE_CHECK is used to detect loops in face inheritance.
3355 Returns true if any of the inherited attributes are `font-related'. */
3358 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3360 Lisp_Object inherit
;
3362 Lisp_Object cycle_check
;
3364 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3365 /* Inherit from the named face INHERIT. */
3369 /* Make sure we're not in an inheritance loop. */
3370 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3371 if (NILP (cycle_check
))
3372 /* Cycle detected, ignore any further inheritance. */
3375 lface
= lface_from_face_name (f
, inherit
, 0);
3377 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3379 else if (CONSP (inherit
))
3380 /* Handle a list of inherited faces by calling ourselves recursively
3381 on each element. Note that we only do so for symbol elements, so
3382 it's not possible to infinitely recurse. */
3384 while (CONSP (inherit
))
3386 if (SYMBOLP (XCAR (inherit
)))
3387 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3389 /* Check for a circular inheritance list. */
3390 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3391 if (NILP (cycle_check
))
3392 /* Cycle detected. */
3395 inherit
= XCDR (inherit
);
3401 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3402 is a face property, determine the resulting face attributes on
3403 frame F, and store them in TO. PROP may be a single face
3404 specification or a list of such specifications. Each face
3405 specification can be
3407 1. A symbol or string naming a Lisp face.
3409 2. A property list of the form (KEYWORD VALUE ...) where each
3410 KEYWORD is a face attribute name, and value is an appropriate value
3413 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3414 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3415 for compatibility with 20.2.
3417 Face specifications earlier in lists take precedence over later
3421 merge_face_vector_with_property (f
, to
, prop
)
3428 Lisp_Object first
= XCAR (prop
);
3430 if (EQ (first
, Qforeground_color
)
3431 || EQ (first
, Qbackground_color
))
3433 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3434 . COLOR). COLOR must be a string. */
3435 Lisp_Object color_name
= XCDR (prop
);
3436 Lisp_Object color
= first
;
3438 if (STRINGP (color_name
))
3440 if (EQ (color
, Qforeground_color
))
3441 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3443 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3446 add_to_log ("Invalid face color", color_name
, Qnil
);
3448 else if (SYMBOLP (first
)
3449 && *XSYMBOL (first
)->name
->data
== ':')
3451 /* Assume this is the property list form. */
3452 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3454 Lisp_Object keyword
= XCAR (prop
);
3455 Lisp_Object value
= XCAR (XCDR (prop
));
3457 if (EQ (keyword
, QCfamily
))
3459 if (STRINGP (value
))
3460 to
[LFACE_FAMILY_INDEX
] = value
;
3462 add_to_log ("Invalid face font family", value
, Qnil
);
3464 else if (EQ (keyword
, QCheight
))
3466 Lisp_Object new_height
=
3467 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3470 if (NILP (new_height
))
3471 add_to_log ("Invalid face font height", value
, Qnil
);
3473 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3475 else if (EQ (keyword
, QCweight
))
3478 && face_numeric_weight (value
) >= 0)
3479 to
[LFACE_WEIGHT_INDEX
] = value
;
3481 add_to_log ("Invalid face weight", value
, Qnil
);
3483 else if (EQ (keyword
, QCslant
))
3486 && face_numeric_slant (value
) >= 0)
3487 to
[LFACE_SLANT_INDEX
] = value
;
3489 add_to_log ("Invalid face slant", value
, Qnil
);
3491 else if (EQ (keyword
, QCunderline
))
3496 to
[LFACE_UNDERLINE_INDEX
] = value
;
3498 add_to_log ("Invalid face underline", value
, Qnil
);
3500 else if (EQ (keyword
, QCoverline
))
3505 to
[LFACE_OVERLINE_INDEX
] = value
;
3507 add_to_log ("Invalid face overline", value
, Qnil
);
3509 else if (EQ (keyword
, QCstrike_through
))
3514 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3516 add_to_log ("Invalid face strike-through", value
, Qnil
);
3518 else if (EQ (keyword
, QCbox
))
3521 value
= make_number (1);
3522 if (INTEGERP (value
)
3526 to
[LFACE_BOX_INDEX
] = value
;
3528 add_to_log ("Invalid face box", value
, Qnil
);
3530 else if (EQ (keyword
, QCinverse_video
)
3531 || EQ (keyword
, QCreverse_video
))
3533 if (EQ (value
, Qt
) || NILP (value
))
3534 to
[LFACE_INVERSE_INDEX
] = value
;
3536 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3538 else if (EQ (keyword
, QCforeground
))
3540 if (STRINGP (value
))
3541 to
[LFACE_FOREGROUND_INDEX
] = value
;
3543 add_to_log ("Invalid face foreground", value
, Qnil
);
3545 else if (EQ (keyword
, QCbackground
))
3547 if (STRINGP (value
))
3548 to
[LFACE_BACKGROUND_INDEX
] = value
;
3550 add_to_log ("Invalid face background", value
, Qnil
);
3552 else if (EQ (keyword
, QCstipple
))
3554 #ifdef HAVE_X_WINDOWS
3555 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3556 if (!NILP (pixmap_p
))
3557 to
[LFACE_STIPPLE_INDEX
] = value
;
3559 add_to_log ("Invalid face stipple", value
, Qnil
);
3562 else if (EQ (keyword
, QCwidth
))
3565 && face_numeric_swidth (value
) >= 0)
3566 to
[LFACE_SWIDTH_INDEX
] = value
;
3568 add_to_log ("Invalid face width", value
, Qnil
);
3570 else if (EQ (keyword
, QCinherit
))
3572 if (SYMBOLP (value
))
3573 to
[LFACE_INHERIT_INDEX
] = value
;
3577 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3578 if (!SYMBOLP (XCAR (tail
)))
3581 to
[LFACE_INHERIT_INDEX
] = value
;
3583 add_to_log ("Invalid face inherit", value
, Qnil
);
3587 add_to_log ("Invalid attribute %s in face property",
3590 prop
= XCDR (XCDR (prop
));
3595 /* This is a list of face specs. Specifications at the
3596 beginning of the list take precedence over later
3597 specifications, so we have to merge starting with the
3598 last specification. */
3599 Lisp_Object next
= XCDR (prop
);
3601 merge_face_vector_with_property (f
, to
, next
);
3602 merge_face_vector_with_property (f
, to
, first
);
3607 /* PROP ought to be a face name. */
3608 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3610 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3612 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3617 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3618 Sinternal_make_lisp_face
, 1, 2, 0,
3619 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3620 If FACE was not known as a face before, create a new one.
3621 If optional argument FRAME is specified, make a frame-local face
3622 for that frame. Otherwise operate on the global face definition.
3623 Value is a vector of face attributes. */)
3625 Lisp_Object face
, frame
;
3627 Lisp_Object global_lface
, lface
;
3631 CHECK_SYMBOL (face
);
3632 global_lface
= lface_from_face_name (NULL
, face
, 0);
3636 CHECK_LIVE_FRAME (frame
);
3638 lface
= lface_from_face_name (f
, face
, 0);
3641 f
= NULL
, lface
= Qnil
;
3643 /* Add a global definition if there is none. */
3644 if (NILP (global_lface
))
3646 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3648 AREF (global_lface
, 0) = Qface
;
3649 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3650 Vface_new_frame_defaults
);
3652 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3653 face id to Lisp face is given by the vector lface_id_to_name.
3654 The mapping from Lisp face to Lisp face id is given by the
3655 property `face' of the Lisp face name. */
3656 if (next_lface_id
== lface_id_to_name_size
)
3658 int new_size
= max (50, 2 * lface_id_to_name_size
);
3659 int sz
= new_size
* sizeof *lface_id_to_name
;
3660 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3661 lface_id_to_name_size
= new_size
;
3664 lface_id_to_name
[next_lface_id
] = face
;
3665 Fput (face
, Qface
, make_number (next_lface_id
));
3669 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3670 AREF (global_lface
, i
) = Qunspecified
;
3672 /* Add a frame-local definition. */
3677 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3679 AREF (lface
, 0) = Qface
;
3680 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3683 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3684 AREF (lface
, i
) = Qunspecified
;
3687 lface
= global_lface
;
3689 /* Changing a named face means that all realized faces depending on
3690 that face are invalid. Since we cannot tell which realized faces
3691 depend on the face, make sure they are all removed. This is done
3692 by incrementing face_change_count. The next call to
3693 init_iterator will then free realized faces. */
3694 ++face_change_count
;
3695 ++windows_or_buffers_changed
;
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
);
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
);
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
);
3756 CHECK_LIVE_FRAME (new_frame
);
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
));
3764 /* Changing a named face means that all realized faces depending on
3765 that face are invalid. Since we cannot tell which realized faces
3766 depend on the face, make sure they are all removed. This is done
3767 by incrementing face_change_count. The next call to
3768 init_iterator will then free realized faces. */
3769 ++face_change_count
;
3770 ++windows_or_buffers_changed
;
3776 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3777 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3778 doc
: /* Set attribute ATTR of FACE to VALUE.
3779 FRAME being a frame means change the face on that frame.
3780 FRAME nil means change the face of the selected frame.
3781 FRAME t means change the default for new frames.
3782 FRAME 0 means change the face on all frames, and change the default
3784 (face
, attr
, value
, frame
)
3785 Lisp_Object face
, attr
, value
, frame
;
3788 Lisp_Object old_value
= Qnil
;
3789 /* Set 1 if ATTR is QCfont. */
3790 int font_attr_p
= 0;
3791 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3792 int font_related_attr_p
= 0;
3794 CHECK_SYMBOL (face
);
3795 CHECK_SYMBOL (attr
);
3797 face
= resolve_face_name (face
);
3799 /* If FRAME is 0, change face on all frames, and change the
3800 default for new frames. */
3801 if (INTEGERP (frame
) && XINT (frame
) == 0)
3804 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3805 FOR_EACH_FRAME (tail
, frame
)
3806 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3810 /* Set lface to the Lisp attribute vector of FACE. */
3812 lface
= lface_from_face_name (NULL
, face
, 1);
3816 frame
= selected_frame
;
3818 CHECK_LIVE_FRAME (frame
);
3819 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3821 /* If a frame-local face doesn't exist yet, create one. */
3823 lface
= Finternal_make_lisp_face (face
, frame
);
3826 if (EQ (attr
, QCfamily
))
3828 if (!UNSPECIFIEDP (value
))
3830 CHECK_STRING (value
);
3831 if (XSTRING (value
)->size
== 0)
3832 signal_error ("Invalid face family", value
);
3834 old_value
= LFACE_FAMILY (lface
);
3835 LFACE_FAMILY (lface
) = value
;
3836 font_related_attr_p
= 1;
3838 else if (EQ (attr
, QCheight
))
3840 if (!UNSPECIFIEDP (value
))
3844 test
= (EQ (face
, Qdefault
)
3846 /* The default face must have an absolute size,
3847 otherwise, we do a test merge with a random
3848 height to see if VALUE's ok. */
3849 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3851 if (!INTEGERP (test
) || XINT (test
) <= 0)
3852 signal_error ("Invalid face height", value
);
3855 old_value
= LFACE_HEIGHT (lface
);
3856 LFACE_HEIGHT (lface
) = value
;
3857 font_related_attr_p
= 1;
3859 else if (EQ (attr
, QCweight
))
3861 if (!UNSPECIFIEDP (value
))
3863 CHECK_SYMBOL (value
);
3864 if (face_numeric_weight (value
) < 0)
3865 signal_error ("Invalid face weight", value
);
3867 old_value
= LFACE_WEIGHT (lface
);
3868 LFACE_WEIGHT (lface
) = value
;
3869 font_related_attr_p
= 1;
3871 else if (EQ (attr
, QCslant
))
3873 if (!UNSPECIFIEDP (value
))
3875 CHECK_SYMBOL (value
);
3876 if (face_numeric_slant (value
) < 0)
3877 signal_error ("Invalid face slant", value
);
3879 old_value
= LFACE_SLANT (lface
);
3880 LFACE_SLANT (lface
) = value
;
3881 font_related_attr_p
= 1;
3883 else if (EQ (attr
, QCunderline
))
3885 if (!UNSPECIFIEDP (value
))
3886 if ((SYMBOLP (value
)
3888 && !EQ (value
, Qnil
))
3889 /* Underline color. */
3891 && XSTRING (value
)->size
== 0))
3892 signal_error ("Invalid face underline", value
);
3894 old_value
= LFACE_UNDERLINE (lface
);
3895 LFACE_UNDERLINE (lface
) = value
;
3897 else if (EQ (attr
, QCoverline
))
3899 if (!UNSPECIFIEDP (value
))
3900 if ((SYMBOLP (value
)
3902 && !EQ (value
, Qnil
))
3903 /* Overline color. */
3905 && XSTRING (value
)->size
== 0))
3906 signal_error ("Invalid face overline", value
);
3908 old_value
= LFACE_OVERLINE (lface
);
3909 LFACE_OVERLINE (lface
) = value
;
3911 else if (EQ (attr
, QCstrike_through
))
3913 if (!UNSPECIFIEDP (value
))
3914 if ((SYMBOLP (value
)
3916 && !EQ (value
, Qnil
))
3917 /* Strike-through color. */
3919 && XSTRING (value
)->size
== 0))
3920 signal_error ("Invalid face strike-through", value
);
3922 old_value
= LFACE_STRIKE_THROUGH (lface
);
3923 LFACE_STRIKE_THROUGH (lface
) = value
;
3925 else if (EQ (attr
, QCbox
))
3929 /* Allow t meaning a simple box of width 1 in foreground color
3932 value
= make_number (1);
3934 if (UNSPECIFIEDP (value
))
3936 else if (NILP (value
))
3938 else if (INTEGERP (value
))
3939 valid_p
= XINT (value
) != 0;
3940 else if (STRINGP (value
))
3941 valid_p
= XSTRING (value
)->size
> 0;
3942 else if (CONSP (value
))
3958 if (EQ (k
, QCline_width
))
3960 if (!INTEGERP (v
) || XINT (v
) == 0)
3963 else if (EQ (k
, QCcolor
))
3965 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3968 else if (EQ (k
, QCstyle
))
3970 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3977 valid_p
= NILP (tem
);
3983 signal_error ("Invalid face box", value
);
3985 old_value
= LFACE_BOX (lface
);
3986 LFACE_BOX (lface
) = value
;
3988 else if (EQ (attr
, QCinverse_video
)
3989 || EQ (attr
, QCreverse_video
))
3991 if (!UNSPECIFIEDP (value
))
3993 CHECK_SYMBOL (value
);
3994 if (!EQ (value
, Qt
) && !NILP (value
))
3995 signal_error ("Invalid inverse-video face attribute value", value
);
3997 old_value
= LFACE_INVERSE (lface
);
3998 LFACE_INVERSE (lface
) = value
;
4000 else if (EQ (attr
, QCforeground
))
4002 if (!UNSPECIFIEDP (value
))
4004 /* Don't check for valid color names here because it depends
4005 on the frame (display) whether the color will be valid
4006 when the face is realized. */
4007 CHECK_STRING (value
);
4008 if (XSTRING (value
)->size
== 0)
4009 signal_error ("Empty foreground color value", value
);
4011 old_value
= LFACE_FOREGROUND (lface
);
4012 LFACE_FOREGROUND (lface
) = value
;
4014 else if (EQ (attr
, QCbackground
))
4016 if (!UNSPECIFIEDP (value
))
4018 /* Don't check for valid color names here because it depends
4019 on the frame (display) whether the color will be valid
4020 when the face is realized. */
4021 CHECK_STRING (value
);
4022 if (XSTRING (value
)->size
== 0)
4023 signal_error ("Empty background color value", value
);
4025 old_value
= LFACE_BACKGROUND (lface
);
4026 LFACE_BACKGROUND (lface
) = value
;
4028 else if (EQ (attr
, QCstipple
))
4030 #ifdef HAVE_X_WINDOWS
4031 if (!UNSPECIFIEDP (value
)
4033 && NILP (Fbitmap_spec_p (value
)))
4034 signal_error ("Invalid stipple attribute", value
);
4035 old_value
= LFACE_STIPPLE (lface
);
4036 LFACE_STIPPLE (lface
) = value
;
4037 #endif /* HAVE_X_WINDOWS */
4039 else if (EQ (attr
, QCwidth
))
4041 if (!UNSPECIFIEDP (value
))
4043 CHECK_SYMBOL (value
);
4044 if (face_numeric_swidth (value
) < 0)
4045 signal_error ("Invalid face width", value
);
4047 old_value
= LFACE_SWIDTH (lface
);
4048 LFACE_SWIDTH (lface
) = value
;
4049 font_related_attr_p
= 1;
4051 else if (EQ (attr
, QCfont
))
4053 #ifdef HAVE_WINDOW_SYSTEM
4054 if (EQ (frame
, Qt
) || FRAME_WINDOW_P (XFRAME (frame
)))
4056 /* Set font-related attributes of the Lisp face from an XLFD
4061 CHECK_STRING (value
);
4063 f
= SELECTED_FRAME ();
4065 f
= check_x_frame (frame
);
4067 /* VALUE may be a fontset name or an alias of fontset. In
4068 such a case, use the base fontset name. */
4069 tmp
= Fquery_fontset (value
, Qnil
);
4073 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4074 signal_error ("Invalid font or fontset name", value
);
4078 #endif /* HAVE_WINDOW_SYSTEM */
4080 else if (EQ (attr
, QCinherit
))
4083 if (SYMBOLP (value
))
4086 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4087 if (!SYMBOLP (XCAR (tail
)))
4090 LFACE_INHERIT (lface
) = value
;
4092 signal_error ("Invalid face inheritance", value
);
4094 else if (EQ (attr
, QCbold
))
4096 old_value
= LFACE_WEIGHT (lface
);
4097 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4098 font_related_attr_p
= 1;
4100 else if (EQ (attr
, QCitalic
))
4102 old_value
= LFACE_SLANT (lface
);
4103 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4104 font_related_attr_p
= 1;
4107 signal_error ("Invalid face attribute name", attr
);
4109 if (font_related_attr_p
4110 && !UNSPECIFIEDP (value
))
4111 /* If a font-related attribute other than QCfont is specified, the
4112 original `font' attribute nor that of default face is useless
4113 to determine a new font. Thus, we set it to nil so that font
4114 selection mechanism doesn't use it. */
4115 LFACE_FONT (lface
) = Qnil
;
4117 /* Changing a named face means that all realized faces depending on
4118 that face are invalid. Since we cannot tell which realized faces
4119 depend on the face, make sure they are all removed. This is done
4120 by incrementing face_change_count. The next call to
4121 init_iterator will then free realized faces. */
4123 && (EQ (attr
, QCfont
)
4124 || NILP (Fequal (old_value
, value
))))
4126 ++face_change_count
;
4127 ++windows_or_buffers_changed
;
4130 if (!UNSPECIFIEDP (value
)
4131 && NILP (Fequal (old_value
, value
)))
4137 if (EQ (face
, Qdefault
))
4139 #ifdef HAVE_WINDOW_SYSTEM
4140 /* Changed font-related attributes of the `default' face are
4141 reflected in changed `font' frame parameters. */
4143 && (font_related_attr_p
|| font_attr_p
)
4144 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4145 set_font_frame_param (frame
, lface
);
4147 #endif /* HAVE_WINDOW_SYSTEM */
4149 if (EQ (attr
, QCforeground
))
4150 param
= Qforeground_color
;
4151 else if (EQ (attr
, QCbackground
))
4152 param
= Qbackground_color
;
4154 #ifdef HAVE_WINDOW_SYSTEM
4156 else if (EQ (face
, Qscroll_bar
))
4158 /* Changing the colors of `scroll-bar' sets frame parameters
4159 `scroll-bar-foreground' and `scroll-bar-background'. */
4160 if (EQ (attr
, QCforeground
))
4161 param
= Qscroll_bar_foreground
;
4162 else if (EQ (attr
, QCbackground
))
4163 param
= Qscroll_bar_background
;
4165 #endif /* not WINDOWSNT */
4166 else if (EQ (face
, Qborder
))
4168 /* Changing background color of `border' sets frame parameter
4170 if (EQ (attr
, QCbackground
))
4171 param
= Qborder_color
;
4173 else if (EQ (face
, Qcursor
))
4175 /* Changing background color of `cursor' sets frame parameter
4177 if (EQ (attr
, QCbackground
))
4178 param
= Qcursor_color
;
4180 else if (EQ (face
, Qmouse
))
4182 /* Changing background color of `mouse' sets frame parameter
4184 if (EQ (attr
, QCbackground
))
4185 param
= Qmouse_color
;
4187 #endif /* HAVE_WINDOW_SYSTEM */
4188 else if (EQ (face
, Qmenu
))
4190 /* Indicate that we have to update the menu bar when
4191 realizing faces on FRAME. FRAME t change the
4192 default for new frames. We do this by setting
4193 setting the flag in new face caches */
4196 struct frame
*f
= XFRAME (frame
);
4197 if (FRAME_FACE_CACHE (f
) == NULL
)
4198 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4199 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4202 menu_face_changed_default
= 1;
4208 /* Update `default-frame-alist', which is used for new frames. */
4210 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4213 /* Update the current frame's parameters. */
4216 cons
= XCAR (Vparam_value_alist
);
4217 XSETCAR (cons
, param
);
4218 XSETCDR (cons
, value
);
4219 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4228 #ifdef HAVE_WINDOW_SYSTEM
4230 /* Set the `font' frame parameter of FRAME determined from `default'
4231 face attributes LFACE. If a face or fontset name is explicitely
4232 specfied in LFACE, use it as is. Otherwise, determine a font name
4233 from the other font-related atrributes of LFACE. In that case, if
4234 there's no matching font, signals an error. */
4237 set_font_frame_param (frame
, lface
)
4238 Lisp_Object frame
, lface
;
4240 struct frame
*f
= XFRAME (frame
);
4242 if (FRAME_WINDOW_P (f
))
4244 Lisp_Object font_name
;
4247 if (STRINGP (LFACE_FONT (lface
)))
4248 font_name
= LFACE_FONT (lface
);
4251 /* Choose a font name that reflects LFACE's attributes and has
4252 the registry and encoding pattern specified in the default
4253 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4254 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4256 error ("No font matches the specified attribute");
4257 font_name
= build_string (font
);
4261 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4266 /* Update the corresponding face when frame parameter PARAM on frame F
4267 has been assigned the value NEW_VALUE. */
4270 update_face_from_frame_parameter (f
, param
, new_value
)
4272 Lisp_Object param
, new_value
;
4276 /* If there are no faces yet, give up. This is the case when called
4277 from Fx_create_frame, and we do the necessary things later in
4278 face-set-after-frame-defaults. */
4279 if (NILP (f
->face_alist
))
4282 /* Changing a named face means that all realized faces depending on
4283 that face are invalid. Since we cannot tell which realized faces
4284 depend on the face, make sure they are all removed. This is done
4285 by incrementing face_change_count. The next call to
4286 init_iterator will then free realized faces. */
4287 ++face_change_count
;
4288 ++windows_or_buffers_changed
;
4290 if (EQ (param
, Qforeground_color
))
4292 lface
= lface_from_face_name (f
, Qdefault
, 1);
4293 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4294 ? new_value
: Qunspecified
);
4295 realize_basic_faces (f
);
4297 else if (EQ (param
, Qbackground_color
))
4301 /* Changing the background color might change the background
4302 mode, so that we have to load new defface specs. Call
4303 frame-update-face-colors to do that. */
4304 XSETFRAME (frame
, f
);
4305 call1 (Qframe_update_face_colors
, frame
);
4307 lface
= lface_from_face_name (f
, Qdefault
, 1);
4308 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4309 ? new_value
: Qunspecified
);
4310 realize_basic_faces (f
);
4312 if (EQ (param
, Qborder_color
))
4314 lface
= lface_from_face_name (f
, Qborder
, 1);
4315 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4316 ? new_value
: Qunspecified
);
4318 else if (EQ (param
, Qcursor_color
))
4320 lface
= lface_from_face_name (f
, Qcursor
, 1);
4321 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4322 ? new_value
: Qunspecified
);
4324 else if (EQ (param
, Qmouse_color
))
4326 lface
= lface_from_face_name (f
, Qmouse
, 1);
4327 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4328 ? new_value
: Qunspecified
);
4333 /* Get the value of X resource RESOURCE, class CLASS for the display
4334 of frame FRAME. This is here because ordinary `x-get-resource'
4335 doesn't take a frame argument. */
4337 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4338 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4339 (resource
, class, frame
)
4340 Lisp_Object resource
, class, frame
;
4342 Lisp_Object value
= Qnil
;
4345 CHECK_STRING (resource
);
4346 CHECK_STRING (class);
4347 CHECK_LIVE_FRAME (frame
);
4349 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4350 resource
, class, Qnil
, Qnil
);
4352 #endif /* not macintosh */
4353 #endif /* not WINDOWSNT */
4358 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4359 If VALUE is "on" or "true", return t. If VALUE is "off" or
4360 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4361 error; if SIGNAL_P is zero, return 0. */
4364 face_boolean_x_resource_value (value
, signal_p
)
4368 Lisp_Object result
= make_number (0);
4370 xassert (STRINGP (value
));
4372 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4373 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4375 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4376 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4378 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4379 result
= Qunspecified
;
4381 signal_error ("Invalid face attribute value from X resource", value
);
4387 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4388 Finternal_set_lisp_face_attribute_from_resource
,
4389 Sinternal_set_lisp_face_attribute_from_resource
,
4390 3, 4, 0, doc
: /* */)
4391 (face
, attr
, value
, frame
)
4392 Lisp_Object face
, attr
, value
, frame
;
4394 CHECK_SYMBOL (face
);
4395 CHECK_SYMBOL (attr
);
4396 CHECK_STRING (value
);
4398 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4399 value
= Qunspecified
;
4400 else if (EQ (attr
, QCheight
))
4402 value
= Fstring_to_number (value
, make_number (10));
4403 if (XINT (value
) <= 0)
4404 signal_error ("Invalid face height from X resource", value
);
4406 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4407 value
= face_boolean_x_resource_value (value
, 1);
4408 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4409 value
= intern (XSTRING (value
)->data
);
4410 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4411 value
= face_boolean_x_resource_value (value
, 1);
4412 else if (EQ (attr
, QCunderline
)
4413 || EQ (attr
, QCoverline
)
4414 || EQ (attr
, QCstrike_through
))
4416 Lisp_Object boolean_value
;
4418 /* If the result of face_boolean_x_resource_value is t or nil,
4419 VALUE does NOT specify a color. */
4420 boolean_value
= face_boolean_x_resource_value (value
, 0);
4421 if (SYMBOLP (boolean_value
))
4422 value
= boolean_value
;
4424 else if (EQ (attr
, QCbox
))
4425 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4427 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4430 #endif /* HAVE_WINDOW_SYSTEM */
4433 /***********************************************************************
4435 ***********************************************************************/
4437 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4439 /* Make menus on frame F appear as specified by the `menu' face. */
4442 x_update_menu_appearance (f
)
4445 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4449 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4453 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4454 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4455 char *myname
= XSTRING (Vx_resource_name
)->data
;
4458 const char *popup_path
= "popup_menu";
4460 const char *popup_path
= "menu.popup";
4463 if (STRINGP (LFACE_FOREGROUND (lface
)))
4465 sprintf (line
, "%s.%s*foreground: %s",
4467 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4468 XrmPutLineResource (&rdb
, line
);
4469 sprintf (line
, "%s.pane.menubar*foreground: %s",
4470 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4471 XrmPutLineResource (&rdb
, line
);
4475 if (STRINGP (LFACE_BACKGROUND (lface
)))
4477 sprintf (line
, "%s.%s*background: %s",
4479 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4480 XrmPutLineResource (&rdb
, line
);
4481 sprintf (line
, "%s.pane.menubar*background: %s",
4482 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4483 XrmPutLineResource (&rdb
, line
);
4488 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4489 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4490 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4491 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4492 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4493 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4496 const char *suffix
= "List";
4498 const char *suffix
= "";
4500 sprintf (line
, "%s.pane.menubar*font%s: %s",
4501 myname
, suffix
, face
->font_name
);
4502 XrmPutLineResource (&rdb
, line
);
4503 sprintf (line
, "%s.%s*font%s: %s",
4504 myname
, popup_path
, suffix
, face
->font_name
);
4505 XrmPutLineResource (&rdb
, line
);
4509 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4510 free_frame_menubar (f
);
4514 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4517 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4518 Sface_attribute_relative_p
,
4520 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4522 Lisp_Object attribute
, value
;
4524 if (EQ (value
, Qunspecified
))
4526 else if (EQ (attribute
, QCheight
))
4527 return INTEGERP (value
) ? Qnil
: Qt
;
4532 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4534 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4535 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4536 the result will be absolute, otherwise it will be relative. */)
4537 (attribute
, value1
, value2
)
4538 Lisp_Object attribute
, value1
, value2
;
4540 if (EQ (value1
, Qunspecified
))
4542 else if (EQ (attribute
, QCheight
))
4543 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4549 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4550 Sinternal_get_lisp_face_attribute
,
4552 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4553 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4554 face attribute name, signal an error.
4555 If the optional argument FRAME is given, report on face FACE in that
4556 frame. If FRAME is t, report on the defaults for face FACE (for new
4557 frames). If FRAME is omitted or nil, use the selected frame. */)
4558 (symbol
, keyword
, frame
)
4559 Lisp_Object symbol
, keyword
, frame
;
4561 Lisp_Object lface
, value
= Qnil
;
4563 CHECK_SYMBOL (symbol
);
4564 CHECK_SYMBOL (keyword
);
4567 lface
= lface_from_face_name (NULL
, symbol
, 1);
4571 frame
= selected_frame
;
4572 CHECK_LIVE_FRAME (frame
);
4573 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4576 if (EQ (keyword
, QCfamily
))
4577 value
= LFACE_FAMILY (lface
);
4578 else if (EQ (keyword
, QCheight
))
4579 value
= LFACE_HEIGHT (lface
);
4580 else if (EQ (keyword
, QCweight
))
4581 value
= LFACE_WEIGHT (lface
);
4582 else if (EQ (keyword
, QCslant
))
4583 value
= LFACE_SLANT (lface
);
4584 else if (EQ (keyword
, QCunderline
))
4585 value
= LFACE_UNDERLINE (lface
);
4586 else if (EQ (keyword
, QCoverline
))
4587 value
= LFACE_OVERLINE (lface
);
4588 else if (EQ (keyword
, QCstrike_through
))
4589 value
= LFACE_STRIKE_THROUGH (lface
);
4590 else if (EQ (keyword
, QCbox
))
4591 value
= LFACE_BOX (lface
);
4592 else if (EQ (keyword
, QCinverse_video
)
4593 || EQ (keyword
, QCreverse_video
))
4594 value
= LFACE_INVERSE (lface
);
4595 else if (EQ (keyword
, QCforeground
))
4596 value
= LFACE_FOREGROUND (lface
);
4597 else if (EQ (keyword
, QCbackground
))
4598 value
= LFACE_BACKGROUND (lface
);
4599 else if (EQ (keyword
, QCstipple
))
4600 value
= LFACE_STIPPLE (lface
);
4601 else if (EQ (keyword
, QCwidth
))
4602 value
= LFACE_SWIDTH (lface
);
4603 else if (EQ (keyword
, QCinherit
))
4604 value
= LFACE_INHERIT (lface
);
4605 else if (EQ (keyword
, QCfont
))
4606 value
= LFACE_FONT (lface
);
4608 signal_error ("Invalid face attribute name", keyword
);
4614 DEFUN ("internal-lisp-face-attribute-values",
4615 Finternal_lisp_face_attribute_values
,
4616 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4617 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4618 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4622 Lisp_Object result
= Qnil
;
4624 CHECK_SYMBOL (attr
);
4626 if (EQ (attr
, QCweight
)
4627 || EQ (attr
, QCslant
)
4628 || EQ (attr
, QCwidth
))
4630 /* Extract permissible symbols from tables. */
4631 struct table_entry
*table
;
4634 if (EQ (attr
, QCweight
))
4635 table
= weight_table
, dim
= DIM (weight_table
);
4636 else if (EQ (attr
, QCslant
))
4637 table
= slant_table
, dim
= DIM (slant_table
);
4639 table
= swidth_table
, dim
= DIM (swidth_table
);
4641 for (i
= 0; i
< dim
; ++i
)
4643 Lisp_Object symbol
= *table
[i
].symbol
;
4644 Lisp_Object tail
= result
;
4647 && !EQ (XCAR (tail
), symbol
))
4651 result
= Fcons (symbol
, result
);
4654 else if (EQ (attr
, QCunderline
))
4655 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4656 else if (EQ (attr
, QCoverline
))
4657 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4658 else if (EQ (attr
, QCstrike_through
))
4659 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4660 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4661 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4667 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4668 Sinternal_merge_in_global_face
, 2, 2, 0,
4669 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4670 Default face attributes override any local face attributes. */)
4672 Lisp_Object face
, frame
;
4675 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4677 CHECK_LIVE_FRAME (frame
);
4678 global_lface
= lface_from_face_name (NULL
, face
, 1);
4679 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4680 if (NILP (local_lface
))
4681 local_lface
= Finternal_make_lisp_face (face
, frame
);
4683 /* Make every specified global attribute override the local one.
4684 BEWARE!! This is only used from `face-set-after-frame-default' where
4685 the local frame is defined from default specs in `face-defface-spec'
4686 and those should be overridden by global settings. Hence the strange
4687 "global before local" priority. */
4688 lvec
= XVECTOR (local_lface
)->contents
;
4689 gvec
= XVECTOR (global_lface
)->contents
;
4690 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4691 if (! UNSPECIFIEDP (gvec
[i
]))
4698 /* The following function is implemented for compatibility with 20.2.
4699 The function is used in x-resolve-fonts when it is asked to
4700 return fonts with the same size as the font of a face. This is
4701 done in fontset.el. */
4703 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4704 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4705 If the optional argument FRAME is given, report on face FACE in that frame.
4706 If FRAME is t, report on the defaults for face FACE (for new frames).
4707 The font default for a face is either nil, or a list
4708 of the form (bold), (italic) or (bold italic).
4709 If FRAME is omitted or nil, use the selected frame. */)
4711 Lisp_Object face
, frame
;
4715 Lisp_Object result
= Qnil
;
4716 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4718 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4719 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4720 result
= Fcons (Qbold
, result
);
4722 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4723 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4724 result
= Fcons (Qitalic
, result
);
4730 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4731 int face_id
= lookup_named_face (f
, face
, 0);
4732 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4733 return face
? build_string (face
->font_name
) : Qnil
;
4738 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4739 all attributes are `equal'. Tries to be fast because this function
4740 is called quite often. */
4743 lface_equal_p (v1
, v2
)
4744 Lisp_Object
*v1
, *v2
;
4748 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4750 Lisp_Object a
= v1
[i
];
4751 Lisp_Object b
= v2
[i
];
4753 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4754 and the other is specified. */
4755 equal_p
= XTYPE (a
) == XTYPE (b
);
4764 equal_p
= ((STRING_BYTES (XSTRING (a
))
4765 == STRING_BYTES (XSTRING (b
)))
4766 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4767 STRING_BYTES (XSTRING (a
))) == 0);
4776 equal_p
= !NILP (Fequal (a
, b
));
4786 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4787 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4788 doc
: /* True if FACE1 and FACE2 are equal.
4789 If the optional argument FRAME is given, report on face FACE in that frame.
4790 If FRAME is t, report on the defaults for face FACE (for new frames).
4791 If FRAME is omitted or nil, use the selected frame. */)
4792 (face1
, face2
, frame
)
4793 Lisp_Object face1
, face2
, frame
;
4797 Lisp_Object lface1
, lface2
;
4802 /* Don't use check_x_frame here because this function is called
4803 before X frames exist. At that time, if FRAME is nil,
4804 selected_frame will be used which is the frame dumped with
4805 Emacs. That frame is not an X frame. */
4806 f
= frame_or_selected_frame (frame
, 2);
4808 lface1
= lface_from_face_name (NULL
, face1
, 1);
4809 lface2
= lface_from_face_name (NULL
, face2
, 1);
4810 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4811 XVECTOR (lface2
)->contents
);
4812 return equal_p
? Qt
: Qnil
;
4816 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4817 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4818 doc
: /* True if FACE has no attribute specified.
4819 If the optional argument FRAME is given, report on face FACE in that frame.
4820 If FRAME is t, report on the defaults for face FACE (for new frames).
4821 If FRAME is omitted or nil, use the selected frame. */)
4823 Lisp_Object face
, frame
;
4830 frame
= selected_frame
;
4831 CHECK_LIVE_FRAME (frame
);
4835 lface
= lface_from_face_name (NULL
, face
, 1);
4837 lface
= lface_from_face_name (f
, face
, 1);
4839 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4840 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4843 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4847 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4849 doc
: /* Return an alist of frame-local faces defined on FRAME.
4850 For internal use only. */)
4854 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4855 return f
->face_alist
;
4859 /* Return a hash code for Lisp string STRING with case ignored. Used
4860 below in computing a hash value for a Lisp face. */
4862 static INLINE
unsigned
4863 hash_string_case_insensitive (string
)
4868 xassert (STRINGP (string
));
4869 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4870 hash
= (hash
<< 1) ^ tolower (*s
);
4875 /* Return a hash code for face attribute vector V. */
4877 static INLINE
unsigned
4881 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4882 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4883 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4884 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4885 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4886 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4887 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4891 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4892 considering charsets/registries). They do if they specify the same
4893 family, point size, weight, width, slant, and fontset. Both LFACE1
4894 and LFACE2 must be fully-specified. */
4897 lface_same_font_attributes_p (lface1
, lface2
)
4898 Lisp_Object
*lface1
, *lface2
;
4900 xassert (lface_fully_specified_p (lface1
)
4901 && lface_fully_specified_p (lface2
));
4902 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4903 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4904 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4905 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4906 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4907 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4908 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4909 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4910 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4911 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4912 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4913 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4918 /***********************************************************************
4920 ***********************************************************************/
4922 /* Allocate and return a new realized face for Lisp face attribute
4925 static struct face
*
4926 make_realized_face (attr
)
4929 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4930 bzero (face
, sizeof *face
);
4931 face
->ascii_face
= face
;
4932 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4937 /* Free realized face FACE, including its X resources. FACE may
4941 free_realized_face (f
, face
)
4947 #ifdef HAVE_WINDOW_SYSTEM
4948 if (FRAME_WINDOW_P (f
))
4950 /* Free fontset of FACE if it is ASCII face. */
4951 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4952 free_face_fontset (f
, face
);
4955 x_free_gc (f
, face
->gc
);
4959 free_face_colors (f
, face
);
4960 x_destroy_bitmap (f
, face
->stipple
);
4962 #endif /* HAVE_WINDOW_SYSTEM */
4969 /* Prepare face FACE for subsequent display on frame F. This
4970 allocated GCs if they haven't been allocated yet or have been freed
4971 by clearing the face cache. */
4974 prepare_face_for_display (f
, face
)
4978 #ifdef HAVE_WINDOW_SYSTEM
4979 xassert (FRAME_WINDOW_P (f
));
4984 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4986 xgcv
.foreground
= face
->foreground
;
4987 xgcv
.background
= face
->background
;
4988 #ifdef HAVE_X_WINDOWS
4989 xgcv
.graphics_exposures
= False
;
4991 /* The font of FACE may be null if we couldn't load it. */
4994 #ifdef HAVE_X_WINDOWS
4995 xgcv
.font
= face
->font
->fid
;
4998 xgcv
.font
= face
->font
;
5001 xgcv
.font
= face
->font
;
5007 #ifdef HAVE_X_WINDOWS
5010 xgcv
.fill_style
= FillOpaqueStippled
;
5011 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5012 mask
|= GCFillStyle
| GCStipple
;
5015 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5018 #endif /* HAVE_WINDOW_SYSTEM */
5022 /***********************************************************************
5024 ***********************************************************************/
5026 /* Return a new face cache for frame F. */
5028 static struct face_cache
*
5032 struct face_cache
*c
;
5035 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5036 bzero (c
, sizeof *c
);
5037 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5038 c
->buckets
= (struct face
**) xmalloc (size
);
5039 bzero (c
->buckets
, size
);
5041 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5043 c
->menu_face_changed_p
= menu_face_changed_default
;
5048 /* Clear out all graphics contexts for all realized faces, except for
5049 the basic faces. This should be done from time to time just to avoid
5050 keeping too many graphics contexts that are no longer needed. */
5054 struct face_cache
*c
;
5056 if (c
&& FRAME_WINDOW_P (c
->f
))
5058 #ifdef HAVE_WINDOW_SYSTEM
5060 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5062 struct face
*face
= c
->faces_by_id
[i
];
5063 if (face
&& face
->gc
)
5065 x_free_gc (c
->f
, face
->gc
);
5069 #endif /* HAVE_WINDOW_SYSTEM */
5074 /* Free all realized faces in face cache C, including basic faces. C
5075 may be null. If faces are freed, make sure the frame's current
5076 matrix is marked invalid, so that a display caused by an expose
5077 event doesn't try to use faces we destroyed. */
5080 free_realized_faces (c
)
5081 struct face_cache
*c
;
5086 struct frame
*f
= c
->f
;
5088 /* We must block input here because we can't process X events
5089 safely while only some faces are freed, or when the frame's
5090 current matrix still references freed faces. */
5093 for (i
= 0; i
< c
->used
; ++i
)
5095 free_realized_face (f
, c
->faces_by_id
[i
]);
5096 c
->faces_by_id
[i
] = NULL
;
5100 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5101 bzero (c
->buckets
, size
);
5103 /* Must do a thorough redisplay the next time. Mark current
5104 matrices as invalid because they will reference faces freed
5105 above. This function is also called when a frame is
5106 destroyed. In this case, the root window of F is nil. */
5107 if (WINDOWP (f
->root_window
))
5109 clear_current_matrices (f
);
5110 ++windows_or_buffers_changed
;
5118 /* Free all faces realized for multibyte characters on frame F that
5122 free_realized_multibyte_face (f
, fontset
)
5126 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5130 /* We must block input here because we can't process X events safely
5131 while only some faces are freed, or when the frame's current
5132 matrix still references freed faces. */
5135 for (i
= 0; i
< cache
->used
; i
++)
5137 face
= cache
->faces_by_id
[i
];
5139 && face
!= face
->ascii_face
5140 && face
->fontset
== fontset
)
5142 uncache_face (cache
, face
);
5143 free_realized_face (f
, face
);
5147 /* Must do a thorough redisplay the next time. Mark current
5148 matrices as invalid because they will reference faces freed
5149 above. This function is also called when a frame is destroyed.
5150 In this case, the root window of F is nil. */
5151 if (WINDOWP (f
->root_window
))
5153 clear_current_matrices (f
);
5154 ++windows_or_buffers_changed
;
5161 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5162 This is done after attributes of a named face have been changed,
5163 because we can't tell which realized faces depend on that face. */
5166 free_all_realized_faces (frame
)
5172 FOR_EACH_FRAME (rest
, frame
)
5173 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5176 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5180 /* Free face cache C and faces in it, including their X resources. */
5184 struct face_cache
*c
;
5188 free_realized_faces (c
);
5190 xfree (c
->faces_by_id
);
5196 /* Cache realized face FACE in face cache C. HASH is the hash value
5197 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5198 collision list of the face hash table of C. This is done because
5199 otherwise lookup_face would find FACE for every character, even if
5200 faces with the same attributes but for specific characters exist. */
5203 cache_face (c
, face
, hash
)
5204 struct face_cache
*c
;
5208 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5212 if (face
->fontset
>= 0)
5214 struct face
*last
= c
->buckets
[i
];
5225 c
->buckets
[i
] = face
;
5226 face
->prev
= face
->next
= NULL
;
5232 face
->next
= c
->buckets
[i
];
5234 face
->next
->prev
= face
;
5235 c
->buckets
[i
] = face
;
5238 /* Find a free slot in C->faces_by_id and use the index of the free
5239 slot as FACE->id. */
5240 for (i
= 0; i
< c
->used
; ++i
)
5241 if (c
->faces_by_id
[i
] == NULL
)
5245 /* Maybe enlarge C->faces_by_id. */
5246 if (i
== c
->used
&& c
->used
== c
->size
)
5248 int new_size
= 2 * c
->size
;
5249 int sz
= new_size
* sizeof *c
->faces_by_id
;
5250 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5255 /* Check that FACE got a unique id. */
5260 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5261 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5267 #endif /* GLYPH_DEBUG */
5269 c
->faces_by_id
[i
] = face
;
5275 /* Remove face FACE from cache C. */
5278 uncache_face (c
, face
)
5279 struct face_cache
*c
;
5282 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5285 face
->prev
->next
= face
->next
;
5287 c
->buckets
[i
] = face
->next
;
5290 face
->next
->prev
= face
->prev
;
5292 c
->faces_by_id
[face
->id
] = NULL
;
5293 if (face
->id
== c
->used
)
5298 /* Look up a realized face with face attributes ATTR in the face cache
5299 of frame F. The face will be used to display character C. Value
5300 is the ID of the face found. If no suitable face is found, realize
5301 a new one. In that case, if C is a multibyte character, BASE_FACE
5302 is a face that has the same attributes. */
5305 lookup_face (f
, attr
, c
, base_face
)
5309 struct face
*base_face
;
5311 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5316 xassert (cache
!= NULL
);
5317 check_lface_attrs (attr
);
5319 /* Look up ATTR in the face cache. */
5320 hash
= lface_hash (attr
);
5321 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5323 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5324 if (face
->hash
== hash
5325 && (!FRAME_WINDOW_P (f
)
5326 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5327 && lface_equal_p (face
->lface
, attr
))
5330 /* If not found, realize a new face. */
5332 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5335 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5337 /* When this function is called from face_for_char (in this case, C is
5338 a multibyte character), a fontset of a face returned by
5339 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5340 C) is not sutisfied. The fontset is set for this face by
5341 face_for_char later. */
5343 if (FRAME_WINDOW_P (f
))
5344 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5346 #endif /* GLYPH_DEBUG */
5352 /* Return the face id of the realized face for named face SYMBOL on
5353 frame F suitable for displaying character C. Value is -1 if the
5354 face couldn't be determined, which might happen if the default face
5355 isn't realized and cannot be realized. */
5358 lookup_named_face (f
, symbol
, c
)
5363 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5364 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5365 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5367 if (default_face
== NULL
)
5369 if (!realize_basic_faces (f
))
5371 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5374 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5375 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5376 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5377 return lookup_face (f
, attrs
, c
, NULL
);
5381 /* Return the ID of the realized ASCII face of Lisp face with ID
5382 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5385 ascii_face_of_lisp_face (f
, lface_id
)
5391 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5393 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5394 face_id
= lookup_named_face (f
, face_name
, 0);
5403 /* Return a face for charset ASCII that is like the face with id
5404 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5405 STEPS < 0 means larger. Value is the id of the face. */
5408 smaller_face (f
, face_id
, steps
)
5412 #ifdef HAVE_WINDOW_SYSTEM
5414 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5415 int pt
, last_pt
, last_height
;
5418 struct face
*new_face
;
5420 /* If not called for an X frame, just return the original face. */
5421 if (FRAME_TERMCAP_P (f
))
5424 /* Try in increments of 1/2 pt. */
5425 delta
= steps
< 0 ? 5 : -5;
5426 steps
= abs (steps
);
5428 face
= FACE_FROM_ID (f
, face_id
);
5429 bcopy (face
->lface
, attrs
, sizeof attrs
);
5430 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5431 new_face_id
= face_id
;
5432 last_height
= FONT_HEIGHT (face
->font
);
5436 /* Give up if we cannot find a font within 10pt. */
5437 && abs (last_pt
- pt
) < 100)
5439 /* Look up a face for a slightly smaller/larger font. */
5441 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5442 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5443 new_face
= FACE_FROM_ID (f
, new_face_id
);
5445 /* If height changes, count that as one step. */
5446 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5447 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5450 last_height
= FONT_HEIGHT (new_face
->font
);
5457 #else /* not HAVE_WINDOW_SYSTEM */
5461 #endif /* not HAVE_WINDOW_SYSTEM */
5465 /* Return a face for charset ASCII that is like the face with id
5466 FACE_ID on frame F, but has height HEIGHT. */
5469 face_with_height (f
, face_id
, height
)
5474 #ifdef HAVE_WINDOW_SYSTEM
5476 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5478 if (FRAME_TERMCAP_P (f
)
5482 face
= FACE_FROM_ID (f
, face_id
);
5483 bcopy (face
->lface
, attrs
, sizeof attrs
);
5484 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5485 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5486 #endif /* HAVE_WINDOW_SYSTEM */
5492 /* Return the face id of the realized face for named face SYMBOL on
5493 frame F suitable for displaying character C, and use attributes of
5494 the face FACE_ID for attributes that aren't completely specified by
5495 SYMBOL. This is like lookup_named_face, except that the default
5496 attributes come from FACE_ID, not from the default face. FACE_ID
5497 is assumed to be already realized. */
5500 lookup_derived_face (f
, symbol
, c
, face_id
)
5506 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5507 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5508 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5513 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5514 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5515 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5516 return lookup_face (f
, attrs
, c
, default_face
);
5519 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5520 Sface_attributes_as_vector
, 1, 1, 0,
5521 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5526 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5528 merge_face_vector_with_property (XFRAME (selected_frame
),
5529 XVECTOR (lface
)->contents
,
5536 /***********************************************************************
5538 ***********************************************************************/
5540 DEFUN ("internal-set-font-selection-order",
5541 Finternal_set_font_selection_order
,
5542 Sinternal_set_font_selection_order
, 1, 1, 0,
5543 doc
: /* Set font selection order for face font selection to ORDER.
5544 ORDER must be a list of length 4 containing the symbols `:width',
5545 `:height', `:weight', and `:slant'. Face attributes appearing
5546 first in ORDER are matched first, e.g. if `:height' appears before
5547 `:weight' in ORDER, font selection first tries to find a font with
5548 a suitable height, and then tries to match the font weight.
5555 int indices
[DIM (font_sort_order
)];
5558 bzero (indices
, sizeof indices
);
5562 CONSP (list
) && i
< DIM (indices
);
5563 list
= XCDR (list
), ++i
)
5565 Lisp_Object attr
= XCAR (list
);
5568 if (EQ (attr
, QCwidth
))
5570 else if (EQ (attr
, QCheight
))
5571 xlfd
= XLFD_POINT_SIZE
;
5572 else if (EQ (attr
, QCweight
))
5574 else if (EQ (attr
, QCslant
))
5579 if (indices
[i
] != 0)
5584 if (!NILP (list
) || i
!= DIM (indices
))
5585 signal_error ("Invalid font sort order", order
);
5586 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5587 if (indices
[i
] == 0)
5588 signal_error ("Invalid font sort order", order
);
5590 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5592 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5593 free_all_realized_faces (Qnil
);
5600 DEFUN ("internal-set-alternative-font-family-alist",
5601 Finternal_set_alternative_font_family_alist
,
5602 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5603 doc
: /* Define alternative font families to try in face font selection.
5604 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5605 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5606 be found. Value is ALIST. */)
5611 Vface_alternative_font_family_alist
= alist
;
5612 free_all_realized_faces (Qnil
);
5617 DEFUN ("internal-set-alternative-font-registry-alist",
5618 Finternal_set_alternative_font_registry_alist
,
5619 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5620 doc
: /* Define alternative font registries to try in face font selection.
5621 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5622 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5623 be found. Value is ALIST. */)
5628 Vface_alternative_font_registry_alist
= alist
;
5629 free_all_realized_faces (Qnil
);
5634 #ifdef HAVE_WINDOW_SYSTEM
5636 /* Value is non-zero if FONT is the name of a scalable font. The
5637 X11R6 XLFD spec says that point size, pixel size, and average width
5638 are zero for scalable fonts. Intlfonts contain at least one
5639 scalable font ("*-muleindian-1") for which this isn't true, so we
5640 just test average width. */
5643 font_scalable_p (font
)
5644 struct font_name
*font
;
5646 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5647 return (*s
== '0' && *(s
+ 1) == '\0')
5649 /* Windows implementation of XLFD is slightly broken for backward
5650 compatibility with previous broken versions, so test for
5651 wildcards as well as 0. */
5658 /* Ignore the difference of font point size less than this value. */
5660 #define FONT_POINT_SIZE_QUANTUM 5
5662 /* Value is non-zero if FONT1 is a better match for font attributes
5663 VALUES than FONT2. VALUES is an array of face attribute values in
5664 font sort order. COMPARE_PT_P zero means don't compare point
5665 sizes. AVGWIDTH, if not zero, is a specified font average width
5669 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5671 struct font_name
*font1
, *font2
;
5672 int compare_pt_p
, avgwidth
;
5676 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5678 int xlfd_idx
= font_sort_order
[i
];
5680 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5682 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5683 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5685 if (xlfd_idx
== XLFD_POINT_SIZE
5686 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5688 if (delta1
> delta2
)
5690 else if (delta1
< delta2
)
5694 /* The difference may be equal because, e.g., the face
5695 specifies `italic' but we have only `regular' and
5696 `oblique'. Prefer `oblique' in this case. */
5697 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5698 && font1
->numeric
[xlfd_idx
] > values
[i
]
5699 && font2
->numeric
[xlfd_idx
] < values
[i
])
5707 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5708 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5709 if (delta1
> delta2
)
5711 else if (delta1
< delta2
)
5715 return font1
->registry_priority
< font2
->registry_priority
;
5719 /* Value is non-zero if FONT is an exact match for face attributes in
5720 SPECIFIED. SPECIFIED is an array of face attribute values in font
5721 sort order. AVGWIDTH, if non-zero, is an average width to compare
5725 exact_face_match_p (specified
, font
, avgwidth
)
5727 struct font_name
*font
;
5732 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5733 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5736 return (i
== DIM (font_sort_order
)
5738 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5742 /* Value is the name of a scaled font, generated from scalable font
5743 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5744 Value is allocated from heap. */
5747 build_scalable_font_name (f
, font
, specified_pt
)
5749 struct font_name
*font
;
5752 char point_size
[20], pixel_size
[20];
5754 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5757 /* If scalable font is for a specific resolution, compute
5758 the point size we must specify from the resolution of
5759 the display and the specified resolution of the font. */
5760 if (font
->numeric
[XLFD_RESY
] != 0)
5762 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5763 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5768 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5771 /* Set point size of the font. */
5772 sprintf (point_size
, "%d", (int) pt
);
5773 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5774 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5776 /* Set pixel size. */
5777 sprintf (pixel_size
, "%d", pixel_value
);
5778 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5779 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5781 /* If font doesn't specify its resolution, use the
5782 resolution of the display. */
5783 if (font
->numeric
[XLFD_RESY
] == 0)
5786 sprintf (buffer
, "%d", (int) resy
);
5787 font
->fields
[XLFD_RESY
] = buffer
;
5788 font
->numeric
[XLFD_RESY
] = resy
;
5791 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5794 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5795 sprintf (buffer
, "%d", resx
);
5796 font
->fields
[XLFD_RESX
] = buffer
;
5797 font
->numeric
[XLFD_RESX
] = resx
;
5800 return build_font_name (font
);
5804 /* Value is non-zero if we are allowed to use scalable font FONT. We
5805 can't run a Lisp function here since this function may be called
5806 with input blocked. */
5809 may_use_scalable_font_p (font
)
5812 if (EQ (Vscalable_fonts_allowed
, Qt
))
5814 else if (CONSP (Vscalable_fonts_allowed
))
5816 Lisp_Object tail
, regexp
;
5818 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5820 regexp
= XCAR (tail
);
5821 if (STRINGP (regexp
)
5822 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5832 /* Return the name of the best matching font for face attributes ATTRS
5833 in the array of font_name structures FONTS which contains NFONTS
5834 elements. WIDTH_RATIO is a factor with which to multiply average
5835 widths if ATTRS specifies such a width.
5837 Value is a font name which is allocated from the heap. FONTS is
5838 freed by this function. */
5841 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5844 struct font_name
*fonts
;
5849 struct font_name
*best
;
5852 int exact_p
, avgwidth
;
5857 /* Make specified font attributes available in `specified',
5858 indexed by sort order. */
5859 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5861 int xlfd_idx
= font_sort_order
[i
];
5863 if (xlfd_idx
== XLFD_SWIDTH
)
5864 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5865 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5866 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5867 else if (xlfd_idx
== XLFD_WEIGHT
)
5868 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5869 else if (xlfd_idx
== XLFD_SLANT
)
5870 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5875 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5877 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5881 /* Start with the first non-scalable font in the list. */
5882 for (i
= 0; i
< nfonts
; ++i
)
5883 if (!font_scalable_p (fonts
+ i
))
5886 /* Find the best match among the non-scalable fonts. */
5891 for (i
= 1; i
< nfonts
; ++i
)
5892 if (!font_scalable_p (fonts
+ i
)
5893 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5897 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5906 /* Unless we found an exact match among non-scalable fonts, see if
5907 we can find a better match among scalable fonts. */
5910 /* A scalable font is better if
5912 1. its weight, slant, swidth attributes are better, or.
5914 2. the best non-scalable font doesn't have the required
5915 point size, and the scalable fonts weight, slant, swidth
5918 int non_scalable_has_exact_height_p
;
5920 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5921 non_scalable_has_exact_height_p
= 1;
5923 non_scalable_has_exact_height_p
= 0;
5925 for (i
= 0; i
< nfonts
; ++i
)
5926 if (font_scalable_p (fonts
+ i
))
5929 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5930 || (!non_scalable_has_exact_height_p
5931 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5936 if (font_scalable_p (best
))
5937 font_name
= build_scalable_font_name (f
, best
, pt
);
5939 font_name
= build_font_name (best
);
5941 /* Free font_name structures. */
5942 free_font_names (fonts
, nfonts
);
5948 /* Get a list of matching fonts on frame F, considering FAMILY
5949 and alternative font families from Vface_alternative_font_registry_alist.
5951 FAMILY is the font family whose alternatives are considered.
5953 REGISTRY, if a string, specifies a font registry and encoding to
5954 match. A value of nil means include fonts of any registry and
5957 Return in *FONTS a pointer to a vector of font_name structures for
5958 the fonts matched. Value is the number of fonts found. */
5961 try_alternative_families (f
, family
, registry
, fonts
)
5963 Lisp_Object family
, registry
;
5964 struct font_name
**fonts
;
5969 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5972 /* Try alternative font families. */
5973 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5976 for (alter
= XCDR (alter
);
5977 CONSP (alter
) && nfonts
== 0;
5978 alter
= XCDR (alter
))
5980 if (STRINGP (XCAR (alter
)))
5981 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5985 /* Try scalable fonts before giving up. */
5986 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5988 int count
= BINDING_STACK_SIZE ();
5989 specbind (Qscalable_fonts_allowed
, Qt
);
5990 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5991 unbind_to (count
, Qnil
);
5998 /* Get a list of matching fonts on frame F.
6000 FAMILY, if a string, specifies a font family derived from the fontset.
6001 It is only used if the face does not specify any family in ATTRS or
6002 if we cannot find any font of the face's family.
6004 REGISTRY, if a string, specifies a font registry and encoding to
6005 match. A value of nil means include fonts of any registry and
6008 Return in *FONTS a pointer to a vector of font_name structures for
6009 the fonts matched. Value is the number of fonts found. */
6012 try_font_list (f
, attrs
, family
, registry
, fonts
)
6015 Lisp_Object family
, registry
;
6016 struct font_name
**fonts
;
6019 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6021 if (STRINGP (face_family
))
6022 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
6024 if (nfonts
== 0 && !NILP (family
))
6025 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6027 /* Try font family of the default face or "fixed". */
6030 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6032 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6034 family
= build_string ("fixed");
6035 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6038 /* Try any family with the given registry. */
6040 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6046 /* Return the fontset id of the base fontset name or alias name given
6047 by the fontset attribute of ATTRS. Value is -1 if the fontset
6048 attribute of ATTRS doesn't name a fontset. */
6051 face_fontset (attrs
)
6056 name
= attrs
[LFACE_FONT_INDEX
];
6057 if (!STRINGP (name
))
6059 return fs_query_fontset (name
, 0);
6063 /* Choose a name of font to use on frame F to display character C with
6064 Lisp face attributes specified by ATTRS. The font name is
6065 determined by the font-related attributes in ATTRS and the name
6066 pattern for C in FONTSET. Value is the font name which is
6067 allocated from the heap and must be freed by the caller, or NULL if
6068 we can get no information about the font name of C. It is assured
6069 that we always get some information for a single byte
6073 choose_face_font (f
, attrs
, fontset
, c
)
6078 Lisp_Object pattern
;
6079 char *font_name
= NULL
;
6080 struct font_name
*fonts
;
6081 int nfonts
, width_ratio
;
6083 /* Get (foundry and) family name and registry (and encoding) name of
6085 pattern
= fontset_font_pattern (f
, fontset
, c
);
6088 xassert (!SINGLE_BYTE_CHAR_P (c
));
6092 /* If what we got is a name pattern, return it. */
6093 if (STRINGP (pattern
))
6094 return xstrdup (XSTRING (pattern
)->data
);
6096 /* Get a list of fonts matching that pattern and choose the
6097 best match for the specified face attributes from it. */
6098 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6099 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6101 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6102 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6106 #endif /* HAVE_WINDOW_SYSTEM */
6110 /***********************************************************************
6112 ***********************************************************************/
6114 /* Realize basic faces on frame F. Value is zero if frame parameters
6115 of F don't contain enough information needed to realize the default
6119 realize_basic_faces (f
)
6123 int count
= BINDING_STACK_SIZE ();
6125 /* Block input here so that we won't be surprised by an X expose
6126 event, for instance, without having the faces set up. */
6128 specbind (Qscalable_fonts_allowed
, Qt
);
6130 if (realize_default_face (f
))
6132 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6133 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6134 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6135 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6136 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6137 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6138 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6139 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6140 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6141 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6143 /* Reflect changes in the `menu' face in menu bars. */
6144 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6146 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6147 #ifdef USE_X_TOOLKIT
6148 x_update_menu_appearance (f
);
6155 unbind_to (count
, Qnil
);
6161 /* Realize the default face on frame F. If the face is not fully
6162 specified, make it fully-specified. Attributes of the default face
6163 that are not explicitly specified are taken from frame parameters. */
6166 realize_default_face (f
)
6169 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6171 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6172 Lisp_Object frame_font
;
6175 /* If the `default' face is not yet known, create it. */
6176 lface
= lface_from_face_name (f
, Qdefault
, 0);
6180 XSETFRAME (frame
, f
);
6181 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6184 #ifdef HAVE_WINDOW_SYSTEM
6185 if (FRAME_WINDOW_P (f
))
6187 /* Set frame_font to the value of the `font' frame parameter. */
6188 frame_font
= Fassq (Qfont
, f
->param_alist
);
6189 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6190 frame_font
= XCDR (frame_font
);
6191 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6193 #endif /* HAVE_WINDOW_SYSTEM */
6195 if (!FRAME_WINDOW_P (f
))
6197 LFACE_FAMILY (lface
) = build_string ("default");
6198 LFACE_SWIDTH (lface
) = Qnormal
;
6199 LFACE_HEIGHT (lface
) = make_number (1);
6200 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6201 LFACE_WEIGHT (lface
) = Qnormal
;
6202 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6203 LFACE_SLANT (lface
) = Qnormal
;
6204 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6207 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6208 LFACE_UNDERLINE (lface
) = Qnil
;
6210 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6211 LFACE_OVERLINE (lface
) = Qnil
;
6213 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6214 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6216 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6217 LFACE_BOX (lface
) = Qnil
;
6219 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6220 LFACE_INVERSE (lface
) = Qnil
;
6222 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6224 /* This function is called so early that colors are not yet
6225 set in the frame parameter list. */
6226 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6228 if (CONSP (color
) && STRINGP (XCDR (color
)))
6229 LFACE_FOREGROUND (lface
) = XCDR (color
);
6230 else if (FRAME_WINDOW_P (f
))
6232 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6233 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6238 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6240 /* This function is called so early that colors are not yet
6241 set in the frame parameter list. */
6242 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6243 if (CONSP (color
) && STRINGP (XCDR (color
)))
6244 LFACE_BACKGROUND (lface
) = XCDR (color
);
6245 else if (FRAME_WINDOW_P (f
))
6247 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6248 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6253 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6254 LFACE_STIPPLE (lface
) = Qnil
;
6256 /* Realize the face; it must be fully-specified now. */
6257 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6258 check_lface (lface
);
6259 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6260 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6265 /* Realize basic faces other than the default face in face cache C.
6266 SYMBOL is the face name, ID is the face id the realized face must
6267 have. The default face must have been realized already. */
6270 realize_named_face (f
, symbol
, id
)
6275 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6276 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6277 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6278 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6279 struct face
*new_face
;
6281 /* The default face must exist and be fully specified. */
6282 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6283 check_lface_attrs (attrs
);
6284 xassert (lface_fully_specified_p (attrs
));
6286 /* If SYMBOL isn't know as a face, create it. */
6290 XSETFRAME (frame
, f
);
6291 lface
= Finternal_make_lisp_face (symbol
, frame
);
6294 /* Merge SYMBOL's face with the default face. */
6295 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6296 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6298 /* Realize the face. */
6299 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6303 /* Realize the fully-specified face with attributes ATTRS in face
6304 cache CACHE for character C. If C is a multibyte character,
6305 BASE_FACE is a face that has the same attributes. Otherwise,
6306 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6307 ID of face to remove before caching the new face. Value is a
6308 pointer to the newly created realized face. */
6310 static struct face
*
6311 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6312 struct face_cache
*cache
;
6315 struct face
*base_face
;
6320 /* LFACE must be fully specified. */
6321 xassert (cache
!= NULL
);
6322 check_lface_attrs (attrs
);
6324 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6326 /* Remove the former face. */
6327 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6328 uncache_face (cache
, former_face
);
6329 free_realized_face (cache
->f
, former_face
);
6332 if (FRAME_WINDOW_P (cache
->f
))
6333 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6334 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6335 face
= realize_tty_face (cache
, attrs
, c
);
6339 /* Insert the new face. */
6340 cache_face (cache
, face
, lface_hash (attrs
));
6341 #ifdef HAVE_WINDOW_SYSTEM
6342 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6343 load_face_font (cache
->f
, face
, c
);
6344 #endif /* HAVE_WINDOW_SYSTEM */
6349 /* Realize the fully-specified face with attributes ATTRS in face
6350 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6351 a multibyte character, BASE_FACE is a face that has the same
6352 attributes. Otherwise, BASE_FACE is ignored. If the new face
6353 doesn't share font with the default face, a fontname is allocated
6354 from the heap and set in `font_name' of the new face, but it is not
6355 yet loaded here. Value is a pointer to the newly created realized
6358 static struct face
*
6359 realize_x_face (cache
, attrs
, c
, base_face
)
6360 struct face_cache
*cache
;
6363 struct face
*base_face
;
6365 #ifdef HAVE_WINDOW_SYSTEM
6366 struct face
*face
, *default_face
;
6368 Lisp_Object stipple
, overline
, strike_through
, box
;
6370 xassert (FRAME_WINDOW_P (cache
->f
));
6371 xassert (SINGLE_BYTE_CHAR_P (c
)
6374 /* Allocate a new realized face. */
6375 face
= make_realized_face (attrs
);
6379 /* If C is a multibyte character, we share all face attirbutes with
6380 BASE_FACE including the realized fontset. But, we must load a
6382 if (!SINGLE_BYTE_CHAR_P (c
))
6384 bcopy (base_face
, face
, sizeof *face
);
6387 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6388 face
->colors_copied_bitwise_p
= 1;
6390 /* to force realize_face to load font */
6395 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6397 /* Determine the font to use. Most of the time, the font will be
6398 the same as the font of the default face, so try that first. */
6399 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6401 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6402 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6404 face
->font
= default_face
->font
;
6405 face
->fontset
= default_face
->fontset
;
6406 face
->font_info_id
= default_face
->font_info_id
;
6407 face
->font_name
= default_face
->font_name
;
6408 face
->ascii_face
= face
;
6410 /* But, as we can't share the fontset, make a new realized
6411 fontset that has the same base fontset as of the default
6414 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6418 /* If the face attribute ATTRS specifies a fontset, use it as
6419 the base of a new realized fontset. Otherwise, use the same
6420 base fontset as of the default face. The base determines
6421 registry and encoding of a font. It may also determine
6422 foundry and family. The other fields of font name pattern
6423 are constructed from ATTRS. */
6424 int fontset
= face_fontset (attrs
);
6426 if ((fontset
== -1) && default_face
)
6427 fontset
= default_face
->fontset
;
6428 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6429 face
->font
= NULL
; /* to force realize_face to load font */
6432 /* Load the font if it is specified in ATTRS. This fixes
6433 changing frame font on the Mac. */
6434 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6436 struct font_info
*font_info
=
6437 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6439 face
->font
= font_info
->font
;
6444 /* Load colors, and set remaining attributes. */
6446 load_face_colors (f
, face
, attrs
);
6449 box
= attrs
[LFACE_BOX_INDEX
];
6452 /* A simple box of line width 1 drawn in color given by
6454 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6456 face
->box
= FACE_SIMPLE_BOX
;
6457 face
->box_line_width
= 1;
6459 else if (INTEGERP (box
))
6461 /* Simple box of specified line width in foreground color of the
6463 xassert (XINT (box
) != 0);
6464 face
->box
= FACE_SIMPLE_BOX
;
6465 face
->box_line_width
= XINT (box
);
6466 face
->box_color
= face
->foreground
;
6467 face
->box_color_defaulted_p
= 1;
6469 else if (CONSP (box
))
6471 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6472 being one of `raised' or `sunken'. */
6473 face
->box
= FACE_SIMPLE_BOX
;
6474 face
->box_color
= face
->foreground
;
6475 face
->box_color_defaulted_p
= 1;
6476 face
->box_line_width
= 1;
6480 Lisp_Object keyword
, value
;
6482 keyword
= XCAR (box
);
6490 if (EQ (keyword
, QCline_width
))
6492 if (INTEGERP (value
) && XINT (value
) != 0)
6493 face
->box_line_width
= XINT (value
);
6495 else if (EQ (keyword
, QCcolor
))
6497 if (STRINGP (value
))
6499 face
->box_color
= load_color (f
, face
, value
,
6501 face
->use_box_color_for_shadows_p
= 1;
6504 else if (EQ (keyword
, QCstyle
))
6506 if (EQ (value
, Qreleased_button
))
6507 face
->box
= FACE_RAISED_BOX
;
6508 else if (EQ (value
, Qpressed_button
))
6509 face
->box
= FACE_SUNKEN_BOX
;
6514 /* Text underline, overline, strike-through. */
6516 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6518 /* Use default color (same as foreground color). */
6519 face
->underline_p
= 1;
6520 face
->underline_defaulted_p
= 1;
6521 face
->underline_color
= 0;
6523 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6525 /* Use specified color. */
6526 face
->underline_p
= 1;
6527 face
->underline_defaulted_p
= 0;
6528 face
->underline_color
6529 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6530 LFACE_UNDERLINE_INDEX
);
6532 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6534 face
->underline_p
= 0;
6535 face
->underline_defaulted_p
= 0;
6536 face
->underline_color
= 0;
6539 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6540 if (STRINGP (overline
))
6542 face
->overline_color
6543 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6544 LFACE_OVERLINE_INDEX
);
6545 face
->overline_p
= 1;
6547 else if (EQ (overline
, Qt
))
6549 face
->overline_color
= face
->foreground
;
6550 face
->overline_color_defaulted_p
= 1;
6551 face
->overline_p
= 1;
6554 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6555 if (STRINGP (strike_through
))
6557 face
->strike_through_color
6558 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6559 LFACE_STRIKE_THROUGH_INDEX
);
6560 face
->strike_through_p
= 1;
6562 else if (EQ (strike_through
, Qt
))
6564 face
->strike_through_color
= face
->foreground
;
6565 face
->strike_through_color_defaulted_p
= 1;
6566 face
->strike_through_p
= 1;
6569 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6570 if (!NILP (stipple
))
6571 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6573 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6575 #endif /* HAVE_WINDOW_SYSTEM */
6579 /* Map a specified color of face FACE on frame F to a tty color index.
6580 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6581 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6582 default foreground/background colors. */
6585 map_tty_color (f
, face
, idx
, defaulted
)
6588 enum lface_attribute_index idx
;
6591 Lisp_Object frame
, color
, def
;
6592 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6593 unsigned long default_pixel
, default_other_pixel
, pixel
;
6595 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6599 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6600 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6604 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6605 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6608 XSETFRAME (frame
, f
);
6609 color
= face
->lface
[idx
];
6612 && XSTRING (color
)->size
6613 && CONSP (Vtty_defined_color_alist
)
6614 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6617 /* Associations in tty-defined-color-alist are of the form
6618 (NAME INDEX R G B). We need the INDEX part. */
6619 pixel
= XINT (XCAR (XCDR (def
)));
6622 if (pixel
== default_pixel
&& STRINGP (color
))
6624 pixel
= load_color (f
, face
, color
, idx
);
6626 #if defined (MSDOS) || defined (WINDOWSNT)
6627 /* If the foreground of the default face is the default color,
6628 use the foreground color defined by the frame. */
6630 if (FRAME_MSDOS_P (f
))
6633 if (pixel
== default_pixel
6634 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6637 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6639 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6640 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6643 else if (pixel
== default_other_pixel
)
6646 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6648 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6649 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6655 #endif /* MSDOS or WINDOWSNT */
6659 face
->foreground
= pixel
;
6661 face
->background
= pixel
;
6665 /* Realize the fully-specified face with attributes ATTRS in face
6666 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6667 pointer to the newly created realized face. */
6669 static struct face
*
6670 realize_tty_face (cache
, attrs
, c
)
6671 struct face_cache
*cache
;
6677 int face_colors_defaulted
= 0;
6678 struct frame
*f
= cache
->f
;
6680 /* Frame must be a termcap frame. */
6681 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6683 /* Allocate a new realized face. */
6684 face
= make_realized_face (attrs
);
6685 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6687 /* Map face attributes to TTY appearances. We map slant to
6688 dimmed text because we want italic text to appear differently
6689 and because dimmed text is probably used infrequently. */
6690 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6691 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6693 if (weight
> XLFD_WEIGHT_MEDIUM
)
6694 face
->tty_bold_p
= 1;
6695 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6696 face
->tty_dim_p
= 1;
6697 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6698 face
->tty_underline_p
= 1;
6699 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6700 face
->tty_reverse_p
= 1;
6702 /* Map color names to color indices. */
6703 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6704 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6706 /* Swap colors if face is inverse-video. If the colors are taken
6707 from the frame colors, they are already inverted, since the
6708 frame-creation function calls x-handle-reverse-video. */
6709 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6711 unsigned long tem
= face
->foreground
;
6712 face
->foreground
= face
->background
;
6713 face
->background
= tem
;
6716 if (tty_suppress_bold_inverse_default_colors_p
6718 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6719 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6720 face
->tty_bold_p
= 0;
6726 DEFUN ("tty-suppress-bold-inverse-default-colors",
6727 Ftty_suppress_bold_inverse_default_colors
,
6728 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6729 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6730 SUPPRESS non-nil means suppress it.
6731 This affects bold faces on TTYs whose foreground is the default background
6732 color of the display and whose background is the default foreground color.
6733 For such faces, the bold face attribute is ignored if this variable
6736 Lisp_Object suppress
;
6738 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6739 ++face_change_count
;
6745 /***********************************************************************
6747 ***********************************************************************/
6749 /* Return the ID of the face to use to display character CH with face
6750 property PROP on frame F in current_buffer. */
6753 compute_char_face (f
, ch
, prop
)
6760 if (NILP (current_buffer
->enable_multibyte_characters
))
6765 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6766 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6770 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6771 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6772 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6773 merge_face_vector_with_property (f
, attrs
, prop
);
6774 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6780 /* Return the face ID associated with buffer position POS for
6781 displaying ASCII characters. Return in *ENDPTR the position at
6782 which a different face is needed, as far as text properties and
6783 overlays are concerned. W is a window displaying current_buffer.
6785 REGION_BEG, REGION_END delimit the region, so it can be
6788 LIMIT is a position not to scan beyond. That is to limit the time
6789 this function can take.
6791 If MOUSE is non-zero, use the character's mouse-face, not its face.
6793 The face returned is suitable for displaying ASCII characters. */
6796 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6797 endptr
, limit
, mouse
)
6800 int region_beg
, region_end
;
6805 struct frame
*f
= XFRAME (w
->frame
);
6806 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6807 Lisp_Object prop
, position
;
6809 Lisp_Object
*overlay_vec
;
6812 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6813 Lisp_Object limit1
, end
;
6814 struct face
*default_face
;
6816 /* W must display the current buffer. We could write this function
6817 to use the frame and buffer of W, but right now it doesn't. */
6818 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6820 XSETFRAME (frame
, f
);
6821 XSETFASTINT (position
, pos
);
6824 if (pos
< region_beg
&& region_beg
< endpos
)
6825 endpos
= region_beg
;
6827 /* Get the `face' or `mouse_face' text property at POS, and
6828 determine the next position at which the property changes. */
6829 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6830 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6831 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6833 endpos
= XINT (end
);
6835 /* Look at properties from overlays. */
6840 /* First try with room for 40 overlays. */
6842 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6843 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6844 &next_overlay
, NULL
, 0);
6846 /* If there are more than 40, make enough space for all, and try
6848 if (noverlays
> len
)
6851 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6852 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6853 &next_overlay
, NULL
, 0);
6856 if (next_overlay
< endpos
)
6857 endpos
= next_overlay
;
6862 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6864 /* Optimize common cases where we can use the default face. */
6867 && !(pos
>= region_beg
&& pos
< region_end
))
6868 return DEFAULT_FACE_ID
;
6870 /* Begin with attributes from the default face. */
6871 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6873 /* Merge in attributes specified via text properties. */
6875 merge_face_vector_with_property (f
, attrs
, prop
);
6877 /* Now merge the overlay data. */
6878 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6879 for (i
= 0; i
< noverlays
; i
++)
6884 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6886 merge_face_vector_with_property (f
, attrs
, prop
);
6888 oend
= OVERLAY_END (overlay_vec
[i
]);
6889 oendpos
= OVERLAY_POSITION (oend
);
6890 if (oendpos
< endpos
)
6894 /* If in the region, merge in the region face. */
6895 if (pos
>= region_beg
&& pos
< region_end
)
6897 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6898 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6900 if (region_end
< endpos
)
6901 endpos
= region_end
;
6906 /* Look up a realized face with the given face attributes,
6907 or realize a new one for ASCII characters. */
6908 return lookup_face (f
, attrs
, 0, NULL
);
6912 /* Compute the face at character position POS in Lisp string STRING on
6913 window W, for ASCII characters.
6915 If STRING is an overlay string, it comes from position BUFPOS in
6916 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6917 not an overlay string. W must display the current buffer.
6918 REGION_BEG and REGION_END give the start and end positions of the
6919 region; both are -1 if no region is visible.
6921 BASE_FACE_ID is the id of a face to merge with. For strings coming
6922 from overlays or the `display' property it is the face at BUFPOS.
6924 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6926 Set *ENDPTR to the next position where to check for faces in
6927 STRING; -1 if the face is constant from POS to the end of the
6930 Value is the id of the face to use. The face returned is suitable
6931 for displaying ASCII characters. */
6934 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6935 region_end
, endptr
, base_face_id
, mouse_p
)
6939 int region_beg
, region_end
;
6941 enum face_id base_face_id
;
6944 Lisp_Object prop
, position
, end
, limit
;
6945 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6946 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6947 struct face
*base_face
;
6948 int multibyte_p
= STRING_MULTIBYTE (string
);
6949 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6951 /* Get the value of the face property at the current position within
6952 STRING. Value is nil if there is no face property. */
6953 XSETFASTINT (position
, pos
);
6954 prop
= Fget_text_property (position
, prop_name
, string
);
6956 /* Get the next position at which to check for faces. Value of end
6957 is nil if face is constant all the way to the end of the string.
6958 Otherwise it is a string position where to check faces next.
6959 Limit is the maximum position up to which to check for property
6960 changes in Fnext_single_property_change. Strings are usually
6961 short, so set the limit to the end of the string. */
6962 XSETFASTINT (limit
, XSTRING (string
)->size
);
6963 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6965 *endptr
= XFASTINT (end
);
6969 base_face
= FACE_FROM_ID (f
, base_face_id
);
6970 xassert (base_face
);
6972 /* Optimize the default case that there is no face property and we
6973 are not in the region. */
6975 && (base_face_id
!= DEFAULT_FACE_ID
6976 /* BUFPOS <= 0 means STRING is not an overlay string, so
6977 that the region doesn't have to be taken into account. */
6979 || bufpos
< region_beg
6980 || bufpos
>= region_end
)
6982 /* We can't realize faces for different charsets differently
6983 if we don't have fonts, so we can stop here if not working
6984 on a window-system frame. */
6985 || !FRAME_WINDOW_P (f
)
6986 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6987 return base_face
->id
;
6989 /* Begin with attributes from the base face. */
6990 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6992 /* Merge in attributes specified via text properties. */
6994 merge_face_vector_with_property (f
, attrs
, prop
);
6996 /* If in the region, merge in the region face. */
6998 && bufpos
>= region_beg
6999 && bufpos
< region_end
)
7001 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7002 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7005 /* Look up a realized face with the given face attributes,
7006 or realize a new one for ASCII characters. */
7007 return lookup_face (f
, attrs
, 0, NULL
);
7012 /***********************************************************************
7014 ***********************************************************************/
7018 /* Print the contents of the realized face FACE to stderr. */
7021 dump_realized_face (face
)
7024 fprintf (stderr
, "ID: %d\n", face
->id
);
7025 #ifdef HAVE_X_WINDOWS
7026 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7028 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7030 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7031 fprintf (stderr
, "background: 0x%lx (%s)\n",
7033 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7034 fprintf (stderr
, "font_name: %s (%s)\n",
7036 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7037 #ifdef HAVE_X_WINDOWS
7038 fprintf (stderr
, "font = %p\n", face
->font
);
7040 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7041 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7042 fprintf (stderr
, "underline: %d (%s)\n",
7044 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7045 fprintf (stderr
, "hash: %d\n", face
->hash
);
7046 fprintf (stderr
, "charset: %d\n", face
->charset
);
7050 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7058 fprintf (stderr
, "font selection order: ");
7059 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7060 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7061 fprintf (stderr
, "\n");
7063 fprintf (stderr
, "alternative fonts: ");
7064 debug_print (Vface_alternative_font_family_alist
);
7065 fprintf (stderr
, "\n");
7067 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7068 Fdump_face (make_number (i
));
7074 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7076 error ("Not a valid face");
7077 dump_realized_face (face
);
7084 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7085 0, 0, 0, doc
: /* */)
7088 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7089 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7090 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7094 #endif /* GLYPH_DEBUG != 0 */
7098 /***********************************************************************
7100 ***********************************************************************/
7105 Qface
= intern ("face");
7107 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7108 staticpro (&Qbitmap_spec_p
);
7109 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7110 staticpro (&Qframe_update_face_colors
);
7112 /* Lisp face attribute keywords. */
7113 QCfamily
= intern (":family");
7114 staticpro (&QCfamily
);
7115 QCheight
= intern (":height");
7116 staticpro (&QCheight
);
7117 QCweight
= intern (":weight");
7118 staticpro (&QCweight
);
7119 QCslant
= intern (":slant");
7120 staticpro (&QCslant
);
7121 QCunderline
= intern (":underline");
7122 staticpro (&QCunderline
);
7123 QCinverse_video
= intern (":inverse-video");
7124 staticpro (&QCinverse_video
);
7125 QCreverse_video
= intern (":reverse-video");
7126 staticpro (&QCreverse_video
);
7127 QCforeground
= intern (":foreground");
7128 staticpro (&QCforeground
);
7129 QCbackground
= intern (":background");
7130 staticpro (&QCbackground
);
7131 QCstipple
= intern (":stipple");;
7132 staticpro (&QCstipple
);
7133 QCwidth
= intern (":width");
7134 staticpro (&QCwidth
);
7135 QCfont
= intern (":font");
7136 staticpro (&QCfont
);
7137 QCbold
= intern (":bold");
7138 staticpro (&QCbold
);
7139 QCitalic
= intern (":italic");
7140 staticpro (&QCitalic
);
7141 QCoverline
= intern (":overline");
7142 staticpro (&QCoverline
);
7143 QCstrike_through
= intern (":strike-through");
7144 staticpro (&QCstrike_through
);
7145 QCbox
= intern (":box");
7147 QCinherit
= intern (":inherit");
7148 staticpro (&QCinherit
);
7150 /* Symbols used for Lisp face attribute values. */
7151 QCcolor
= intern (":color");
7152 staticpro (&QCcolor
);
7153 QCline_width
= intern (":line-width");
7154 staticpro (&QCline_width
);
7155 QCstyle
= intern (":style");
7156 staticpro (&QCstyle
);
7157 Qreleased_button
= intern ("released-button");
7158 staticpro (&Qreleased_button
);
7159 Qpressed_button
= intern ("pressed-button");
7160 staticpro (&Qpressed_button
);
7161 Qnormal
= intern ("normal");
7162 staticpro (&Qnormal
);
7163 Qultra_light
= intern ("ultra-light");
7164 staticpro (&Qultra_light
);
7165 Qextra_light
= intern ("extra-light");
7166 staticpro (&Qextra_light
);
7167 Qlight
= intern ("light");
7168 staticpro (&Qlight
);
7169 Qsemi_light
= intern ("semi-light");
7170 staticpro (&Qsemi_light
);
7171 Qsemi_bold
= intern ("semi-bold");
7172 staticpro (&Qsemi_bold
);
7173 Qbold
= intern ("bold");
7175 Qextra_bold
= intern ("extra-bold");
7176 staticpro (&Qextra_bold
);
7177 Qultra_bold
= intern ("ultra-bold");
7178 staticpro (&Qultra_bold
);
7179 Qoblique
= intern ("oblique");
7180 staticpro (&Qoblique
);
7181 Qitalic
= intern ("italic");
7182 staticpro (&Qitalic
);
7183 Qreverse_oblique
= intern ("reverse-oblique");
7184 staticpro (&Qreverse_oblique
);
7185 Qreverse_italic
= intern ("reverse-italic");
7186 staticpro (&Qreverse_italic
);
7187 Qultra_condensed
= intern ("ultra-condensed");
7188 staticpro (&Qultra_condensed
);
7189 Qextra_condensed
= intern ("extra-condensed");
7190 staticpro (&Qextra_condensed
);
7191 Qcondensed
= intern ("condensed");
7192 staticpro (&Qcondensed
);
7193 Qsemi_condensed
= intern ("semi-condensed");
7194 staticpro (&Qsemi_condensed
);
7195 Qsemi_expanded
= intern ("semi-expanded");
7196 staticpro (&Qsemi_expanded
);
7197 Qexpanded
= intern ("expanded");
7198 staticpro (&Qexpanded
);
7199 Qextra_expanded
= intern ("extra-expanded");
7200 staticpro (&Qextra_expanded
);
7201 Qultra_expanded
= intern ("ultra-expanded");
7202 staticpro (&Qultra_expanded
);
7203 Qbackground_color
= intern ("background-color");
7204 staticpro (&Qbackground_color
);
7205 Qforeground_color
= intern ("foreground-color");
7206 staticpro (&Qforeground_color
);
7207 Qunspecified
= intern ("unspecified");
7208 staticpro (&Qunspecified
);
7210 Qface_alias
= intern ("face-alias");
7211 staticpro (&Qface_alias
);
7212 Qdefault
= intern ("default");
7213 staticpro (&Qdefault
);
7214 Qtool_bar
= intern ("tool-bar");
7215 staticpro (&Qtool_bar
);
7216 Qregion
= intern ("region");
7217 staticpro (&Qregion
);
7218 Qfringe
= intern ("fringe");
7219 staticpro (&Qfringe
);
7220 Qheader_line
= intern ("header-line");
7221 staticpro (&Qheader_line
);
7222 Qscroll_bar
= intern ("scroll-bar");
7223 staticpro (&Qscroll_bar
);
7224 Qmenu
= intern ("menu");
7226 Qcursor
= intern ("cursor");
7227 staticpro (&Qcursor
);
7228 Qborder
= intern ("border");
7229 staticpro (&Qborder
);
7230 Qmouse
= intern ("mouse");
7231 staticpro (&Qmouse
);
7232 Qmode_line_inactive
= intern ("mode-line-inactive");
7233 staticpro (&Qmode_line_inactive
);
7234 Qtty_color_desc
= intern ("tty-color-desc");
7235 staticpro (&Qtty_color_desc
);
7236 Qtty_color_by_index
= intern ("tty-color-by-index");
7237 staticpro (&Qtty_color_by_index
);
7238 Qtty_color_alist
= intern ("tty-color-alist");
7239 staticpro (&Qtty_color_alist
);
7240 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7241 staticpro (&Qscalable_fonts_allowed
);
7243 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7244 staticpro (&Vparam_value_alist
);
7245 Vface_alternative_font_family_alist
= Qnil
;
7246 staticpro (&Vface_alternative_font_family_alist
);
7247 Vface_alternative_font_registry_alist
= Qnil
;
7248 staticpro (&Vface_alternative_font_registry_alist
);
7250 defsubr (&Sinternal_make_lisp_face
);
7251 defsubr (&Sinternal_lisp_face_p
);
7252 defsubr (&Sinternal_set_lisp_face_attribute
);
7253 #ifdef HAVE_WINDOW_SYSTEM
7254 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7256 defsubr (&Scolor_gray_p
);
7257 defsubr (&Scolor_supported_p
);
7258 defsubr (&Sface_attribute_relative_p
);
7259 defsubr (&Smerge_face_attribute
);
7260 defsubr (&Sinternal_get_lisp_face_attribute
);
7261 defsubr (&Sinternal_lisp_face_attribute_values
);
7262 defsubr (&Sinternal_lisp_face_equal_p
);
7263 defsubr (&Sinternal_lisp_face_empty_p
);
7264 defsubr (&Sinternal_copy_lisp_face
);
7265 defsubr (&Sinternal_merge_in_global_face
);
7266 defsubr (&Sface_font
);
7267 defsubr (&Sframe_face_alist
);
7268 defsubr (&Sinternal_set_font_selection_order
);
7269 defsubr (&Sinternal_set_alternative_font_family_alist
);
7270 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7271 defsubr (&Sface_attributes_as_vector
);
7273 defsubr (&Sdump_face
);
7274 defsubr (&Sshow_face_resources
);
7275 #endif /* GLYPH_DEBUG */
7276 defsubr (&Sclear_face_cache
);
7277 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7279 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7280 defsubr (&Sdump_colors
);
7283 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7284 doc
: /* *Limit for font matching.
7285 If an integer > 0, font matching functions won't load more than
7286 that number of fonts when searching for a matching font. */);
7287 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7289 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7290 doc
: /* List of global face definitions (for internal use only.) */);
7291 Vface_new_frame_defaults
= Qnil
;
7293 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7294 doc
: /* *Default stipple pattern used on monochrome displays.
7295 This stipple pattern is used on monochrome displays
7296 instead of shades of gray for a face background color.
7297 See `set-face-stipple' for possible values for this variable. */);
7298 Vface_default_stipple
= build_string ("gray3");
7300 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7301 doc
: /* An alist of defined terminal colors and their RGB values. */);
7302 Vtty_defined_color_alist
= Qnil
;
7304 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7305 doc
: /* Allowed scalable fonts.
7306 A value of nil means don't allow any scalable fonts.
7307 A value of t means allow any scalable font.
7308 Otherwise, value must be a list of regular expressions. A font may be
7309 scaled if its name matches a regular expression in the list.
7310 Note that if value is nil, a scalable font might still be used, if no
7311 other font of the appropriate family and registry is available. */);
7312 Vscalable_fonts_allowed
= Qnil
;
7314 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7315 doc
: /* List of ignored fonts.
7316 Each element is a regular expression that matches names of fonts to
7318 Vface_ignored_fonts
= Qnil
;
7320 #ifdef HAVE_WINDOW_SYSTEM
7321 defsubr (&Sbitmap_spec_p
);
7322 defsubr (&Sx_list_fonts
);
7323 defsubr (&Sinternal_face_x_get_resource
);
7324 defsubr (&Sx_family_fonts
);
7325 defsubr (&Sx_font_family_list
);
7326 #endif /* HAVE_WINDOW_SYSTEM */