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 on this display. */
1058 FOR_EACH_FRAME (tail
, frame
)
1060 struct frame
*f
= XFRAME (frame
);
1061 if (FRAME_WINDOW_P (f
)
1062 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1063 && font_info
->font
== FRAME_FONT (f
))
1071 if (font_info
->full_name
!= font_info
->name
)
1072 xfree (font_info
->full_name
);
1073 xfree (font_info
->name
);
1075 /* Free the font. */
1077 #ifdef HAVE_X_WINDOWS
1078 XFreeFont (dpyinfo
->display
, font_info
->font
);
1081 w32_unload_font (dpyinfo
, font_info
->font
);
1085 /* Mark font table slot free. */
1086 font_info
->font
= NULL
;
1087 font_info
->name
= font_info
->full_name
= NULL
;
1091 #endif /* HAVE_WINDOW_SYSTEM */
1095 /***********************************************************************
1097 ***********************************************************************/
1099 #ifdef HAVE_WINDOW_SYSTEM
1101 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1102 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1103 A bitmap specification is either a string, a file name, or a list
1104 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1105 HEIGHT is its height, and DATA is a string containing the bits of
1106 the pixmap. Bits are stored row by row, each row occupies
1107 \(WIDTH + 7)/8 bytes. */)
1113 if (STRINGP (object
))
1114 /* If OBJECT is a string, it's a file name. */
1116 else if (CONSP (object
))
1118 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1119 HEIGHT must be integers > 0, and DATA must be string large
1120 enough to hold a bitmap of the specified size. */
1121 Lisp_Object width
, height
, data
;
1123 height
= width
= data
= Qnil
;
1127 width
= XCAR (object
);
1128 object
= XCDR (object
);
1131 height
= XCAR (object
);
1132 object
= XCDR (object
);
1134 data
= XCAR (object
);
1138 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1140 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1142 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1147 return pixmap_p
? Qt
: Qnil
;
1151 /* Load a bitmap according to NAME (which is either a file name or a
1152 pixmap spec) for use on frame F. Value is the bitmap_id (see
1153 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1154 bitmap cannot be loaded, display a message saying so, and return
1155 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1156 if these pointers are not null. */
1159 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1162 unsigned int *w_ptr
, *h_ptr
;
1170 tem
= Fbitmap_spec_p (name
);
1172 wrong_type_argument (Qbitmap_spec_p
, name
);
1177 /* Decode a bitmap spec into a bitmap. */
1182 w
= XINT (Fcar (name
));
1183 h
= XINT (Fcar (Fcdr (name
)));
1184 bits
= Fcar (Fcdr (Fcdr (name
)));
1186 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1191 /* It must be a string -- a file name. */
1192 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1198 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1209 ++npixmaps_allocated
;
1212 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1215 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1221 #endif /* HAVE_WINDOW_SYSTEM */
1225 /***********************************************************************
1227 ***********************************************************************/
1229 #ifdef HAVE_WINDOW_SYSTEM
1231 /* Update the line_height of frame F. Return non-zero if line height
1235 frame_update_line_height (f
)
1238 int line_height
, changed_p
;
1240 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1241 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1242 FRAME_LINE_HEIGHT (f
) = line_height
;
1246 #endif /* HAVE_WINDOW_SYSTEM */
1249 /***********************************************************************
1251 ***********************************************************************/
1253 #ifdef HAVE_WINDOW_SYSTEM
1255 /* Load font of face FACE which is used on frame F to display
1256 character C. The name of the font to load is determined by lface
1257 and fontset of FACE. */
1260 load_face_font (f
, face
, c
)
1265 struct font_info
*font_info
= NULL
;
1268 face
->font_info_id
= -1;
1271 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1276 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1281 face
->font_info_id
= font_info
->font_idx
;
1282 face
->font
= font_info
->font
;
1283 face
->font_name
= font_info
->full_name
;
1286 x_free_gc (f
, face
->gc
);
1291 add_to_log ("Unable to load font %s",
1292 build_string (font_name
), Qnil
);
1296 #endif /* HAVE_WINDOW_SYSTEM */
1300 /***********************************************************************
1302 ***********************************************************************/
1304 /* A version of defined_color for non-X frames. */
1307 tty_defined_color (f
, color_name
, color_def
, alloc
)
1313 Lisp_Object color_desc
;
1314 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1315 unsigned long red
= 0, green
= 0, blue
= 0;
1318 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1322 XSETFRAME (frame
, f
);
1324 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1325 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1327 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1328 if (CONSP (XCDR (XCDR (color_desc
))))
1330 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1331 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1332 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1336 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1337 /* We were called early during startup, and the colors are not
1338 yet set up in tty-defined-color-alist. Don't return a failure
1339 indication, since this produces the annoying "Unable to
1340 load color" messages in the *Messages* buffer. */
1343 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1345 if (strcmp (color_name
, "unspecified-fg") == 0)
1346 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1347 else if (strcmp (color_name
, "unspecified-bg") == 0)
1348 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1351 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1354 color_def
->pixel
= color_idx
;
1355 color_def
->red
= red
;
1356 color_def
->green
= green
;
1357 color_def
->blue
= blue
;
1363 /* Decide if color named COLOR_NAME is valid for the display
1364 associated with the frame F; if so, return the rgb values in
1365 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1367 This does the right thing for any type of frame. */
1370 defined_color (f
, color_name
, color_def
, alloc
)
1376 if (!FRAME_WINDOW_P (f
))
1377 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1378 #ifdef HAVE_X_WINDOWS
1379 else if (FRAME_X_P (f
))
1380 return x_defined_color (f
, color_name
, color_def
, alloc
);
1383 else if (FRAME_W32_P (f
))
1384 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1387 else if (FRAME_MAC_P (f
))
1388 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1395 /* Given the index IDX of a tty color on frame F, return its name, a
1399 tty_color_name (f
, idx
)
1403 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1406 Lisp_Object coldesc
;
1408 XSETFRAME (frame
, f
);
1409 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1411 if (!NILP (coldesc
))
1412 return XCAR (coldesc
);
1415 /* We can have an MSDOG frame under -nw for a short window of
1416 opportunity before internal_terminal_init is called. DTRT. */
1417 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1418 return msdos_stdcolor_name (idx
);
1421 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1422 return build_string (unspecified_fg
);
1423 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1424 return build_string (unspecified_bg
);
1427 return vga_stdcolor_name (idx
);
1430 return Qunspecified
;
1434 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1435 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1438 face_color_gray_p (f
, color_name
)
1445 if (defined_color (f
, color_name
, &color
, 0))
1446 gray_p
= ((abs (color
.red
- color
.green
)
1447 < max (color
.red
, color
.green
) / 20)
1448 && (abs (color
.green
- color
.blue
)
1449 < max (color
.green
, color
.blue
) / 20)
1450 && (abs (color
.blue
- color
.red
)
1451 < max (color
.blue
, color
.red
) / 20));
1459 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1460 BACKGROUND_P non-zero means the color will be used as background
1464 face_color_supported_p (f
, color_name
, background_p
)
1472 XSETFRAME (frame
, f
);
1473 return (FRAME_WINDOW_P (f
)
1474 ? (!NILP (Fxw_display_color_p (frame
))
1475 || xstricmp (color_name
, "black") == 0
1476 || xstricmp (color_name
, "white") == 0
1478 && face_color_gray_p (f
, color_name
))
1479 || (!NILP (Fx_display_grayscale_p (frame
))
1480 && face_color_gray_p (f
, color_name
)))
1481 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1485 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1486 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1487 FRAME specifies the frame and thus the display for interpreting COLOR.
1488 If FRAME is nil or omitted, use the selected frame. */)
1490 Lisp_Object color
, frame
;
1494 CHECK_FRAME (frame
);
1495 CHECK_STRING (color
);
1497 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1501 DEFUN ("color-supported-p", Fcolor_supported_p
,
1502 Scolor_supported_p
, 2, 3, 0,
1503 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1504 BACKGROUND-P non-nil means COLOR is used as a background.
1505 If FRAME is nil or omitted, use the selected frame.
1506 COLOR must be a valid color name. */)
1507 (color
, frame
, background_p
)
1508 Lisp_Object frame
, color
, background_p
;
1512 CHECK_FRAME (frame
);
1513 CHECK_STRING (color
);
1515 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1521 /* Load color with name NAME for use by face FACE on frame F.
1522 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1523 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1524 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1525 pixel color. If color cannot be loaded, display a message, and
1526 return the foreground, background or underline color of F, but
1527 record that fact in flags of the face so that we don't try to free
1531 load_color (f
, face
, name
, target_index
)
1535 enum lface_attribute_index target_index
;
1539 xassert (STRINGP (name
));
1540 xassert (target_index
== LFACE_FOREGROUND_INDEX
1541 || target_index
== LFACE_BACKGROUND_INDEX
1542 || target_index
== LFACE_UNDERLINE_INDEX
1543 || target_index
== LFACE_OVERLINE_INDEX
1544 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1545 || target_index
== LFACE_BOX_INDEX
);
1547 /* if the color map is full, defined_color will return a best match
1548 to the values in an existing cell. */
1549 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1551 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1553 switch (target_index
)
1555 case LFACE_FOREGROUND_INDEX
:
1556 face
->foreground_defaulted_p
= 1;
1557 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1560 case LFACE_BACKGROUND_INDEX
:
1561 face
->background_defaulted_p
= 1;
1562 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1565 case LFACE_UNDERLINE_INDEX
:
1566 face
->underline_defaulted_p
= 1;
1567 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1570 case LFACE_OVERLINE_INDEX
:
1571 face
->overline_color_defaulted_p
= 1;
1572 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1575 case LFACE_STRIKE_THROUGH_INDEX
:
1576 face
->strike_through_color_defaulted_p
= 1;
1577 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1580 case LFACE_BOX_INDEX
:
1581 face
->box_color_defaulted_p
= 1;
1582 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1591 ++ncolors_allocated
;
1598 #ifdef HAVE_WINDOW_SYSTEM
1600 /* Load colors for face FACE which is used on frame F. Colors are
1601 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1602 of ATTRS. If the background color specified is not supported on F,
1603 try to emulate gray colors with a stipple from Vface_default_stipple. */
1606 load_face_colors (f
, face
, attrs
)
1613 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1614 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1616 /* Swap colors if face is inverse-video. */
1617 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1625 /* Check for support for foreground, not for background because
1626 face_color_supported_p is smart enough to know that grays are
1627 "supported" as background because we are supposed to use stipple
1629 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1630 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1632 x_destroy_bitmap (f
, face
->stipple
);
1633 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1634 &face
->pixmap_w
, &face
->pixmap_h
);
1637 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1638 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1642 /* Free color PIXEL on frame F. */
1645 unload_color (f
, pixel
)
1647 unsigned long pixel
;
1649 #ifdef HAVE_X_WINDOWS
1653 x_free_colors (f
, &pixel
, 1);
1660 /* Free colors allocated for FACE. */
1663 free_face_colors (f
, face
)
1667 #ifdef HAVE_X_WINDOWS
1668 if (face
->colors_copied_bitwise_p
)
1673 if (!face
->foreground_defaulted_p
)
1675 x_free_colors (f
, &face
->foreground
, 1);
1676 IF_DEBUG (--ncolors_allocated
);
1679 if (!face
->background_defaulted_p
)
1681 x_free_colors (f
, &face
->background
, 1);
1682 IF_DEBUG (--ncolors_allocated
);
1685 if (face
->underline_p
1686 && !face
->underline_defaulted_p
)
1688 x_free_colors (f
, &face
->underline_color
, 1);
1689 IF_DEBUG (--ncolors_allocated
);
1692 if (face
->overline_p
1693 && !face
->overline_color_defaulted_p
)
1695 x_free_colors (f
, &face
->overline_color
, 1);
1696 IF_DEBUG (--ncolors_allocated
);
1699 if (face
->strike_through_p
1700 && !face
->strike_through_color_defaulted_p
)
1702 x_free_colors (f
, &face
->strike_through_color
, 1);
1703 IF_DEBUG (--ncolors_allocated
);
1706 if (face
->box
!= FACE_NO_BOX
1707 && !face
->box_color_defaulted_p
)
1709 x_free_colors (f
, &face
->box_color
, 1);
1710 IF_DEBUG (--ncolors_allocated
);
1714 #endif /* HAVE_X_WINDOWS */
1717 #endif /* HAVE_WINDOW_SYSTEM */
1721 /***********************************************************************
1723 ***********************************************************************/
1725 /* An enumerator for each field of an XLFD font name. */
1746 /* An enumerator for each possible slant value of a font. Taken from
1747 the XLFD specification. */
1755 XLFD_SLANT_REVERSE_ITALIC
,
1756 XLFD_SLANT_REVERSE_OBLIQUE
,
1760 /* Relative font weight according to XLFD documentation. */
1764 XLFD_WEIGHT_UNKNOWN
,
1765 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1766 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1767 XLFD_WEIGHT_LIGHT
, /* 30 */
1768 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1769 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1770 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1771 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1772 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1773 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1776 /* Relative proportionate width. */
1780 XLFD_SWIDTH_UNKNOWN
,
1781 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1782 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1783 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1784 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1785 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1786 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1787 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1788 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1789 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1792 /* Structure used for tables mapping XLFD weight, slant, and width
1793 names to numeric and symbolic values. */
1799 Lisp_Object
*symbol
;
1802 /* Table of XLFD slant names and their numeric and symbolic
1803 representations. This table must be sorted by slant names in
1806 static struct table_entry slant_table
[] =
1808 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1809 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1810 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1811 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1812 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1813 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1816 /* Table of XLFD weight names. This table must be sorted by weight
1817 names in ascending order. */
1819 static struct table_entry weight_table
[] =
1821 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1822 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1823 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1824 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1825 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1826 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1827 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1828 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1829 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1830 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1831 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1832 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1833 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1834 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1835 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1836 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1839 /* Table of XLFD width names. This table must be sorted by width
1840 names in ascending order. */
1842 static struct table_entry swidth_table
[] =
1844 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1845 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1846 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1847 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1848 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1849 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1850 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1851 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1852 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1853 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1854 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1855 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1856 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1857 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1858 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1861 /* Structure used to hold the result of splitting font names in XLFD
1862 format into their fields. */
1866 /* The original name which is modified destructively by
1867 split_font_name. The pointer is kept here to be able to free it
1868 if it was allocated from the heap. */
1871 /* Font name fields. Each vector element points into `name' above.
1872 Fields are NUL-terminated. */
1873 char *fields
[XLFD_LAST
];
1875 /* Numeric values for those fields that interest us. See
1876 split_font_name for which these are. */
1877 int numeric
[XLFD_LAST
];
1879 /* Lower value mean higher priority. */
1880 int registry_priority
;
1883 /* The frame in effect when sorting font names. Set temporarily in
1884 sort_fonts so that it is available in font comparison functions. */
1886 static struct frame
*font_frame
;
1888 /* Order by which font selection chooses fonts. The default values
1889 mean `first, find a best match for the font width, then for the
1890 font height, then for weight, then for slant.' This variable can be
1891 set via set-face-font-sort-order. */
1894 static int font_sort_order
[4] = {
1895 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1898 static int font_sort_order
[4];
1901 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1902 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1903 is a pointer to the matching table entry or null if no table entry
1906 static struct table_entry
*
1907 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1908 struct table_entry
*table
;
1910 struct font_name
*font
;
1913 /* Function split_font_name converts fields to lower-case, so there
1914 is no need to use xstrlwr or xstricmp here. */
1915 char *s
= font
->fields
[field_index
];
1916 int low
, mid
, high
, cmp
;
1923 mid
= (low
+ high
) / 2;
1924 cmp
= strcmp (table
[mid
].name
, s
);
1938 /* Return a numeric representation for font name field
1939 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1940 has DIM entries. Value is the numeric value found or DFLT if no
1941 table entry matches. This function is used to translate weight,
1942 slant, and swidth names of XLFD font names to numeric values. */
1945 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1946 struct table_entry
*table
;
1948 struct font_name
*font
;
1952 struct table_entry
*p
;
1953 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1954 return p
? p
->numeric
: dflt
;
1958 /* Return a symbolic representation for font name field
1959 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1960 has DIM entries. Value is the symbolic value found or DFLT if no
1961 table entry matches. This function is used to translate weight,
1962 slant, and swidth names of XLFD font names to symbols. */
1964 static INLINE Lisp_Object
1965 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1966 struct table_entry
*table
;
1968 struct font_name
*font
;
1972 struct table_entry
*p
;
1973 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1974 return p
? *p
->symbol
: dflt
;
1978 /* Return a numeric value for the slant of the font given by FONT. */
1981 xlfd_numeric_slant (font
)
1982 struct font_name
*font
;
1984 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1985 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1989 /* Return a symbol representing the weight of the font given by FONT. */
1991 static INLINE Lisp_Object
1992 xlfd_symbolic_slant (font
)
1993 struct font_name
*font
;
1995 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1996 font
, XLFD_SLANT
, Qnormal
);
2000 /* Return a numeric value for the weight of the font given by FONT. */
2003 xlfd_numeric_weight (font
)
2004 struct font_name
*font
;
2006 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2007 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2011 /* Return a symbol representing the slant of the font given by FONT. */
2013 static INLINE Lisp_Object
2014 xlfd_symbolic_weight (font
)
2015 struct font_name
*font
;
2017 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2018 font
, XLFD_WEIGHT
, Qnormal
);
2022 /* Return a numeric value for the swidth of the font whose XLFD font
2023 name fields are found in FONT. */
2026 xlfd_numeric_swidth (font
)
2027 struct font_name
*font
;
2029 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2030 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2034 /* Return a symbolic value for the swidth of FONT. */
2036 static INLINE Lisp_Object
2037 xlfd_symbolic_swidth (font
)
2038 struct font_name
*font
;
2040 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2041 font
, XLFD_SWIDTH
, Qnormal
);
2045 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2046 entries. Value is a pointer to the matching table entry or null if
2047 no element of TABLE contains SYMBOL. */
2049 static struct table_entry
*
2050 face_value (table
, dim
, symbol
)
2051 struct table_entry
*table
;
2057 xassert (SYMBOLP (symbol
));
2059 for (i
= 0; i
< dim
; ++i
)
2060 if (EQ (*table
[i
].symbol
, symbol
))
2063 return i
< dim
? table
+ i
: NULL
;
2067 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2068 entries. Value is -1 if SYMBOL is not found in TABLE. */
2071 face_numeric_value (table
, dim
, symbol
)
2072 struct table_entry
*table
;
2076 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2077 return p
? p
->numeric
: -1;
2081 /* Return a numeric value representing the weight specified by Lisp
2082 symbol WEIGHT. Value is one of the enumerators of enum
2086 face_numeric_weight (weight
)
2089 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2093 /* Return a numeric value representing the slant specified by Lisp
2094 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2097 face_numeric_slant (slant
)
2100 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2104 /* Return a numeric value representing the swidth specified by Lisp
2105 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2108 face_numeric_swidth (width
)
2111 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2115 #ifdef HAVE_WINDOW_SYSTEM
2117 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2121 struct font_name
*font
;
2123 /* Function split_font_name converts fields to lower-case, so there
2124 is no need to use tolower here. */
2125 return *font
->fields
[XLFD_SPACING
] != 'p';
2129 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2131 The actual height of the font when displayed on F depends on the
2132 resolution of both the font and frame. For example, a 10pt font
2133 designed for a 100dpi display will display larger than 10pt on a
2134 75dpi display. (It's not unusual to use fonts not designed for the
2135 display one is using. For example, some intlfonts are available in
2136 72dpi versions, only.)
2138 Value is the real point size of FONT on frame F, or 0 if it cannot
2142 xlfd_point_size (f
, font
)
2144 struct font_name
*font
;
2146 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2147 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2151 if (*pixel_field
== '[')
2153 /* The pixel size field is `[A B C D]' which specifies
2154 a transformation matrix.
2160 by which all glyphs of the font are transformed. The spec
2161 says that s scalar value N for the pixel size is equivalent
2162 to A = N * resx/resy, B = C = 0, D = N. */
2163 char *start
= pixel_field
+ 1, *end
;
2167 for (i
= 0; i
< 4; ++i
)
2169 matrix
[i
] = strtod (start
, &end
);
2176 pixel
= atoi (pixel_field
);
2181 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2187 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2188 of frame F. This function is used to guess a point size of font
2189 when only the pixel height of the font is available. */
2192 pixel_point_size (f
, pixel
)
2196 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2200 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2201 point size of one dot. */
2202 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2203 int_pt
= real_pt
+ 0.5;
2209 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2210 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2211 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2212 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2213 zero if the font name doesn't have the format we expect. The
2214 expected format is a font name that starts with a `-' and has
2215 XLFD_LAST fields separated by `-'. */
2218 split_font_name (f
, font
, numeric_p
)
2220 struct font_name
*font
;
2226 if (*font
->name
== '-')
2228 char *p
= xstrlwr (font
->name
) + 1;
2230 while (i
< XLFD_LAST
)
2232 font
->fields
[i
] = p
;
2235 /* Pixel and point size may be of the form `[....]'. For
2236 BNF, see XLFD spec, chapter 4. Negative values are
2237 indicated by tilde characters which we replace with
2238 `-' characters, here. */
2240 && (i
- 1 == XLFD_PIXEL_SIZE
2241 || i
- 1 == XLFD_POINT_SIZE
))
2246 for (++p
; *p
&& *p
!= ']'; ++p
)
2250 /* Check that the matrix contains 4 floating point
2252 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2255 if (strtod (start
, &end
) == 0 && start
== end
)
2262 while (*p
&& *p
!= '-')
2272 success_p
= i
== XLFD_LAST
;
2274 /* If requested, and font name was in the expected format,
2275 compute numeric values for some fields. */
2276 if (numeric_p
&& success_p
)
2278 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2279 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2280 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2281 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2282 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2283 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2286 /* Initialize it to zero. It will be overridden by font_list while
2287 trying alternate registries. */
2288 font
->registry_priority
= 0;
2294 /* Build an XLFD font name from font name fields in FONT. Value is a
2295 pointer to the font name, which is allocated via xmalloc. */
2298 build_font_name (font
)
2299 struct font_name
*font
;
2303 char *font_name
= (char *) xmalloc (size
);
2304 int total_length
= 0;
2306 for (i
= 0; i
< XLFD_LAST
; ++i
)
2308 /* Add 1 because of the leading `-'. */
2309 int len
= strlen (font
->fields
[i
]) + 1;
2311 /* Reallocate font_name if necessary. Add 1 for the final
2313 if (total_length
+ len
+ 1 >= size
)
2315 int new_size
= max (2 * size
, size
+ len
+ 1);
2316 int sz
= new_size
* sizeof *font_name
;
2317 font_name
= (char *) xrealloc (font_name
, sz
);
2321 font_name
[total_length
] = '-';
2322 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2323 total_length
+= len
;
2326 font_name
[total_length
] = 0;
2331 /* Free an array FONTS of N font_name structures. This frees FONTS
2332 itself and all `name' fields in its elements. */
2335 free_font_names (fonts
, n
)
2336 struct font_name
*fonts
;
2340 xfree (fonts
[--n
].name
);
2345 /* Sort vector FONTS of font_name structures which contains NFONTS
2346 elements using qsort and comparison function CMPFN. F is the frame
2347 on which the fonts will be used. The global variable font_frame
2348 is temporarily set to F to make it available in CMPFN. */
2351 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2353 struct font_name
*fonts
;
2355 int (*cmpfn
) P_ ((const void *, const void *));
2358 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2363 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2364 display in x_display_list. FONTS is a pointer to a vector of
2365 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2366 alternative patterns from Valternate_fontname_alist if no fonts are
2367 found matching PATTERN.
2369 For all fonts found, set FONTS[i].name to the name of the font,
2370 allocated via xmalloc, and split font names into fields. Ignore
2371 fonts that we can't parse. Value is the number of fonts found. */
2374 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2377 struct font_name
*fonts
;
2378 int nfonts
, try_alternatives_p
;
2382 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2383 better to do it the other way around. */
2385 Lisp_Object lpattern
, tem
;
2387 lpattern
= build_string (pattern
);
2389 /* Get the list of fonts matching PATTERN. */
2392 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2395 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2398 /* Make a copy of the font names we got from X, and
2399 split them into fields. */
2401 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2403 Lisp_Object elt
, tail
;
2404 char *name
= XSTRING (XCAR (tem
))->data
;
2406 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2407 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2411 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2420 /* Make a copy of the font name. */
2421 fonts
[n
].name
= xstrdup (name
);
2423 if (split_font_name (f
, fonts
+ n
, 1))
2425 if (font_scalable_p (fonts
+ n
)
2426 && !may_use_scalable_font_p (name
))
2429 xfree (fonts
[n
].name
);
2435 xfree (fonts
[n
].name
);
2438 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2439 if (n
== 0 && try_alternatives_p
)
2441 Lisp_Object list
= Valternate_fontname_alist
;
2443 while (CONSP (list
))
2445 Lisp_Object entry
= XCAR (list
);
2447 && STRINGP (XCAR (entry
))
2448 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2455 Lisp_Object patterns
= XCAR (list
);
2458 while (CONSP (patterns
)
2459 /* If list is screwed up, give up. */
2460 && (name
= XCAR (patterns
),
2462 /* Ignore patterns equal to PATTERN because we tried that
2463 already with no success. */
2464 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2465 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2468 patterns
= XCDR (patterns
);
2476 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2477 using comparison function CMPFN. Value is the number of fonts
2478 found. If value is non-zero, *FONTS is set to a vector of
2479 font_name structures allocated from the heap containing matching
2480 fonts. Each element of *FONTS contains a name member that is also
2481 allocated from the heap. Font names in these structures are split
2482 into fields. Use free_font_names to free such an array. */
2485 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2488 int (*cmpfn
) P_ ((const void *, const void *));
2489 struct font_name
**fonts
;
2493 /* Get the list of fonts matching pattern. 100 should suffice. */
2494 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2495 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2496 nfonts
= XFASTINT (Vfont_list_limit
);
2498 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2499 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2501 /* Sort the resulting array and return it in *FONTS. If no
2502 fonts were found, make sure to set *FONTS to null. */
2504 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2515 /* Compare two font_name structures *A and *B. Value is analogous to
2516 strcmp. Sort order is given by the global variable
2517 font_sort_order. Font names are sorted so that, everything else
2518 being equal, fonts with a resolution closer to that of the frame on
2519 which they are used are listed first. The global variable
2520 font_frame is the frame on which we operate. */
2523 cmp_font_names (a
, b
)
2526 struct font_name
*x
= (struct font_name
*) a
;
2527 struct font_name
*y
= (struct font_name
*) b
;
2530 /* All strings have been converted to lower-case by split_font_name,
2531 so we can use strcmp here. */
2532 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2537 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2539 int j
= font_sort_order
[i
];
2540 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2545 /* Everything else being equal, we prefer fonts with an
2546 y-resolution closer to that of the frame. */
2547 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2548 int x_resy
= x
->numeric
[XLFD_RESY
];
2549 int y_resy
= y
->numeric
[XLFD_RESY
];
2550 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2558 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2559 is non-nil list fonts matching that pattern. Otherwise, if
2560 REGISTRY is non-nil return only fonts with that registry, otherwise
2561 return fonts of any registry. Set *FONTS to a vector of font_name
2562 structures allocated from the heap containing the fonts found.
2563 Value is the number of fonts found. */
2566 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2568 Lisp_Object pattern
, family
, registry
;
2569 struct font_name
**fonts
;
2571 char *pattern_str
, *family_str
, *registry_str
;
2575 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2576 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2578 pattern_str
= (char *) alloca (strlen (family_str
)
2579 + strlen (registry_str
)
2581 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2582 strcat (pattern_str
, family_str
);
2583 strcat (pattern_str
, "-*-");
2584 strcat (pattern_str
, registry_str
);
2585 if (!index (registry_str
, '-'))
2587 if (registry_str
[strlen (registry_str
) - 1] == '*')
2588 strcat (pattern_str
, "-*");
2590 strcat (pattern_str
, "*-*");
2594 pattern_str
= (char *) XSTRING (pattern
)->data
;
2596 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2600 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2601 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2602 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2605 static struct font_name
*
2606 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2607 struct font_name
*fonts1
, *fonts2
;
2608 int nfonts1
, nfonts2
;
2610 int new_nfonts
= nfonts1
+ nfonts2
;
2611 struct font_name
*new_fonts
;
2613 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2614 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2615 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2622 /* Get a sorted list of fonts of family FAMILY on frame F.
2624 If PATTERN is non-nil list fonts matching that pattern.
2626 If REGISTRY is non-nil, return fonts with that registry and the
2627 alternative registries from Vface_alternative_font_registry_alist.
2629 If REGISTRY is nil return fonts of any registry.
2631 Set *FONTS to a vector of font_name structures allocated from the
2632 heap containing the fonts found. Value is the number of fonts
2636 font_list (f
, pattern
, family
, registry
, fonts
)
2638 Lisp_Object pattern
, family
, registry
;
2639 struct font_name
**fonts
;
2641 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2643 if (!NILP (registry
)
2644 && CONSP (Vface_alternative_font_registry_alist
))
2648 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2653 for (alter
= XCDR (alter
), reg_prio
= 1;
2655 alter
= XCDR (alter
), reg_prio
++)
2656 if (STRINGP (XCAR (alter
)))
2659 struct font_name
*fonts2
;
2661 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2663 for (i
= 0; i
< nfonts2
; i
++)
2664 fonts2
[i
].registry_priority
= reg_prio
;
2665 *fonts
= (nfonts
> 0
2666 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2677 /* Remove elements from LIST whose cars are `equal'. Called from
2678 x-family-fonts and x-font-family-list to remove duplicate font
2682 remove_duplicates (list
)
2685 Lisp_Object tail
= list
;
2687 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2689 Lisp_Object next
= XCDR (tail
);
2690 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2691 XSETCDR (tail
, XCDR (next
));
2698 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2699 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2700 If FAMILY is omitted or nil, list all families.
2701 Otherwise, FAMILY must be a string, possibly containing wildcards
2703 If FRAME is omitted or nil, use the selected frame.
2704 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2705 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2706 FAMILY is the font family name. POINT-SIZE is the size of the
2707 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2708 width, weight and slant of the font. These symbols are the same as for
2709 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2710 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2711 giving the registry and encoding of the font.
2712 The result list is sorted according to the current setting of
2713 the face font sort order. */)
2715 Lisp_Object family
, frame
;
2717 struct frame
*f
= check_x_frame (frame
);
2718 struct font_name
*fonts
;
2721 struct gcpro gcpro1
;
2724 CHECK_STRING (family
);
2728 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2729 for (i
= nfonts
- 1; i
>= 0; --i
)
2731 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2734 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2735 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2736 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2737 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2738 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2739 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2740 tem
= build_font_name (fonts
+ i
);
2741 ASET (v
, 6, build_string (tem
));
2742 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2743 fonts
[i
].fields
[XLFD_ENCODING
]);
2744 ASET (v
, 7, build_string (tem
));
2747 result
= Fcons (v
, result
);
2750 remove_duplicates (result
);
2751 free_font_names (fonts
, nfonts
);
2757 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2759 doc
: /* Return a list of available font families on FRAME.
2760 If FRAME is omitted or nil, use the selected frame.
2761 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2762 is a font family, and FIXED-P is non-nil if fonts of that family
2763 are fixed-pitch. */)
2767 struct frame
*f
= check_x_frame (frame
);
2769 struct font_name
*fonts
;
2771 struct gcpro gcpro1
;
2772 int count
= specpdl_ptr
- specpdl
;
2775 /* Let's consider all fonts. Increase the limit for matching
2776 fonts until we have them all. */
2779 specbind (intern ("font-list-limit"), make_number (limit
));
2780 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2782 if (nfonts
== limit
)
2784 free_font_names (fonts
, nfonts
);
2793 for (i
= nfonts
- 1; i
>= 0; --i
)
2794 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2795 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2798 remove_duplicates (result
);
2799 free_font_names (fonts
, nfonts
);
2801 return unbind_to (count
, result
);
2805 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2806 doc
: /* Return a list of the names of available fonts matching PATTERN.
2807 If optional arguments FACE and FRAME are specified, return only fonts
2808 the same size as FACE on FRAME.
2809 PATTERN is a string, perhaps with wildcard characters;
2810 the * character matches any substring, and
2811 the ? character matches any single character.
2812 PATTERN is case-insensitive.
2813 FACE is a face name--a symbol.
2815 The return value is a list of strings, suitable as arguments to
2818 Fonts Emacs can't use may or may not be excluded
2819 even if they match PATTERN and FACE.
2820 The optional fourth argument MAXIMUM sets a limit on how many
2821 fonts to match. The first MAXIMUM fonts are reported.
2822 The optional fifth argument WIDTH, if specified, is a number of columns
2823 occupied by a character of a font. In that case, return only fonts
2824 the WIDTH times as wide as FACE on FRAME. */)
2825 (pattern
, face
, frame
, maximum
, width
)
2826 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2833 CHECK_STRING (pattern
);
2839 CHECK_NATNUM (maximum
);
2840 maxnames
= XINT (maximum
);
2844 CHECK_NUMBER (width
);
2846 /* We can't simply call check_x_frame because this function may be
2847 called before any frame is created. */
2848 f
= frame_or_selected_frame (frame
, 2);
2849 if (!FRAME_WINDOW_P (f
))
2851 /* Perhaps we have not yet created any frame. */
2856 /* Determine the width standard for comparison with the fonts we find. */
2862 /* This is of limited utility since it works with character
2863 widths. Keep it for compatibility. --gerd. */
2864 int face_id
= lookup_named_face (f
, face
, 0);
2865 struct face
*face
= (face_id
< 0
2867 : FACE_FROM_ID (f
, face_id
));
2869 if (face
&& face
->font
)
2870 size
= FONT_WIDTH (face
->font
);
2872 size
= FONT_WIDTH (FRAME_FONT (f
));
2875 size
*= XINT (width
);
2879 Lisp_Object args
[2];
2881 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2883 /* We don't have to check fontsets. */
2885 args
[1] = list_fontsets (f
, pattern
, size
);
2886 return Fnconc (2, args
);
2890 #endif /* HAVE_WINDOW_SYSTEM */
2894 /***********************************************************************
2896 ***********************************************************************/
2898 /* Access face attributes of face LFACE, a Lisp vector. */
2900 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2901 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2902 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2903 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2904 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2905 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2906 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2907 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2908 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2909 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2910 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2911 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2912 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2913 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2914 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2915 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2917 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2918 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2920 #define LFACEP(LFACE) \
2922 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2923 && EQ (AREF (LFACE, 0), Qface))
2928 /* Check consistency of Lisp face attribute vector ATTRS. */
2931 check_lface_attrs (attrs
)
2934 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2935 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2936 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2937 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2938 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2939 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2940 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2941 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2942 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2943 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2944 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2945 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2946 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2947 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2948 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2949 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2950 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2951 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2952 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2953 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2954 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2955 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2956 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2957 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2958 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2959 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2960 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2961 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2962 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2963 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2964 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2965 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2966 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2967 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2968 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2969 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2970 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2971 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2972 #ifdef HAVE_WINDOW_SYSTEM
2973 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2974 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2975 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2976 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2977 || NILP (attrs
[LFACE_FONT_INDEX
])
2978 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2983 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2991 xassert (LFACEP (lface
));
2992 check_lface_attrs (XVECTOR (lface
)->contents
);
2996 #else /* GLYPH_DEBUG == 0 */
2998 #define check_lface_attrs(attrs) (void) 0
2999 #define check_lface(lface) (void) 0
3001 #endif /* GLYPH_DEBUG == 0 */
3004 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3005 to make it a symvol. If FACE_NAME is an alias for another face,
3006 return that face's name. */
3009 resolve_face_name (face_name
)
3010 Lisp_Object face_name
;
3012 Lisp_Object aliased
;
3014 if (STRINGP (face_name
))
3015 face_name
= intern (XSTRING (face_name
)->data
);
3017 while (SYMBOLP (face_name
))
3019 aliased
= Fget (face_name
, Qface_alias
);
3023 face_name
= aliased
;
3030 /* Return the face definition of FACE_NAME on frame F. F null means
3031 return the definition for new frames. FACE_NAME may be a string or
3032 a symbol (apparently Emacs 20.2 allowed strings as face names in
3033 face text properties; Ediff uses that). If FACE_NAME is an alias
3034 for another face, return that face's definition. If SIGNAL_P is
3035 non-zero, signal an error if FACE_NAME is not a valid face name.
3036 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3039 static INLINE Lisp_Object
3040 lface_from_face_name (f
, face_name
, signal_p
)
3042 Lisp_Object face_name
;
3047 face_name
= resolve_face_name (face_name
);
3050 lface
= assq_no_quit (face_name
, f
->face_alist
);
3052 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3055 lface
= XCDR (lface
);
3057 signal_error ("Invalid face", face_name
);
3059 check_lface (lface
);
3064 /* Get face attributes of face FACE_NAME from frame-local faces on
3065 frame F. Store the resulting attributes in ATTRS which must point
3066 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3067 is non-zero, signal an error if FACE_NAME does not name a face.
3068 Otherwise, value is zero if FACE_NAME is not a face. */
3071 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3073 Lisp_Object face_name
;
3080 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3083 bcopy (XVECTOR (lface
)->contents
, attrs
,
3084 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3094 /* Non-zero if all attributes in face attribute vector ATTRS are
3095 specified, i.e. are non-nil. */
3098 lface_fully_specified_p (attrs
)
3103 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3104 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3105 && i
!= LFACE_AVGWIDTH_INDEX
)
3106 if (UNSPECIFIEDP (attrs
[i
]))
3109 return i
== LFACE_VECTOR_SIZE
;
3112 #ifdef HAVE_WINDOW_SYSTEM
3114 /* Set font-related attributes of Lisp face LFACE from the fullname of
3115 the font opened by FONTNAME. If FORCE_P is zero, set only
3116 unspecified attributes of LFACE. The exception is `font'
3117 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3119 If FONTNAME is not available on frame F,
3120 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3121 If the fullname is not in a valid XLFD format,
3122 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3123 in LFACE and return 1.
3124 Otherwise, return 1. */
3127 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3130 Lisp_Object fontname
;
3131 int force_p
, may_fail_p
;
3133 struct font_name font
;
3138 char *font_name
= XSTRING (fontname
)->data
;
3139 struct font_info
*font_info
;
3141 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3142 fontset
= fs_query_fontset (fontname
, 0);
3144 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3146 /* Check if FONT_NAME is surely available on the system. Usually
3147 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3148 returns quickly. But, even if FONT_NAME is not yet cached,
3149 caching it now is not futail because we anyway load the font
3152 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3162 font
.name
= STRDUPA (font_info
->full_name
);
3163 have_xlfd_p
= split_font_name (f
, &font
, 1);
3165 /* Set attributes only if unspecified, otherwise face defaults for
3166 new frames would never take effect. If we couldn't get a font
3167 name conforming to XLFD, set normal values. */
3169 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3174 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3175 + strlen (font
.fields
[XLFD_FOUNDRY
])
3177 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3178 font
.fields
[XLFD_FAMILY
]);
3179 val
= build_string (buffer
);
3182 val
= build_string ("*");
3183 LFACE_FAMILY (lface
) = val
;
3186 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3189 pt
= xlfd_point_size (f
, &font
);
3191 pt
= pixel_point_size (f
, font_info
->height
* 10);
3193 LFACE_HEIGHT (lface
) = make_number (pt
);
3196 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3197 LFACE_SWIDTH (lface
)
3198 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3200 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3201 LFACE_AVGWIDTH (lface
)
3203 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3206 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3207 LFACE_WEIGHT (lface
)
3208 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3210 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3212 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3214 LFACE_FONT (lface
) = fontname
;
3219 #endif /* HAVE_WINDOW_SYSTEM */
3222 /* Merges the face height FROM with the face height TO, and returns the
3223 merged height. If FROM is an invalid height, then INVALID is
3224 returned instead. FROM and TO may be either absolute face heights or
3225 `relative' heights; the returned value is always an absolute height
3226 unless both FROM and TO are relative. GCPRO is a lisp value that
3227 will be protected from garbage-collection if this function makes a
3231 merge_face_heights (from
, to
, invalid
, gcpro
)
3232 Lisp_Object from
, to
, invalid
, gcpro
;
3234 Lisp_Object result
= invalid
;
3236 if (INTEGERP (from
))
3237 /* FROM is absolute, just use it as is. */
3239 else if (FLOATP (from
))
3240 /* FROM is a scale, use it to adjust TO. */
3243 /* relative X absolute => absolute */
3244 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3245 else if (FLOATP (to
))
3246 /* relative X relative => relative */
3247 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3249 else if (FUNCTIONP (from
))
3250 /* FROM is a function, which use to adjust TO. */
3252 /* Call function with current height as argument.
3253 From is the new height. */
3254 Lisp_Object args
[2];
3255 struct gcpro gcpro1
;
3261 result
= safe_call (2, args
);
3265 /* Ensure that if TO was absolute, so is the result. */
3266 if (INTEGERP (to
) && !INTEGERP (result
))
3274 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3275 store the resulting attributes in TO, which must be already be
3276 completely specified and contain only absolute attributes. Every
3277 specified attribute of FROM overrides the corresponding attribute of
3278 TO; relative attributes in FROM are merged with the absolute value in
3279 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3280 face inheritance; it should be Qnil when called from other places. */
3283 merge_face_vectors (f
, from
, to
, cycle_check
)
3285 Lisp_Object
*from
, *to
;
3286 Lisp_Object cycle_check
;
3290 /* If FROM inherits from some other faces, merge their attributes into
3291 TO before merging FROM's direct attributes. Note that an :inherit
3292 attribute of `unspecified' is the same as one of nil; we never
3293 merge :inherit attributes, so nil is more correct, but lots of
3294 other code uses `unspecified' as a generic value for face attributes. */
3295 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3296 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3297 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3299 /* If TO specifies a :font attribute, and FROM specifies some
3300 font-related attribute, we need to clear TO's :font attribute
3301 (because it will be inconsistent with whatever FROM specifies, and
3302 FROM takes precedence). */
3303 if (!NILP (to
[LFACE_FONT_INDEX
])
3304 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3305 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3306 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3307 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3308 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3309 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3310 to
[LFACE_FONT_INDEX
] = Qnil
;
3312 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3313 if (!UNSPECIFIEDP (from
[i
]))
3315 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3316 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3321 /* TO is always an absolute face, which should inherit from nothing.
3322 We blindly copy the :inherit attribute above and fix it up here. */
3323 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3327 /* Checks the `cycle check' variable CHECK to see if it indicates that
3328 EL is part of a cycle; CHECK must be either Qnil or a value returned
3329 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3330 elements after which a cycle might be suspected; after that many
3331 elements, this macro begins consing in order to keep more precise
3334 Returns nil if a cycle was detected, otherwise a new value for CHECK
3337 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3338 the caller should make sure that's ok. */
3340 #define CYCLE_CHECK(check, el, suspicious) \
3343 : (INTEGERP (check) \
3344 ? (XFASTINT (check) < (suspicious) \
3345 ? make_number (XFASTINT (check) + 1) \
3346 : Fcons (el, Qnil)) \
3347 : (!NILP (Fmemq ((el), (check))) \
3349 : Fcons ((el), (check)))))
3352 /* Merge face attributes from the face on frame F whose name is
3353 INHERITS, into the vector of face attributes TO; INHERITS may also be
3354 a list of face names, in which case they are applied in order.
3355 CYCLE_CHECK is used to detect loops in face inheritance.
3356 Returns true if any of the inherited attributes are `font-related'. */
3359 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3361 Lisp_Object inherit
;
3363 Lisp_Object cycle_check
;
3365 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3366 /* Inherit from the named face INHERIT. */
3370 /* Make sure we're not in an inheritance loop. */
3371 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3372 if (NILP (cycle_check
))
3373 /* Cycle detected, ignore any further inheritance. */
3376 lface
= lface_from_face_name (f
, inherit
, 0);
3378 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3380 else if (CONSP (inherit
))
3381 /* Handle a list of inherited faces by calling ourselves recursively
3382 on each element. Note that we only do so for symbol elements, so
3383 it's not possible to infinitely recurse. */
3385 while (CONSP (inherit
))
3387 if (SYMBOLP (XCAR (inherit
)))
3388 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3390 /* Check for a circular inheritance list. */
3391 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3392 if (NILP (cycle_check
))
3393 /* Cycle detected. */
3396 inherit
= XCDR (inherit
);
3402 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3403 is a face property, determine the resulting face attributes on
3404 frame F, and store them in TO. PROP may be a single face
3405 specification or a list of such specifications. Each face
3406 specification can be
3408 1. A symbol or string naming a Lisp face.
3410 2. A property list of the form (KEYWORD VALUE ...) where each
3411 KEYWORD is a face attribute name, and value is an appropriate value
3414 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3415 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3416 for compatibility with 20.2.
3418 Face specifications earlier in lists take precedence over later
3422 merge_face_vector_with_property (f
, to
, prop
)
3429 Lisp_Object first
= XCAR (prop
);
3431 if (EQ (first
, Qforeground_color
)
3432 || EQ (first
, Qbackground_color
))
3434 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3435 . COLOR). COLOR must be a string. */
3436 Lisp_Object color_name
= XCDR (prop
);
3437 Lisp_Object color
= first
;
3439 if (STRINGP (color_name
))
3441 if (EQ (color
, Qforeground_color
))
3442 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3444 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3447 add_to_log ("Invalid face color", color_name
, Qnil
);
3449 else if (SYMBOLP (first
)
3450 && *XSYMBOL (first
)->name
->data
== ':')
3452 /* Assume this is the property list form. */
3453 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3455 Lisp_Object keyword
= XCAR (prop
);
3456 Lisp_Object value
= XCAR (XCDR (prop
));
3458 if (EQ (keyword
, QCfamily
))
3460 if (STRINGP (value
))
3461 to
[LFACE_FAMILY_INDEX
] = value
;
3463 add_to_log ("Invalid face font family", value
, Qnil
);
3465 else if (EQ (keyword
, QCheight
))
3467 Lisp_Object new_height
=
3468 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3471 if (NILP (new_height
))
3472 add_to_log ("Invalid face font height", value
, Qnil
);
3474 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3476 else if (EQ (keyword
, QCweight
))
3479 && face_numeric_weight (value
) >= 0)
3480 to
[LFACE_WEIGHT_INDEX
] = value
;
3482 add_to_log ("Invalid face weight", value
, Qnil
);
3484 else if (EQ (keyword
, QCslant
))
3487 && face_numeric_slant (value
) >= 0)
3488 to
[LFACE_SLANT_INDEX
] = value
;
3490 add_to_log ("Invalid face slant", value
, Qnil
);
3492 else if (EQ (keyword
, QCunderline
))
3497 to
[LFACE_UNDERLINE_INDEX
] = value
;
3499 add_to_log ("Invalid face underline", value
, Qnil
);
3501 else if (EQ (keyword
, QCoverline
))
3506 to
[LFACE_OVERLINE_INDEX
] = value
;
3508 add_to_log ("Invalid face overline", value
, Qnil
);
3510 else if (EQ (keyword
, QCstrike_through
))
3515 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3517 add_to_log ("Invalid face strike-through", value
, Qnil
);
3519 else if (EQ (keyword
, QCbox
))
3522 value
= make_number (1);
3523 if (INTEGERP (value
)
3527 to
[LFACE_BOX_INDEX
] = value
;
3529 add_to_log ("Invalid face box", value
, Qnil
);
3531 else if (EQ (keyword
, QCinverse_video
)
3532 || EQ (keyword
, QCreverse_video
))
3534 if (EQ (value
, Qt
) || NILP (value
))
3535 to
[LFACE_INVERSE_INDEX
] = value
;
3537 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3539 else if (EQ (keyword
, QCforeground
))
3541 if (STRINGP (value
))
3542 to
[LFACE_FOREGROUND_INDEX
] = value
;
3544 add_to_log ("Invalid face foreground", value
, Qnil
);
3546 else if (EQ (keyword
, QCbackground
))
3548 if (STRINGP (value
))
3549 to
[LFACE_BACKGROUND_INDEX
] = value
;
3551 add_to_log ("Invalid face background", value
, Qnil
);
3553 else if (EQ (keyword
, QCstipple
))
3555 #ifdef HAVE_X_WINDOWS
3556 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3557 if (!NILP (pixmap_p
))
3558 to
[LFACE_STIPPLE_INDEX
] = value
;
3560 add_to_log ("Invalid face stipple", value
, Qnil
);
3563 else if (EQ (keyword
, QCwidth
))
3566 && face_numeric_swidth (value
) >= 0)
3567 to
[LFACE_SWIDTH_INDEX
] = value
;
3569 add_to_log ("Invalid face width", value
, Qnil
);
3571 else if (EQ (keyword
, QCinherit
))
3573 if (SYMBOLP (value
))
3574 to
[LFACE_INHERIT_INDEX
] = value
;
3578 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3579 if (!SYMBOLP (XCAR (tail
)))
3582 to
[LFACE_INHERIT_INDEX
] = value
;
3584 add_to_log ("Invalid face inherit", value
, Qnil
);
3588 add_to_log ("Invalid attribute %s in face property",
3591 prop
= XCDR (XCDR (prop
));
3596 /* This is a list of face specs. Specifications at the
3597 beginning of the list take precedence over later
3598 specifications, so we have to merge starting with the
3599 last specification. */
3600 Lisp_Object next
= XCDR (prop
);
3602 merge_face_vector_with_property (f
, to
, next
);
3603 merge_face_vector_with_property (f
, to
, first
);
3608 /* PROP ought to be a face name. */
3609 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3611 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3613 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3618 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3619 Sinternal_make_lisp_face
, 1, 2, 0,
3620 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3621 If FACE was not known as a face before, create a new one.
3622 If optional argument FRAME is specified, make a frame-local face
3623 for that frame. Otherwise operate on the global face definition.
3624 Value is a vector of face attributes. */)
3626 Lisp_Object face
, frame
;
3628 Lisp_Object global_lface
, lface
;
3632 CHECK_SYMBOL (face
);
3633 global_lface
= lface_from_face_name (NULL
, face
, 0);
3637 CHECK_LIVE_FRAME (frame
);
3639 lface
= lface_from_face_name (f
, face
, 0);
3642 f
= NULL
, lface
= Qnil
;
3644 /* Add a global definition if there is none. */
3645 if (NILP (global_lface
))
3647 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3649 AREF (global_lface
, 0) = Qface
;
3650 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3651 Vface_new_frame_defaults
);
3653 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3654 face id to Lisp face is given by the vector lface_id_to_name.
3655 The mapping from Lisp face to Lisp face id is given by the
3656 property `face' of the Lisp face name. */
3657 if (next_lface_id
== lface_id_to_name_size
)
3659 int new_size
= max (50, 2 * lface_id_to_name_size
);
3660 int sz
= new_size
* sizeof *lface_id_to_name
;
3661 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3662 lface_id_to_name_size
= new_size
;
3665 lface_id_to_name
[next_lface_id
] = face
;
3666 Fput (face
, Qface
, make_number (next_lface_id
));
3670 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3671 AREF (global_lface
, i
) = Qunspecified
;
3673 /* Add a frame-local definition. */
3678 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3680 AREF (lface
, 0) = Qface
;
3681 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3684 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3685 AREF (lface
, i
) = Qunspecified
;
3688 lface
= global_lface
;
3690 xassert (LFACEP (lface
));
3691 check_lface (lface
);
3696 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3697 Sinternal_lisp_face_p
, 1, 2, 0,
3698 doc
: /* Return non-nil if FACE names a face.
3699 If optional second parameter FRAME is non-nil, check for the
3700 existence of a frame-local face with name FACE on that frame.
3701 Otherwise check for the existence of a global face. */)
3703 Lisp_Object face
, frame
;
3709 CHECK_LIVE_FRAME (frame
);
3710 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3713 lface
= lface_from_face_name (NULL
, face
, 0);
3719 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3720 Sinternal_copy_lisp_face
, 4, 4, 0,
3721 doc
: /* Copy face FROM to TO.
3722 If FRAME it t, copy the global face definition of FROM to the
3723 global face definition of TO. Otherwise, copy the frame-local
3724 definition of FROM on FRAME to the frame-local definition of TO
3725 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3728 (from
, to
, frame
, new_frame
)
3729 Lisp_Object from
, to
, frame
, new_frame
;
3731 Lisp_Object lface
, copy
;
3733 CHECK_SYMBOL (from
);
3735 if (NILP (new_frame
))
3740 /* Copy global definition of FROM. We don't make copies of
3741 strings etc. because 20.2 didn't do it either. */
3742 lface
= lface_from_face_name (NULL
, from
, 1);
3743 copy
= Finternal_make_lisp_face (to
, Qnil
);
3747 /* Copy frame-local definition of FROM. */
3748 CHECK_LIVE_FRAME (frame
);
3749 CHECK_LIVE_FRAME (new_frame
);
3750 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3751 copy
= Finternal_make_lisp_face (to
, new_frame
);
3754 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3755 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3761 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3762 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3763 doc
: /* Set attribute ATTR of FACE to VALUE.
3764 FRAME being a frame means change the face on that frame.
3765 FRAME nil means change the face of the selected frame.
3766 FRAME t means change the default for new frames.
3767 FRAME 0 means change the face on all frames, and change the default
3769 (face
, attr
, value
, frame
)
3770 Lisp_Object face
, attr
, value
, frame
;
3773 Lisp_Object old_value
= Qnil
;
3774 /* Set 1 if ATTR is QCfont. */
3775 int font_attr_p
= 0;
3776 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3777 int font_related_attr_p
= 0;
3779 CHECK_SYMBOL (face
);
3780 CHECK_SYMBOL (attr
);
3782 face
= resolve_face_name (face
);
3784 /* If FRAME is 0, change face on all frames, and change the
3785 default for new frames. */
3786 if (INTEGERP (frame
) && XINT (frame
) == 0)
3789 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3790 FOR_EACH_FRAME (tail
, frame
)
3791 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3795 /* Set lface to the Lisp attribute vector of FACE. */
3797 lface
= lface_from_face_name (NULL
, face
, 1);
3801 frame
= selected_frame
;
3803 CHECK_LIVE_FRAME (frame
);
3804 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3806 /* If a frame-local face doesn't exist yet, create one. */
3808 lface
= Finternal_make_lisp_face (face
, frame
);
3811 if (EQ (attr
, QCfamily
))
3813 if (!UNSPECIFIEDP (value
))
3815 CHECK_STRING (value
);
3816 if (XSTRING (value
)->size
== 0)
3817 signal_error ("Invalid face family", value
);
3819 old_value
= LFACE_FAMILY (lface
);
3820 LFACE_FAMILY (lface
) = value
;
3821 font_related_attr_p
= 1;
3823 else if (EQ (attr
, QCheight
))
3825 if (!UNSPECIFIEDP (value
))
3829 test
= (EQ (face
, Qdefault
)
3831 /* The default face must have an absolute size,
3832 otherwise, we do a test merge with a random
3833 height to see if VALUE's ok. */
3834 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3836 if (!INTEGERP (test
) || XINT (test
) <= 0)
3837 signal_error ("Invalid face height", value
);
3840 old_value
= LFACE_HEIGHT (lface
);
3841 LFACE_HEIGHT (lface
) = value
;
3842 font_related_attr_p
= 1;
3844 else if (EQ (attr
, QCweight
))
3846 if (!UNSPECIFIEDP (value
))
3848 CHECK_SYMBOL (value
);
3849 if (face_numeric_weight (value
) < 0)
3850 signal_error ("Invalid face weight", value
);
3852 old_value
= LFACE_WEIGHT (lface
);
3853 LFACE_WEIGHT (lface
) = value
;
3854 font_related_attr_p
= 1;
3856 else if (EQ (attr
, QCslant
))
3858 if (!UNSPECIFIEDP (value
))
3860 CHECK_SYMBOL (value
);
3861 if (face_numeric_slant (value
) < 0)
3862 signal_error ("Invalid face slant", value
);
3864 old_value
= LFACE_SLANT (lface
);
3865 LFACE_SLANT (lface
) = value
;
3866 font_related_attr_p
= 1;
3868 else if (EQ (attr
, QCunderline
))
3870 if (!UNSPECIFIEDP (value
))
3871 if ((SYMBOLP (value
)
3873 && !EQ (value
, Qnil
))
3874 /* Underline color. */
3876 && XSTRING (value
)->size
== 0))
3877 signal_error ("Invalid face underline", value
);
3879 old_value
= LFACE_UNDERLINE (lface
);
3880 LFACE_UNDERLINE (lface
) = value
;
3882 else if (EQ (attr
, QCoverline
))
3884 if (!UNSPECIFIEDP (value
))
3885 if ((SYMBOLP (value
)
3887 && !EQ (value
, Qnil
))
3888 /* Overline color. */
3890 && XSTRING (value
)->size
== 0))
3891 signal_error ("Invalid face overline", value
);
3893 old_value
= LFACE_OVERLINE (lface
);
3894 LFACE_OVERLINE (lface
) = value
;
3896 else if (EQ (attr
, QCstrike_through
))
3898 if (!UNSPECIFIEDP (value
))
3899 if ((SYMBOLP (value
)
3901 && !EQ (value
, Qnil
))
3902 /* Strike-through color. */
3904 && XSTRING (value
)->size
== 0))
3905 signal_error ("Invalid face strike-through", value
);
3907 old_value
= LFACE_STRIKE_THROUGH (lface
);
3908 LFACE_STRIKE_THROUGH (lface
) = value
;
3910 else if (EQ (attr
, QCbox
))
3914 /* Allow t meaning a simple box of width 1 in foreground color
3917 value
= make_number (1);
3919 if (UNSPECIFIEDP (value
))
3921 else if (NILP (value
))
3923 else if (INTEGERP (value
))
3924 valid_p
= XINT (value
) != 0;
3925 else if (STRINGP (value
))
3926 valid_p
= XSTRING (value
)->size
> 0;
3927 else if (CONSP (value
))
3943 if (EQ (k
, QCline_width
))
3945 if (!INTEGERP (v
) || XINT (v
) == 0)
3948 else if (EQ (k
, QCcolor
))
3950 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3953 else if (EQ (k
, QCstyle
))
3955 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3962 valid_p
= NILP (tem
);
3968 signal_error ("Invalid face box", value
);
3970 old_value
= LFACE_BOX (lface
);
3971 LFACE_BOX (lface
) = value
;
3973 else if (EQ (attr
, QCinverse_video
)
3974 || EQ (attr
, QCreverse_video
))
3976 if (!UNSPECIFIEDP (value
))
3978 CHECK_SYMBOL (value
);
3979 if (!EQ (value
, Qt
) && !NILP (value
))
3980 signal_error ("Invalid inverse-video face attribute value", value
);
3982 old_value
= LFACE_INVERSE (lface
);
3983 LFACE_INVERSE (lface
) = value
;
3985 else if (EQ (attr
, QCforeground
))
3987 if (!UNSPECIFIEDP (value
))
3989 /* Don't check for valid color names here because it depends
3990 on the frame (display) whether the color will be valid
3991 when the face is realized. */
3992 CHECK_STRING (value
);
3993 if (XSTRING (value
)->size
== 0)
3994 signal_error ("Empty foreground color value", value
);
3996 old_value
= LFACE_FOREGROUND (lface
);
3997 LFACE_FOREGROUND (lface
) = value
;
3999 else if (EQ (attr
, QCbackground
))
4001 if (!UNSPECIFIEDP (value
))
4003 /* Don't check for valid color names here because it depends
4004 on the frame (display) whether the color will be valid
4005 when the face is realized. */
4006 CHECK_STRING (value
);
4007 if (XSTRING (value
)->size
== 0)
4008 signal_error ("Empty background color value", value
);
4010 old_value
= LFACE_BACKGROUND (lface
);
4011 LFACE_BACKGROUND (lface
) = value
;
4013 else if (EQ (attr
, QCstipple
))
4015 #ifdef HAVE_X_WINDOWS
4016 if (!UNSPECIFIEDP (value
)
4018 && NILP (Fbitmap_spec_p (value
)))
4019 signal_error ("Invalid stipple attribute", value
);
4020 old_value
= LFACE_STIPPLE (lface
);
4021 LFACE_STIPPLE (lface
) = value
;
4022 #endif /* HAVE_X_WINDOWS */
4024 else if (EQ (attr
, QCwidth
))
4026 if (!UNSPECIFIEDP (value
))
4028 CHECK_SYMBOL (value
);
4029 if (face_numeric_swidth (value
) < 0)
4030 signal_error ("Invalid face width", value
);
4032 old_value
= LFACE_SWIDTH (lface
);
4033 LFACE_SWIDTH (lface
) = value
;
4034 font_related_attr_p
= 1;
4036 else if (EQ (attr
, QCfont
))
4038 #ifdef HAVE_WINDOW_SYSTEM
4039 if (FRAME_WINDOW_P (XFRAME (frame
)))
4041 /* Set font-related attributes of the Lisp face from an XLFD
4046 CHECK_STRING (value
);
4048 f
= SELECTED_FRAME ();
4050 f
= check_x_frame (frame
);
4052 /* VALUE may be a fontset name or an alias of fontset. In
4053 such a case, use the base fontset name. */
4054 tmp
= Fquery_fontset (value
, Qnil
);
4058 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4059 signal_error ("Invalid font or fontset name", value
);
4063 #endif /* HAVE_WINDOW_SYSTEM */
4065 else if (EQ (attr
, QCinherit
))
4068 if (SYMBOLP (value
))
4071 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4072 if (!SYMBOLP (XCAR (tail
)))
4075 LFACE_INHERIT (lface
) = value
;
4077 signal_error ("Invalid face inheritance", value
);
4079 else if (EQ (attr
, QCbold
))
4081 old_value
= LFACE_WEIGHT (lface
);
4082 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4083 font_related_attr_p
= 1;
4085 else if (EQ (attr
, QCitalic
))
4087 old_value
= LFACE_SLANT (lface
);
4088 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4089 font_related_attr_p
= 1;
4092 signal_error ("Invalid face attribute name", attr
);
4094 if (font_related_attr_p
4095 && !UNSPECIFIEDP (value
))
4096 /* If a font-related attribute other than QCfont is specified, the
4097 original `font' attribute nor that of default face is useless
4098 to determine a new font. Thus, we set it to nil so that font
4099 selection mechanism doesn't use it. */
4100 LFACE_FONT (lface
) = Qnil
;
4102 /* Changing a named face means that all realized faces depending on
4103 that face are invalid. Since we cannot tell which realized faces
4104 depend on the face, make sure they are all removed. This is done
4105 by incrementing face_change_count. The next call to
4106 init_iterator will then free realized faces. */
4108 && (EQ (attr
, QCfont
)
4109 || NILP (Fequal (old_value
, value
))))
4111 ++face_change_count
;
4112 ++windows_or_buffers_changed
;
4115 if (!UNSPECIFIEDP (value
)
4116 && NILP (Fequal (old_value
, value
)))
4122 if (EQ (face
, Qdefault
))
4124 #ifdef HAVE_WINDOW_SYSTEM
4125 /* Changed font-related attributes of the `default' face are
4126 reflected in changed `font' frame parameters. */
4128 && (font_related_attr_p
|| font_attr_p
)
4129 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4130 set_font_frame_param (frame
, lface
);
4132 #endif /* HAVE_WINDOW_SYSTEM */
4134 if (EQ (attr
, QCforeground
))
4135 param
= Qforeground_color
;
4136 else if (EQ (attr
, QCbackground
))
4137 param
= Qbackground_color
;
4139 #ifdef HAVE_WINDOW_SYSTEM
4141 else if (EQ (face
, Qscroll_bar
))
4143 /* Changing the colors of `scroll-bar' sets frame parameters
4144 `scroll-bar-foreground' and `scroll-bar-background'. */
4145 if (EQ (attr
, QCforeground
))
4146 param
= Qscroll_bar_foreground
;
4147 else if (EQ (attr
, QCbackground
))
4148 param
= Qscroll_bar_background
;
4150 #endif /* not WINDOWSNT */
4151 else if (EQ (face
, Qborder
))
4153 /* Changing background color of `border' sets frame parameter
4155 if (EQ (attr
, QCbackground
))
4156 param
= Qborder_color
;
4158 else if (EQ (face
, Qcursor
))
4160 /* Changing background color of `cursor' sets frame parameter
4162 if (EQ (attr
, QCbackground
))
4163 param
= Qcursor_color
;
4165 else if (EQ (face
, Qmouse
))
4167 /* Changing background color of `mouse' sets frame parameter
4169 if (EQ (attr
, QCbackground
))
4170 param
= Qmouse_color
;
4172 #endif /* HAVE_WINDOW_SYSTEM */
4173 else if (EQ (face
, Qmenu
))
4175 /* Indicate that we have to update the menu bar when
4176 realizing faces on FRAME. FRAME t change the
4177 default for new frames. We do this by setting
4178 setting the flag in new face caches */
4181 struct frame
*f
= XFRAME (frame
);
4182 if (FRAME_FACE_CACHE (f
) == NULL
)
4183 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4184 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4187 menu_face_changed_default
= 1;
4193 /* Update `default-frame-alist', which is used for new frames. */
4195 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4198 /* Update the current frame's parameters. */
4201 cons
= XCAR (Vparam_value_alist
);
4202 XSETCAR (cons
, param
);
4203 XSETCDR (cons
, value
);
4204 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4213 #ifdef HAVE_WINDOW_SYSTEM
4215 /* Set the `font' frame parameter of FRAME determined from `default'
4216 face attributes LFACE. If a face or fontset name is explicitely
4217 specfied in LFACE, use it as is. Otherwise, determine a font name
4218 from the other font-related atrributes of LFACE. In that case, if
4219 there's no matching font, signals an error. */
4222 set_font_frame_param (frame
, lface
)
4223 Lisp_Object frame
, lface
;
4225 struct frame
*f
= XFRAME (frame
);
4227 if (FRAME_WINDOW_P (f
))
4229 Lisp_Object font_name
;
4232 if (STRINGP (LFACE_FONT (lface
)))
4233 font_name
= LFACE_FONT (lface
);
4236 /* Choose a font name that reflects LFACE's attributes and has
4237 the registry and encoding pattern specified in the default
4238 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4239 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4241 error ("No font matches the specified attribute");
4242 font_name
= build_string (font
);
4246 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4251 /* Update the corresponding face when frame parameter PARAM on frame F
4252 has been assigned the value NEW_VALUE. */
4255 update_face_from_frame_parameter (f
, param
, new_value
)
4257 Lisp_Object param
, new_value
;
4261 /* If there are no faces yet, give up. This is the case when called
4262 from Fx_create_frame, and we do the necessary things later in
4263 face-set-after-frame-defaults. */
4264 if (NILP (f
->face_alist
))
4267 if (EQ (param
, Qforeground_color
))
4269 lface
= lface_from_face_name (f
, Qdefault
, 1);
4270 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4271 ? new_value
: Qunspecified
);
4272 realize_basic_faces (f
);
4274 else if (EQ (param
, Qbackground_color
))
4278 /* Changing the background color might change the background
4279 mode, so that we have to load new defface specs. Call
4280 frame-update-face-colors to do that. */
4281 XSETFRAME (frame
, f
);
4282 call1 (Qframe_update_face_colors
, frame
);
4284 lface
= lface_from_face_name (f
, Qdefault
, 1);
4285 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4286 ? new_value
: Qunspecified
);
4287 realize_basic_faces (f
);
4289 if (EQ (param
, Qborder_color
))
4291 lface
= lface_from_face_name (f
, Qborder
, 1);
4292 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4293 ? new_value
: Qunspecified
);
4295 else if (EQ (param
, Qcursor_color
))
4297 lface
= lface_from_face_name (f
, Qcursor
, 1);
4298 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4299 ? new_value
: Qunspecified
);
4301 else if (EQ (param
, Qmouse_color
))
4303 lface
= lface_from_face_name (f
, Qmouse
, 1);
4304 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4305 ? new_value
: Qunspecified
);
4310 /* Get the value of X resource RESOURCE, class CLASS for the display
4311 of frame FRAME. This is here because ordinary `x-get-resource'
4312 doesn't take a frame argument. */
4314 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4315 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4316 (resource
, class, frame
)
4317 Lisp_Object resource
, class, frame
;
4319 Lisp_Object value
= Qnil
;
4322 CHECK_STRING (resource
);
4323 CHECK_STRING (class);
4324 CHECK_LIVE_FRAME (frame
);
4326 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4327 resource
, class, Qnil
, Qnil
);
4329 #endif /* not macintosh */
4330 #endif /* not WINDOWSNT */
4335 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4336 If VALUE is "on" or "true", return t. If VALUE is "off" or
4337 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4338 error; if SIGNAL_P is zero, return 0. */
4341 face_boolean_x_resource_value (value
, signal_p
)
4345 Lisp_Object result
= make_number (0);
4347 xassert (STRINGP (value
));
4349 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4350 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4352 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4353 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4355 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4356 result
= Qunspecified
;
4358 signal_error ("Invalid face attribute value from X resource", value
);
4364 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4365 Finternal_set_lisp_face_attribute_from_resource
,
4366 Sinternal_set_lisp_face_attribute_from_resource
,
4367 3, 4, 0, doc
: /* */)
4368 (face
, attr
, value
, frame
)
4369 Lisp_Object face
, attr
, value
, frame
;
4371 CHECK_SYMBOL (face
);
4372 CHECK_SYMBOL (attr
);
4373 CHECK_STRING (value
);
4375 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4376 value
= Qunspecified
;
4377 else if (EQ (attr
, QCheight
))
4379 value
= Fstring_to_number (value
, make_number (10));
4380 if (XINT (value
) <= 0)
4381 signal_error ("Invalid face height from X resource", value
);
4383 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4384 value
= face_boolean_x_resource_value (value
, 1);
4385 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4386 value
= intern (XSTRING (value
)->data
);
4387 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4388 value
= face_boolean_x_resource_value (value
, 1);
4389 else if (EQ (attr
, QCunderline
)
4390 || EQ (attr
, QCoverline
)
4391 || EQ (attr
, QCstrike_through
))
4393 Lisp_Object boolean_value
;
4395 /* If the result of face_boolean_x_resource_value is t or nil,
4396 VALUE does NOT specify a color. */
4397 boolean_value
= face_boolean_x_resource_value (value
, 0);
4398 if (SYMBOLP (boolean_value
))
4399 value
= boolean_value
;
4401 else if (EQ (attr
, QCbox
))
4402 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4404 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4407 #endif /* HAVE_WINDOW_SYSTEM */
4410 /***********************************************************************
4412 ***********************************************************************/
4414 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4416 /* Make menus on frame F appear as specified by the `menu' face. */
4419 x_update_menu_appearance (f
)
4422 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4426 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4430 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4431 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4432 char *myname
= XSTRING (Vx_resource_name
)->data
;
4435 const char *popup_path
= "popup_menu";
4437 const char *popup_path
= "menu.popup";
4440 if (STRINGP (LFACE_FOREGROUND (lface
)))
4442 sprintf (line
, "%s.%s*foreground: %s",
4444 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4445 XrmPutLineResource (&rdb
, line
);
4446 sprintf (line
, "%s.pane.menubar*foreground: %s",
4447 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4448 XrmPutLineResource (&rdb
, line
);
4452 if (STRINGP (LFACE_BACKGROUND (lface
)))
4454 sprintf (line
, "%s.%s*background: %s",
4456 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4457 XrmPutLineResource (&rdb
, line
);
4458 sprintf (line
, "%s.pane.menubar*background: %s",
4459 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4460 XrmPutLineResource (&rdb
, line
);
4465 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4466 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4467 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4468 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4469 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4470 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4473 const char *suffix
= "List";
4475 const char *suffix
= "";
4477 sprintf (line
, "%s.pane.menubar*font%s: %s",
4478 myname
, suffix
, face
->font_name
);
4479 XrmPutLineResource (&rdb
, line
);
4480 sprintf (line
, "%s.%s*font%s: %s",
4481 myname
, popup_path
, suffix
, face
->font_name
);
4482 XrmPutLineResource (&rdb
, line
);
4486 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4487 free_frame_menubar (f
);
4491 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4494 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4495 Sface_attribute_relative_p
,
4497 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4499 Lisp_Object attribute
, value
;
4501 if (EQ (value
, Qunspecified
))
4503 else if (EQ (attribute
, QCheight
))
4504 return INTEGERP (value
) ? Qnil
: Qt
;
4509 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4511 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4512 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4513 the result will be absolute, otherwise it will be relative. */)
4514 (attribute
, value1
, value2
)
4515 Lisp_Object attribute
, value1
, value2
;
4517 if (EQ (value1
, Qunspecified
))
4519 else if (EQ (attribute
, QCheight
))
4520 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4526 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4527 Sinternal_get_lisp_face_attribute
,
4529 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4530 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4531 face attribute name, signal an error.
4532 If the optional argument FRAME is given, report on face FACE in that
4533 frame. If FRAME is t, report on the defaults for face FACE (for new
4534 frames). If FRAME is omitted or nil, use the selected frame. */)
4535 (symbol
, keyword
, frame
)
4536 Lisp_Object symbol
, keyword
, frame
;
4538 Lisp_Object lface
, value
= Qnil
;
4540 CHECK_SYMBOL (symbol
);
4541 CHECK_SYMBOL (keyword
);
4544 lface
= lface_from_face_name (NULL
, symbol
, 1);
4548 frame
= selected_frame
;
4549 CHECK_LIVE_FRAME (frame
);
4550 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4553 if (EQ (keyword
, QCfamily
))
4554 value
= LFACE_FAMILY (lface
);
4555 else if (EQ (keyword
, QCheight
))
4556 value
= LFACE_HEIGHT (lface
);
4557 else if (EQ (keyword
, QCweight
))
4558 value
= LFACE_WEIGHT (lface
);
4559 else if (EQ (keyword
, QCslant
))
4560 value
= LFACE_SLANT (lface
);
4561 else if (EQ (keyword
, QCunderline
))
4562 value
= LFACE_UNDERLINE (lface
);
4563 else if (EQ (keyword
, QCoverline
))
4564 value
= LFACE_OVERLINE (lface
);
4565 else if (EQ (keyword
, QCstrike_through
))
4566 value
= LFACE_STRIKE_THROUGH (lface
);
4567 else if (EQ (keyword
, QCbox
))
4568 value
= LFACE_BOX (lface
);
4569 else if (EQ (keyword
, QCinverse_video
)
4570 || EQ (keyword
, QCreverse_video
))
4571 value
= LFACE_INVERSE (lface
);
4572 else if (EQ (keyword
, QCforeground
))
4573 value
= LFACE_FOREGROUND (lface
);
4574 else if (EQ (keyword
, QCbackground
))
4575 value
= LFACE_BACKGROUND (lface
);
4576 else if (EQ (keyword
, QCstipple
))
4577 value
= LFACE_STIPPLE (lface
);
4578 else if (EQ (keyword
, QCwidth
))
4579 value
= LFACE_SWIDTH (lface
);
4580 else if (EQ (keyword
, QCinherit
))
4581 value
= LFACE_INHERIT (lface
);
4582 else if (EQ (keyword
, QCfont
))
4583 value
= LFACE_FONT (lface
);
4585 signal_error ("Invalid face attribute name", keyword
);
4591 DEFUN ("internal-lisp-face-attribute-values",
4592 Finternal_lisp_face_attribute_values
,
4593 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4594 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4595 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4599 Lisp_Object result
= Qnil
;
4601 CHECK_SYMBOL (attr
);
4603 if (EQ (attr
, QCweight
)
4604 || EQ (attr
, QCslant
)
4605 || EQ (attr
, QCwidth
))
4607 /* Extract permissible symbols from tables. */
4608 struct table_entry
*table
;
4611 if (EQ (attr
, QCweight
))
4612 table
= weight_table
, dim
= DIM (weight_table
);
4613 else if (EQ (attr
, QCslant
))
4614 table
= slant_table
, dim
= DIM (slant_table
);
4616 table
= swidth_table
, dim
= DIM (swidth_table
);
4618 for (i
= 0; i
< dim
; ++i
)
4620 Lisp_Object symbol
= *table
[i
].symbol
;
4621 Lisp_Object tail
= result
;
4624 && !EQ (XCAR (tail
), symbol
))
4628 result
= Fcons (symbol
, result
);
4631 else if (EQ (attr
, QCunderline
))
4632 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4633 else if (EQ (attr
, QCoverline
))
4634 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4635 else if (EQ (attr
, QCstrike_through
))
4636 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4637 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4638 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4644 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4645 Sinternal_merge_in_global_face
, 2, 2, 0,
4646 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4647 Default face attributes override any local face attributes. */)
4649 Lisp_Object face
, frame
;
4652 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4654 CHECK_LIVE_FRAME (frame
);
4655 global_lface
= lface_from_face_name (NULL
, face
, 1);
4656 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4657 if (NILP (local_lface
))
4658 local_lface
= Finternal_make_lisp_face (face
, frame
);
4660 /* Make every specified global attribute override the local one.
4661 BEWARE!! This is only used from `face-set-after-frame-default' where
4662 the local frame is defined from default specs in `face-defface-spec'
4663 and those should be overridden by global settings. Hence the strange
4664 "global before local" priority. */
4665 lvec
= XVECTOR (local_lface
)->contents
;
4666 gvec
= XVECTOR (global_lface
)->contents
;
4667 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4668 if (! UNSPECIFIEDP (gvec
[i
]))
4675 /* The following function is implemented for compatibility with 20.2.
4676 The function is used in x-resolve-fonts when it is asked to
4677 return fonts with the same size as the font of a face. This is
4678 done in fontset.el. */
4680 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4681 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4682 If the optional argument FRAME is given, report on face FACE in that frame.
4683 If FRAME is t, report on the defaults for face FACE (for new frames).
4684 The font default for a face is either nil, or a list
4685 of the form (bold), (italic) or (bold italic).
4686 If FRAME is omitted or nil, use the selected frame. */)
4688 Lisp_Object face
, frame
;
4692 Lisp_Object result
= Qnil
;
4693 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4695 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4696 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4697 result
= Fcons (Qbold
, result
);
4699 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4700 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4701 result
= Fcons (Qitalic
, result
);
4707 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4708 int face_id
= lookup_named_face (f
, face
, 0);
4709 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4710 return face
? build_string (face
->font_name
) : Qnil
;
4715 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4716 all attributes are `equal'. Tries to be fast because this function
4717 is called quite often. */
4720 lface_equal_p (v1
, v2
)
4721 Lisp_Object
*v1
, *v2
;
4725 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4727 Lisp_Object a
= v1
[i
];
4728 Lisp_Object b
= v2
[i
];
4730 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4731 and the other is specified. */
4732 equal_p
= XTYPE (a
) == XTYPE (b
);
4741 equal_p
= ((STRING_BYTES (XSTRING (a
))
4742 == STRING_BYTES (XSTRING (b
)))
4743 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4744 STRING_BYTES (XSTRING (a
))) == 0);
4753 equal_p
= !NILP (Fequal (a
, b
));
4763 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4764 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4765 doc
: /* True if FACE1 and FACE2 are equal.
4766 If the optional argument FRAME is given, report on face FACE in that frame.
4767 If FRAME is t, report on the defaults for face FACE (for new frames).
4768 If FRAME is omitted or nil, use the selected frame. */)
4769 (face1
, face2
, frame
)
4770 Lisp_Object face1
, face2
, frame
;
4774 Lisp_Object lface1
, lface2
;
4779 /* Don't use check_x_frame here because this function is called
4780 before X frames exist. At that time, if FRAME is nil,
4781 selected_frame will be used which is the frame dumped with
4782 Emacs. That frame is not an X frame. */
4783 f
= frame_or_selected_frame (frame
, 2);
4785 lface1
= lface_from_face_name (NULL
, face1
, 1);
4786 lface2
= lface_from_face_name (NULL
, face2
, 1);
4787 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4788 XVECTOR (lface2
)->contents
);
4789 return equal_p
? Qt
: Qnil
;
4793 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4794 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4795 doc
: /* True if FACE has no attribute specified.
4796 If the optional argument FRAME is given, report on face FACE in that frame.
4797 If FRAME is t, report on the defaults for face FACE (for new frames).
4798 If FRAME is omitted or nil, use the selected frame. */)
4800 Lisp_Object face
, frame
;
4807 frame
= selected_frame
;
4808 CHECK_LIVE_FRAME (frame
);
4812 lface
= lface_from_face_name (NULL
, face
, 1);
4814 lface
= lface_from_face_name (f
, face
, 1);
4816 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4817 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4820 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4824 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4826 doc
: /* Return an alist of frame-local faces defined on FRAME.
4827 For internal use only. */)
4831 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4832 return f
->face_alist
;
4836 /* Return a hash code for Lisp string STRING with case ignored. Used
4837 below in computing a hash value for a Lisp face. */
4839 static INLINE
unsigned
4840 hash_string_case_insensitive (string
)
4845 xassert (STRINGP (string
));
4846 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4847 hash
= (hash
<< 1) ^ tolower (*s
);
4852 /* Return a hash code for face attribute vector V. */
4854 static INLINE
unsigned
4858 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4859 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4860 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4861 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4862 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4863 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4864 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4868 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4869 considering charsets/registries). They do if they specify the same
4870 family, point size, weight, width, slant, and fontset. Both LFACE1
4871 and LFACE2 must be fully-specified. */
4874 lface_same_font_attributes_p (lface1
, lface2
)
4875 Lisp_Object
*lface1
, *lface2
;
4877 xassert (lface_fully_specified_p (lface1
)
4878 && lface_fully_specified_p (lface2
));
4879 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4880 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4881 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4882 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4883 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4884 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4885 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4886 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4887 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4888 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4889 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4890 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4895 /***********************************************************************
4897 ***********************************************************************/
4899 /* Allocate and return a new realized face for Lisp face attribute
4902 static struct face
*
4903 make_realized_face (attr
)
4906 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4907 bzero (face
, sizeof *face
);
4908 face
->ascii_face
= face
;
4909 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4914 /* Free realized face FACE, including its X resources. FACE may
4918 free_realized_face (f
, face
)
4924 #ifdef HAVE_WINDOW_SYSTEM
4925 if (FRAME_WINDOW_P (f
))
4927 /* Free fontset of FACE if it is ASCII face. */
4928 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4929 free_face_fontset (f
, face
);
4932 x_free_gc (f
, face
->gc
);
4936 free_face_colors (f
, face
);
4937 x_destroy_bitmap (f
, face
->stipple
);
4939 #endif /* HAVE_WINDOW_SYSTEM */
4946 /* Prepare face FACE for subsequent display on frame F. This
4947 allocated GCs if they haven't been allocated yet or have been freed
4948 by clearing the face cache. */
4951 prepare_face_for_display (f
, face
)
4955 #ifdef HAVE_WINDOW_SYSTEM
4956 xassert (FRAME_WINDOW_P (f
));
4961 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4963 xgcv
.foreground
= face
->foreground
;
4964 xgcv
.background
= face
->background
;
4965 #ifdef HAVE_X_WINDOWS
4966 xgcv
.graphics_exposures
= False
;
4968 /* The font of FACE may be null if we couldn't load it. */
4971 #ifdef HAVE_X_WINDOWS
4972 xgcv
.font
= face
->font
->fid
;
4975 xgcv
.font
= face
->font
;
4978 xgcv
.font
= face
->font
;
4984 #ifdef HAVE_X_WINDOWS
4987 xgcv
.fill_style
= FillOpaqueStippled
;
4988 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4989 mask
|= GCFillStyle
| GCStipple
;
4992 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4995 #endif /* HAVE_WINDOW_SYSTEM */
4999 /***********************************************************************
5001 ***********************************************************************/
5003 /* Return a new face cache for frame F. */
5005 static struct face_cache
*
5009 struct face_cache
*c
;
5012 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5013 bzero (c
, sizeof *c
);
5014 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5015 c
->buckets
= (struct face
**) xmalloc (size
);
5016 bzero (c
->buckets
, size
);
5018 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5020 c
->menu_face_changed_p
= menu_face_changed_default
;
5025 /* Clear out all graphics contexts for all realized faces, except for
5026 the basic faces. This should be done from time to time just to avoid
5027 keeping too many graphics contexts that are no longer needed. */
5031 struct face_cache
*c
;
5033 if (c
&& FRAME_WINDOW_P (c
->f
))
5035 #ifdef HAVE_WINDOW_SYSTEM
5037 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5039 struct face
*face
= c
->faces_by_id
[i
];
5040 if (face
&& face
->gc
)
5042 x_free_gc (c
->f
, face
->gc
);
5046 #endif /* HAVE_WINDOW_SYSTEM */
5051 /* Free all realized faces in face cache C, including basic faces. C
5052 may be null. If faces are freed, make sure the frame's current
5053 matrix is marked invalid, so that a display caused by an expose
5054 event doesn't try to use faces we destroyed. */
5057 free_realized_faces (c
)
5058 struct face_cache
*c
;
5063 struct frame
*f
= c
->f
;
5065 /* We must block input here because we can't process X events
5066 safely while only some faces are freed, or when the frame's
5067 current matrix still references freed faces. */
5070 for (i
= 0; i
< c
->used
; ++i
)
5072 free_realized_face (f
, c
->faces_by_id
[i
]);
5073 c
->faces_by_id
[i
] = NULL
;
5077 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5078 bzero (c
->buckets
, size
);
5080 /* Must do a thorough redisplay the next time. Mark current
5081 matrices as invalid because they will reference faces freed
5082 above. This function is also called when a frame is
5083 destroyed. In this case, the root window of F is nil. */
5084 if (WINDOWP (f
->root_window
))
5086 clear_current_matrices (f
);
5087 ++windows_or_buffers_changed
;
5095 /* Free all faces realized for multibyte characters on frame F that
5099 free_realized_multibyte_face (f
, fontset
)
5103 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5107 /* We must block input here because we can't process X events safely
5108 while only some faces are freed, or when the frame's current
5109 matrix still references freed faces. */
5112 for (i
= 0; i
< cache
->used
; i
++)
5114 face
= cache
->faces_by_id
[i
];
5116 && face
!= face
->ascii_face
5117 && face
->fontset
== fontset
)
5119 uncache_face (cache
, face
);
5120 free_realized_face (f
, face
);
5124 /* Must do a thorough redisplay the next time. Mark current
5125 matrices as invalid because they will reference faces freed
5126 above. This function is also called when a frame is destroyed.
5127 In this case, the root window of F is nil. */
5128 if (WINDOWP (f
->root_window
))
5130 clear_current_matrices (f
);
5131 ++windows_or_buffers_changed
;
5138 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5139 This is done after attributes of a named face have been changed,
5140 because we can't tell which realized faces depend on that face. */
5143 free_all_realized_faces (frame
)
5149 FOR_EACH_FRAME (rest
, frame
)
5150 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5153 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5157 /* Free face cache C and faces in it, including their X resources. */
5161 struct face_cache
*c
;
5165 free_realized_faces (c
);
5167 xfree (c
->faces_by_id
);
5173 /* Cache realized face FACE in face cache C. HASH is the hash value
5174 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5175 collision list of the face hash table of C. This is done because
5176 otherwise lookup_face would find FACE for every character, even if
5177 faces with the same attributes but for specific characters exist. */
5180 cache_face (c
, face
, hash
)
5181 struct face_cache
*c
;
5185 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5189 if (face
->fontset
>= 0)
5191 struct face
*last
= c
->buckets
[i
];
5202 c
->buckets
[i
] = face
;
5203 face
->prev
= face
->next
= NULL
;
5209 face
->next
= c
->buckets
[i
];
5211 face
->next
->prev
= face
;
5212 c
->buckets
[i
] = face
;
5215 /* Find a free slot in C->faces_by_id and use the index of the free
5216 slot as FACE->id. */
5217 for (i
= 0; i
< c
->used
; ++i
)
5218 if (c
->faces_by_id
[i
] == NULL
)
5222 /* Maybe enlarge C->faces_by_id. */
5223 if (i
== c
->used
&& c
->used
== c
->size
)
5225 int new_size
= 2 * c
->size
;
5226 int sz
= new_size
* sizeof *c
->faces_by_id
;
5227 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5232 /* Check that FACE got a unique id. */
5237 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5238 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5244 #endif /* GLYPH_DEBUG */
5246 c
->faces_by_id
[i
] = face
;
5252 /* Remove face FACE from cache C. */
5255 uncache_face (c
, face
)
5256 struct face_cache
*c
;
5259 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5262 face
->prev
->next
= face
->next
;
5264 c
->buckets
[i
] = face
->next
;
5267 face
->next
->prev
= face
->prev
;
5269 c
->faces_by_id
[face
->id
] = NULL
;
5270 if (face
->id
== c
->used
)
5275 /* Look up a realized face with face attributes ATTR in the face cache
5276 of frame F. The face will be used to display character C. Value
5277 is the ID of the face found. If no suitable face is found, realize
5278 a new one. In that case, if C is a multibyte character, BASE_FACE
5279 is a face that has the same attributes. */
5282 lookup_face (f
, attr
, c
, base_face
)
5286 struct face
*base_face
;
5288 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5293 xassert (cache
!= NULL
);
5294 check_lface_attrs (attr
);
5296 /* Look up ATTR in the face cache. */
5297 hash
= lface_hash (attr
);
5298 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5300 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5301 if (face
->hash
== hash
5302 && (!FRAME_WINDOW_P (f
)
5303 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5304 && lface_equal_p (face
->lface
, attr
))
5307 /* If not found, realize a new face. */
5309 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5312 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5314 /* When this function is called from face_for_char (in this case, C is
5315 a multibyte character), a fontset of a face returned by
5316 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5317 C) is not sutisfied. The fontset is set for this face by
5318 face_for_char later. */
5320 if (FRAME_WINDOW_P (f
))
5321 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5323 #endif /* GLYPH_DEBUG */
5329 /* Return the face id of the realized face for named face SYMBOL on
5330 frame F suitable for displaying character C. Value is -1 if the
5331 face couldn't be determined, which might happen if the default face
5332 isn't realized and cannot be realized. */
5335 lookup_named_face (f
, symbol
, c
)
5340 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5341 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5342 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5344 if (default_face
== NULL
)
5346 if (!realize_basic_faces (f
))
5348 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5351 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5352 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5353 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5354 return lookup_face (f
, attrs
, c
, NULL
);
5358 /* Return the ID of the realized ASCII face of Lisp face with ID
5359 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5362 ascii_face_of_lisp_face (f
, lface_id
)
5368 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5370 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5371 face_id
= lookup_named_face (f
, face_name
, 0);
5380 /* Return a face for charset ASCII that is like the face with id
5381 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5382 STEPS < 0 means larger. Value is the id of the face. */
5385 smaller_face (f
, face_id
, steps
)
5389 #ifdef HAVE_WINDOW_SYSTEM
5391 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5392 int pt
, last_pt
, last_height
;
5395 struct face
*new_face
;
5397 /* If not called for an X frame, just return the original face. */
5398 if (FRAME_TERMCAP_P (f
))
5401 /* Try in increments of 1/2 pt. */
5402 delta
= steps
< 0 ? 5 : -5;
5403 steps
= abs (steps
);
5405 face
= FACE_FROM_ID (f
, face_id
);
5406 bcopy (face
->lface
, attrs
, sizeof attrs
);
5407 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5408 new_face_id
= face_id
;
5409 last_height
= FONT_HEIGHT (face
->font
);
5413 /* Give up if we cannot find a font within 10pt. */
5414 && abs (last_pt
- pt
) < 100)
5416 /* Look up a face for a slightly smaller/larger font. */
5418 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5419 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5420 new_face
= FACE_FROM_ID (f
, new_face_id
);
5422 /* If height changes, count that as one step. */
5423 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5424 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5427 last_height
= FONT_HEIGHT (new_face
->font
);
5434 #else /* not HAVE_WINDOW_SYSTEM */
5438 #endif /* not HAVE_WINDOW_SYSTEM */
5442 /* Return a face for charset ASCII that is like the face with id
5443 FACE_ID on frame F, but has height HEIGHT. */
5446 face_with_height (f
, face_id
, height
)
5451 #ifdef HAVE_WINDOW_SYSTEM
5453 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5455 if (FRAME_TERMCAP_P (f
)
5459 face
= FACE_FROM_ID (f
, face_id
);
5460 bcopy (face
->lface
, attrs
, sizeof attrs
);
5461 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5462 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5463 #endif /* HAVE_WINDOW_SYSTEM */
5469 /* Return the face id of the realized face for named face SYMBOL on
5470 frame F suitable for displaying character C, and use attributes of
5471 the face FACE_ID for attributes that aren't completely specified by
5472 SYMBOL. This is like lookup_named_face, except that the default
5473 attributes come from FACE_ID, not from the default face. FACE_ID
5474 is assumed to be already realized. */
5477 lookup_derived_face (f
, symbol
, c
, face_id
)
5483 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5484 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5485 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5490 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5491 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5492 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5493 return lookup_face (f
, attrs
, c
, default_face
);
5496 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5497 Sface_attributes_as_vector
, 1, 1, 0,
5498 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5503 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5505 merge_face_vector_with_property (XFRAME (selected_frame
),
5506 XVECTOR (lface
)->contents
,
5513 /***********************************************************************
5515 ***********************************************************************/
5517 DEFUN ("internal-set-font-selection-order",
5518 Finternal_set_font_selection_order
,
5519 Sinternal_set_font_selection_order
, 1, 1, 0,
5520 doc
: /* Set font selection order for face font selection to ORDER.
5521 ORDER must be a list of length 4 containing the symbols `:width',
5522 `:height', `:weight', and `:slant'. Face attributes appearing
5523 first in ORDER are matched first, e.g. if `:height' appears before
5524 `:weight' in ORDER, font selection first tries to find a font with
5525 a suitable height, and then tries to match the font weight.
5532 int indices
[DIM (font_sort_order
)];
5535 bzero (indices
, sizeof indices
);
5539 CONSP (list
) && i
< DIM (indices
);
5540 list
= XCDR (list
), ++i
)
5542 Lisp_Object attr
= XCAR (list
);
5545 if (EQ (attr
, QCwidth
))
5547 else if (EQ (attr
, QCheight
))
5548 xlfd
= XLFD_POINT_SIZE
;
5549 else if (EQ (attr
, QCweight
))
5551 else if (EQ (attr
, QCslant
))
5556 if (indices
[i
] != 0)
5561 if (!NILP (list
) || i
!= DIM (indices
))
5562 signal_error ("Invalid font sort order", order
);
5563 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5564 if (indices
[i
] == 0)
5565 signal_error ("Invalid font sort order", order
);
5567 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5569 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5570 free_all_realized_faces (Qnil
);
5577 DEFUN ("internal-set-alternative-font-family-alist",
5578 Finternal_set_alternative_font_family_alist
,
5579 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5580 doc
: /* Define alternative font families to try in face font selection.
5581 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5582 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5583 be found. Value is ALIST. */)
5588 Vface_alternative_font_family_alist
= alist
;
5589 free_all_realized_faces (Qnil
);
5594 DEFUN ("internal-set-alternative-font-registry-alist",
5595 Finternal_set_alternative_font_registry_alist
,
5596 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5597 doc
: /* Define alternative font registries to try in face font selection.
5598 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5599 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5600 be found. Value is ALIST. */)
5605 Vface_alternative_font_registry_alist
= alist
;
5606 free_all_realized_faces (Qnil
);
5611 #ifdef HAVE_WINDOW_SYSTEM
5613 /* Value is non-zero if FONT is the name of a scalable font. The
5614 X11R6 XLFD spec says that point size, pixel size, and average width
5615 are zero for scalable fonts. Intlfonts contain at least one
5616 scalable font ("*-muleindian-1") for which this isn't true, so we
5617 just test average width. */
5620 font_scalable_p (font
)
5621 struct font_name
*font
;
5623 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5624 return (*s
== '0' && *(s
+ 1) == '\0')
5626 /* Windows implementation of XLFD is slightly broken for backward
5627 compatibility with previous broken versions, so test for
5628 wildcards as well as 0. */
5635 /* Ignore the difference of font point size less than this value. */
5637 #define FONT_POINT_SIZE_QUANTUM 5
5639 /* Value is non-zero if FONT1 is a better match for font attributes
5640 VALUES than FONT2. VALUES is an array of face attribute values in
5641 font sort order. COMPARE_PT_P zero means don't compare point
5642 sizes. AVGWIDTH, if not zero, is a specified font average width
5646 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5648 struct font_name
*font1
, *font2
;
5649 int compare_pt_p
, avgwidth
;
5653 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5655 int xlfd_idx
= font_sort_order
[i
];
5657 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5659 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5660 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5662 if (xlfd_idx
== XLFD_POINT_SIZE
5663 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5665 if (delta1
> delta2
)
5667 else if (delta1
< delta2
)
5671 /* The difference may be equal because, e.g., the face
5672 specifies `italic' but we have only `regular' and
5673 `oblique'. Prefer `oblique' in this case. */
5674 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5675 && font1
->numeric
[xlfd_idx
] > values
[i
]
5676 && font2
->numeric
[xlfd_idx
] < values
[i
])
5684 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5685 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5686 if (delta1
> delta2
)
5688 else if (delta1
< delta2
)
5692 return font1
->registry_priority
< font2
->registry_priority
;
5696 /* Value is non-zero if FONT is an exact match for face attributes in
5697 SPECIFIED. SPECIFIED is an array of face attribute values in font
5698 sort order. AVGWIDTH, if non-zero, is an average width to compare
5702 exact_face_match_p (specified
, font
, avgwidth
)
5704 struct font_name
*font
;
5709 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5710 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5713 return (i
== DIM (font_sort_order
)
5715 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5719 /* Value is the name of a scaled font, generated from scalable font
5720 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5721 Value is allocated from heap. */
5724 build_scalable_font_name (f
, font
, specified_pt
)
5726 struct font_name
*font
;
5729 char point_size
[20], pixel_size
[20];
5731 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5734 /* If scalable font is for a specific resolution, compute
5735 the point size we must specify from the resolution of
5736 the display and the specified resolution of the font. */
5737 if (font
->numeric
[XLFD_RESY
] != 0)
5739 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5740 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5745 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5748 /* Set point size of the font. */
5749 sprintf (point_size
, "%d", (int) pt
);
5750 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5751 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5753 /* Set pixel size. */
5754 sprintf (pixel_size
, "%d", pixel_value
);
5755 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5756 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5758 /* If font doesn't specify its resolution, use the
5759 resolution of the display. */
5760 if (font
->numeric
[XLFD_RESY
] == 0)
5763 sprintf (buffer
, "%d", (int) resy
);
5764 font
->fields
[XLFD_RESY
] = buffer
;
5765 font
->numeric
[XLFD_RESY
] = resy
;
5768 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5771 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5772 sprintf (buffer
, "%d", resx
);
5773 font
->fields
[XLFD_RESX
] = buffer
;
5774 font
->numeric
[XLFD_RESX
] = resx
;
5777 return build_font_name (font
);
5781 /* Value is non-zero if we are allowed to use scalable font FONT. We
5782 can't run a Lisp function here since this function may be called
5783 with input blocked. */
5786 may_use_scalable_font_p (font
)
5789 if (EQ (Vscalable_fonts_allowed
, Qt
))
5791 else if (CONSP (Vscalable_fonts_allowed
))
5793 Lisp_Object tail
, regexp
;
5795 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5797 regexp
= XCAR (tail
);
5798 if (STRINGP (regexp
)
5799 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5809 /* Return the name of the best matching font for face attributes ATTRS
5810 in the array of font_name structures FONTS which contains NFONTS
5811 elements. WIDTH_RATIO is a factor with which to multiply average
5812 widths if ATTRS specifies such a width.
5814 Value is a font name which is allocated from the heap. FONTS is
5815 freed by this function. */
5818 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5821 struct font_name
*fonts
;
5826 struct font_name
*best
;
5829 int exact_p
, avgwidth
;
5834 /* Make specified font attributes available in `specified',
5835 indexed by sort order. */
5836 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5838 int xlfd_idx
= font_sort_order
[i
];
5840 if (xlfd_idx
== XLFD_SWIDTH
)
5841 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5842 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5843 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5844 else if (xlfd_idx
== XLFD_WEIGHT
)
5845 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5846 else if (xlfd_idx
== XLFD_SLANT
)
5847 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5852 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5854 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5858 /* Start with the first non-scalable font in the list. */
5859 for (i
= 0; i
< nfonts
; ++i
)
5860 if (!font_scalable_p (fonts
+ i
))
5863 /* Find the best match among the non-scalable fonts. */
5868 for (i
= 1; i
< nfonts
; ++i
)
5869 if (!font_scalable_p (fonts
+ i
)
5870 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5874 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5883 /* Unless we found an exact match among non-scalable fonts, see if
5884 we can find a better match among scalable fonts. */
5887 /* A scalable font is better if
5889 1. its weight, slant, swidth attributes are better, or.
5891 2. the best non-scalable font doesn't have the required
5892 point size, and the scalable fonts weight, slant, swidth
5895 int non_scalable_has_exact_height_p
;
5897 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5898 non_scalable_has_exact_height_p
= 1;
5900 non_scalable_has_exact_height_p
= 0;
5902 for (i
= 0; i
< nfonts
; ++i
)
5903 if (font_scalable_p (fonts
+ i
))
5906 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5907 || (!non_scalable_has_exact_height_p
5908 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5913 if (font_scalable_p (best
))
5914 font_name
= build_scalable_font_name (f
, best
, pt
);
5916 font_name
= build_font_name (best
);
5918 /* Free font_name structures. */
5919 free_font_names (fonts
, nfonts
);
5925 /* Get a list of matching fonts on frame F, considering FAMILY
5926 and alternative font families from Vface_alternative_font_registry_alist.
5928 FAMILY is the font family whose alternatives are considered.
5930 REGISTRY, if a string, specifies a font registry and encoding to
5931 match. A value of nil means include fonts of any registry and
5934 Return in *FONTS a pointer to a vector of font_name structures for
5935 the fonts matched. Value is the number of fonts found. */
5938 try_alternative_families (f
, family
, registry
, fonts
)
5940 Lisp_Object family
, registry
;
5941 struct font_name
**fonts
;
5946 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5949 /* Try alternative font families. */
5950 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5953 for (alter
= XCDR (alter
);
5954 CONSP (alter
) && nfonts
== 0;
5955 alter
= XCDR (alter
))
5957 if (STRINGP (XCAR (alter
)))
5958 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5962 /* Try scalable fonts before giving up. */
5963 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5965 int count
= BINDING_STACK_SIZE ();
5966 specbind (Qscalable_fonts_allowed
, Qt
);
5967 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5968 unbind_to (count
, Qnil
);
5975 /* Get a list of matching fonts on frame F.
5977 FAMILY, if a string, specifies a font family derived from the fontset.
5978 It is only used if the face does not specify any family in ATTRS or
5979 if we cannot find any font of the face's family.
5981 REGISTRY, if a string, specifies a font registry and encoding to
5982 match. A value of nil means include fonts of any registry and
5985 Return in *FONTS a pointer to a vector of font_name structures for
5986 the fonts matched. Value is the number of fonts found. */
5989 try_font_list (f
, attrs
, family
, registry
, fonts
)
5992 Lisp_Object family
, registry
;
5993 struct font_name
**fonts
;
5996 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
5998 if (STRINGP (face_family
))
5999 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
6001 if (nfonts
== 0 && !NILP (family
))
6002 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6004 /* Try font family of the default face or "fixed". */
6007 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6009 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6011 family
= build_string ("fixed");
6012 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6015 /* Try any family with the given registry. */
6017 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6023 /* Return the fontset id of the base fontset name or alias name given
6024 by the fontset attribute of ATTRS. Value is -1 if the fontset
6025 attribute of ATTRS doesn't name a fontset. */
6028 face_fontset (attrs
)
6033 name
= attrs
[LFACE_FONT_INDEX
];
6034 if (!STRINGP (name
))
6036 return fs_query_fontset (name
, 0);
6040 /* Choose a name of font to use on frame F to display character C with
6041 Lisp face attributes specified by ATTRS. The font name is
6042 determined by the font-related attributes in ATTRS and the name
6043 pattern for C in FONTSET. Value is the font name which is
6044 allocated from the heap and must be freed by the caller, or NULL if
6045 we can get no information about the font name of C. It is assured
6046 that we always get some information for a single byte
6050 choose_face_font (f
, attrs
, fontset
, c
)
6055 Lisp_Object pattern
;
6056 char *font_name
= NULL
;
6057 struct font_name
*fonts
;
6058 int nfonts
, width_ratio
;
6060 /* Get (foundry and) family name and registry (and encoding) name of
6062 pattern
= fontset_font_pattern (f
, fontset
, c
);
6065 xassert (!SINGLE_BYTE_CHAR_P (c
));
6069 /* If what we got is a name pattern, return it. */
6070 if (STRINGP (pattern
))
6071 return xstrdup (XSTRING (pattern
)->data
);
6073 /* Get a list of fonts matching that pattern and choose the
6074 best match for the specified face attributes from it. */
6075 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6076 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6078 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6079 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6083 #endif /* HAVE_WINDOW_SYSTEM */
6087 /***********************************************************************
6089 ***********************************************************************/
6091 /* Realize basic faces on frame F. Value is zero if frame parameters
6092 of F don't contain enough information needed to realize the default
6096 realize_basic_faces (f
)
6100 int count
= BINDING_STACK_SIZE ();
6102 /* Block input here so that we won't be surprised by an X expose
6103 event, for instance, without having the faces set up. */
6105 specbind (Qscalable_fonts_allowed
, Qt
);
6107 if (realize_default_face (f
))
6109 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6110 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6111 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6112 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6113 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6114 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6115 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6116 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6117 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6118 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6120 /* Reflect changes in the `menu' face in menu bars. */
6121 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6123 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6124 #ifdef USE_X_TOOLKIT
6125 x_update_menu_appearance (f
);
6132 unbind_to (count
, Qnil
);
6138 /* Realize the default face on frame F. If the face is not fully
6139 specified, make it fully-specified. Attributes of the default face
6140 that are not explicitly specified are taken from frame parameters. */
6143 realize_default_face (f
)
6146 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6148 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6149 Lisp_Object frame_font
;
6152 /* If the `default' face is not yet known, create it. */
6153 lface
= lface_from_face_name (f
, Qdefault
, 0);
6157 XSETFRAME (frame
, f
);
6158 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6161 #ifdef HAVE_WINDOW_SYSTEM
6162 if (FRAME_WINDOW_P (f
))
6164 /* Set frame_font to the value of the `font' frame parameter. */
6165 frame_font
= Fassq (Qfont
, f
->param_alist
);
6166 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6167 frame_font
= XCDR (frame_font
);
6168 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6170 #endif /* HAVE_WINDOW_SYSTEM */
6172 if (!FRAME_WINDOW_P (f
))
6174 LFACE_FAMILY (lface
) = build_string ("default");
6175 LFACE_SWIDTH (lface
) = Qnormal
;
6176 LFACE_HEIGHT (lface
) = make_number (1);
6177 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6178 LFACE_WEIGHT (lface
) = Qnormal
;
6179 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6180 LFACE_SLANT (lface
) = Qnormal
;
6181 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6184 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6185 LFACE_UNDERLINE (lface
) = Qnil
;
6187 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6188 LFACE_OVERLINE (lface
) = Qnil
;
6190 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6191 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6193 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6194 LFACE_BOX (lface
) = Qnil
;
6196 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6197 LFACE_INVERSE (lface
) = Qnil
;
6199 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6201 /* This function is called so early that colors are not yet
6202 set in the frame parameter list. */
6203 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6205 if (CONSP (color
) && STRINGP (XCDR (color
)))
6206 LFACE_FOREGROUND (lface
) = XCDR (color
);
6207 else if (FRAME_WINDOW_P (f
))
6209 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6210 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6215 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6217 /* This function is called so early that colors are not yet
6218 set in the frame parameter list. */
6219 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6220 if (CONSP (color
) && STRINGP (XCDR (color
)))
6221 LFACE_BACKGROUND (lface
) = XCDR (color
);
6222 else if (FRAME_WINDOW_P (f
))
6224 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6225 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6230 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6231 LFACE_STIPPLE (lface
) = Qnil
;
6233 /* Realize the face; it must be fully-specified now. */
6234 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6235 check_lface (lface
);
6236 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6237 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6242 /* Realize basic faces other than the default face in face cache C.
6243 SYMBOL is the face name, ID is the face id the realized face must
6244 have. The default face must have been realized already. */
6247 realize_named_face (f
, symbol
, id
)
6252 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6253 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6254 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6255 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6256 struct face
*new_face
;
6258 /* The default face must exist and be fully specified. */
6259 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6260 check_lface_attrs (attrs
);
6261 xassert (lface_fully_specified_p (attrs
));
6263 /* If SYMBOL isn't know as a face, create it. */
6267 XSETFRAME (frame
, f
);
6268 lface
= Finternal_make_lisp_face (symbol
, frame
);
6271 /* Merge SYMBOL's face with the default face. */
6272 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6273 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6275 /* Realize the face. */
6276 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6280 /* Realize the fully-specified face with attributes ATTRS in face
6281 cache CACHE for character C. If C is a multibyte character,
6282 BASE_FACE is a face that has the same attributes. Otherwise,
6283 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6284 ID of face to remove before caching the new face. Value is a
6285 pointer to the newly created realized face. */
6287 static struct face
*
6288 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6289 struct face_cache
*cache
;
6292 struct face
*base_face
;
6297 /* LFACE must be fully specified. */
6298 xassert (cache
!= NULL
);
6299 check_lface_attrs (attrs
);
6301 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6303 /* Remove the former face. */
6304 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6305 uncache_face (cache
, former_face
);
6306 free_realized_face (cache
->f
, former_face
);
6309 if (FRAME_WINDOW_P (cache
->f
))
6310 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6311 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6312 face
= realize_tty_face (cache
, attrs
, c
);
6316 /* Insert the new face. */
6317 cache_face (cache
, face
, lface_hash (attrs
));
6318 #ifdef HAVE_WINDOW_SYSTEM
6319 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6320 load_face_font (cache
->f
, face
, c
);
6321 #endif /* HAVE_WINDOW_SYSTEM */
6326 /* Realize the fully-specified face with attributes ATTRS in face
6327 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6328 a multibyte character, BASE_FACE is a face that has the same
6329 attributes. Otherwise, BASE_FACE is ignored. If the new face
6330 doesn't share font with the default face, a fontname is allocated
6331 from the heap and set in `font_name' of the new face, but it is not
6332 yet loaded here. Value is a pointer to the newly created realized
6335 static struct face
*
6336 realize_x_face (cache
, attrs
, c
, base_face
)
6337 struct face_cache
*cache
;
6340 struct face
*base_face
;
6342 #ifdef HAVE_WINDOW_SYSTEM
6343 struct face
*face
, *default_face
;
6345 Lisp_Object stipple
, overline
, strike_through
, box
;
6347 xassert (FRAME_WINDOW_P (cache
->f
));
6348 xassert (SINGLE_BYTE_CHAR_P (c
)
6351 /* Allocate a new realized face. */
6352 face
= make_realized_face (attrs
);
6356 /* If C is a multibyte character, we share all face attirbutes with
6357 BASE_FACE including the realized fontset. But, we must load a
6359 if (!SINGLE_BYTE_CHAR_P (c
))
6361 bcopy (base_face
, face
, sizeof *face
);
6364 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6365 face
->colors_copied_bitwise_p
= 1;
6367 /* to force realize_face to load font */
6372 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6374 /* Determine the font to use. Most of the time, the font will be
6375 the same as the font of the default face, so try that first. */
6376 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6378 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6379 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6381 face
->font
= default_face
->font
;
6382 face
->fontset
= default_face
->fontset
;
6383 face
->font_info_id
= default_face
->font_info_id
;
6384 face
->font_name
= default_face
->font_name
;
6385 face
->ascii_face
= face
;
6387 /* But, as we can't share the fontset, make a new realized
6388 fontset that has the same base fontset as of the default
6391 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6395 /* If the face attribute ATTRS specifies a fontset, use it as
6396 the base of a new realized fontset. Otherwise, use the same
6397 base fontset as of the default face. The base determines
6398 registry and encoding of a font. It may also determine
6399 foundry and family. The other fields of font name pattern
6400 are constructed from ATTRS. */
6401 int fontset
= face_fontset (attrs
);
6403 if ((fontset
== -1) && default_face
)
6404 fontset
= default_face
->fontset
;
6405 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6406 face
->font
= NULL
; /* to force realize_face to load font */
6409 /* Load the font if it is specified in ATTRS. This fixes
6410 changing frame font on the Mac. */
6411 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6413 struct font_info
*font_info
=
6414 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6416 face
->font
= font_info
->font
;
6421 /* Load colors, and set remaining attributes. */
6423 load_face_colors (f
, face
, attrs
);
6426 box
= attrs
[LFACE_BOX_INDEX
];
6429 /* A simple box of line width 1 drawn in color given by
6431 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6433 face
->box
= FACE_SIMPLE_BOX
;
6434 face
->box_line_width
= 1;
6436 else if (INTEGERP (box
))
6438 /* Simple box of specified line width in foreground color of the
6440 xassert (XINT (box
) != 0);
6441 face
->box
= FACE_SIMPLE_BOX
;
6442 face
->box_line_width
= XINT (box
);
6443 face
->box_color
= face
->foreground
;
6444 face
->box_color_defaulted_p
= 1;
6446 else if (CONSP (box
))
6448 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6449 being one of `raised' or `sunken'. */
6450 face
->box
= FACE_SIMPLE_BOX
;
6451 face
->box_color
= face
->foreground
;
6452 face
->box_color_defaulted_p
= 1;
6453 face
->box_line_width
= 1;
6457 Lisp_Object keyword
, value
;
6459 keyword
= XCAR (box
);
6467 if (EQ (keyword
, QCline_width
))
6469 if (INTEGERP (value
) && XINT (value
) != 0)
6470 face
->box_line_width
= XINT (value
);
6472 else if (EQ (keyword
, QCcolor
))
6474 if (STRINGP (value
))
6476 face
->box_color
= load_color (f
, face
, value
,
6478 face
->use_box_color_for_shadows_p
= 1;
6481 else if (EQ (keyword
, QCstyle
))
6483 if (EQ (value
, Qreleased_button
))
6484 face
->box
= FACE_RAISED_BOX
;
6485 else if (EQ (value
, Qpressed_button
))
6486 face
->box
= FACE_SUNKEN_BOX
;
6491 /* Text underline, overline, strike-through. */
6493 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6495 /* Use default color (same as foreground color). */
6496 face
->underline_p
= 1;
6497 face
->underline_defaulted_p
= 1;
6498 face
->underline_color
= 0;
6500 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6502 /* Use specified color. */
6503 face
->underline_p
= 1;
6504 face
->underline_defaulted_p
= 0;
6505 face
->underline_color
6506 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6507 LFACE_UNDERLINE_INDEX
);
6509 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6511 face
->underline_p
= 0;
6512 face
->underline_defaulted_p
= 0;
6513 face
->underline_color
= 0;
6516 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6517 if (STRINGP (overline
))
6519 face
->overline_color
6520 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6521 LFACE_OVERLINE_INDEX
);
6522 face
->overline_p
= 1;
6524 else if (EQ (overline
, Qt
))
6526 face
->overline_color
= face
->foreground
;
6527 face
->overline_color_defaulted_p
= 1;
6528 face
->overline_p
= 1;
6531 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6532 if (STRINGP (strike_through
))
6534 face
->strike_through_color
6535 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6536 LFACE_STRIKE_THROUGH_INDEX
);
6537 face
->strike_through_p
= 1;
6539 else if (EQ (strike_through
, Qt
))
6541 face
->strike_through_color
= face
->foreground
;
6542 face
->strike_through_color_defaulted_p
= 1;
6543 face
->strike_through_p
= 1;
6546 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6547 if (!NILP (stipple
))
6548 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6550 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6552 #endif /* HAVE_WINDOW_SYSTEM */
6556 /* Map a specified color of face FACE on frame F to a tty color index.
6557 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6558 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6559 default foreground/background colors. */
6562 map_tty_color (f
, face
, idx
, defaulted
)
6565 enum lface_attribute_index idx
;
6568 Lisp_Object frame
, color
, def
;
6569 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6570 unsigned long default_pixel
, default_other_pixel
, pixel
;
6572 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6576 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6577 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6581 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6582 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6585 XSETFRAME (frame
, f
);
6586 color
= face
->lface
[idx
];
6589 && XSTRING (color
)->size
6590 && CONSP (Vtty_defined_color_alist
)
6591 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6594 /* Associations in tty-defined-color-alist are of the form
6595 (NAME INDEX R G B). We need the INDEX part. */
6596 pixel
= XINT (XCAR (XCDR (def
)));
6599 if (pixel
== default_pixel
&& STRINGP (color
))
6601 pixel
= load_color (f
, face
, color
, idx
);
6603 #if defined (MSDOS) || defined (WINDOWSNT)
6604 /* If the foreground of the default face is the default color,
6605 use the foreground color defined by the frame. */
6607 if (FRAME_MSDOS_P (f
))
6610 if (pixel
== default_pixel
6611 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6614 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6616 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6617 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6620 else if (pixel
== default_other_pixel
)
6623 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6625 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6626 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6632 #endif /* MSDOS or WINDOWSNT */
6636 face
->foreground
= pixel
;
6638 face
->background
= pixel
;
6642 /* Realize the fully-specified face with attributes ATTRS in face
6643 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6644 pointer to the newly created realized face. */
6646 static struct face
*
6647 realize_tty_face (cache
, attrs
, c
)
6648 struct face_cache
*cache
;
6654 int face_colors_defaulted
= 0;
6655 struct frame
*f
= cache
->f
;
6657 /* Frame must be a termcap frame. */
6658 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6660 /* Allocate a new realized face. */
6661 face
= make_realized_face (attrs
);
6662 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6664 /* Map face attributes to TTY appearances. We map slant to
6665 dimmed text because we want italic text to appear differently
6666 and because dimmed text is probably used infrequently. */
6667 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6668 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6670 if (weight
> XLFD_WEIGHT_MEDIUM
)
6671 face
->tty_bold_p
= 1;
6672 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6673 face
->tty_dim_p
= 1;
6674 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6675 face
->tty_underline_p
= 1;
6676 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6677 face
->tty_reverse_p
= 1;
6679 /* Map color names to color indices. */
6680 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6681 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6683 /* Swap colors if face is inverse-video. If the colors are taken
6684 from the frame colors, they are already inverted, since the
6685 frame-creation function calls x-handle-reverse-video. */
6686 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6688 unsigned long tem
= face
->foreground
;
6689 face
->foreground
= face
->background
;
6690 face
->background
= tem
;
6693 if (tty_suppress_bold_inverse_default_colors_p
6695 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6696 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6697 face
->tty_bold_p
= 0;
6703 DEFUN ("tty-suppress-bold-inverse-default-colors",
6704 Ftty_suppress_bold_inverse_default_colors
,
6705 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6706 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6707 SUPPRESS non-nil means suppress it.
6708 This affects bold faces on TTYs whose foreground is the default background
6709 color of the display and whose background is the default foreground color.
6710 For such faces, the bold face attribute is ignored if this variable
6713 Lisp_Object suppress
;
6715 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6716 ++face_change_count
;
6722 /***********************************************************************
6724 ***********************************************************************/
6726 /* Return the ID of the face to use to display character CH with face
6727 property PROP on frame F in current_buffer. */
6730 compute_char_face (f
, ch
, prop
)
6737 if (NILP (current_buffer
->enable_multibyte_characters
))
6742 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6743 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6747 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6748 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6749 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6750 merge_face_vector_with_property (f
, attrs
, prop
);
6751 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6757 /* Return the face ID associated with buffer position POS for
6758 displaying ASCII characters. Return in *ENDPTR the position at
6759 which a different face is needed, as far as text properties and
6760 overlays are concerned. W is a window displaying current_buffer.
6762 REGION_BEG, REGION_END delimit the region, so it can be
6765 LIMIT is a position not to scan beyond. That is to limit the time
6766 this function can take.
6768 If MOUSE is non-zero, use the character's mouse-face, not its face.
6770 The face returned is suitable for displaying ASCII characters. */
6773 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6774 endptr
, limit
, mouse
)
6777 int region_beg
, region_end
;
6782 struct frame
*f
= XFRAME (w
->frame
);
6783 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6784 Lisp_Object prop
, position
;
6786 Lisp_Object
*overlay_vec
;
6789 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6790 Lisp_Object limit1
, end
;
6791 struct face
*default_face
;
6793 /* W must display the current buffer. We could write this function
6794 to use the frame and buffer of W, but right now it doesn't. */
6795 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6797 XSETFRAME (frame
, f
);
6798 XSETFASTINT (position
, pos
);
6801 if (pos
< region_beg
&& region_beg
< endpos
)
6802 endpos
= region_beg
;
6804 /* Get the `face' or `mouse_face' text property at POS, and
6805 determine the next position at which the property changes. */
6806 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6807 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6808 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6810 endpos
= XINT (end
);
6812 /* Look at properties from overlays. */
6817 /* First try with room for 40 overlays. */
6819 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6820 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6821 &next_overlay
, NULL
, 0);
6823 /* If there are more than 40, make enough space for all, and try
6825 if (noverlays
> len
)
6828 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6829 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6830 &next_overlay
, NULL
, 0);
6833 if (next_overlay
< endpos
)
6834 endpos
= next_overlay
;
6839 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6841 /* Optimize common cases where we can use the default face. */
6844 && !(pos
>= region_beg
&& pos
< region_end
))
6845 return DEFAULT_FACE_ID
;
6847 /* Begin with attributes from the default face. */
6848 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6850 /* Merge in attributes specified via text properties. */
6852 merge_face_vector_with_property (f
, attrs
, prop
);
6854 /* Now merge the overlay data. */
6855 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6856 for (i
= 0; i
< noverlays
; i
++)
6861 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6863 merge_face_vector_with_property (f
, attrs
, prop
);
6865 oend
= OVERLAY_END (overlay_vec
[i
]);
6866 oendpos
= OVERLAY_POSITION (oend
);
6867 if (oendpos
< endpos
)
6871 /* If in the region, merge in the region face. */
6872 if (pos
>= region_beg
&& pos
< region_end
)
6874 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6875 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6877 if (region_end
< endpos
)
6878 endpos
= region_end
;
6883 /* Look up a realized face with the given face attributes,
6884 or realize a new one for ASCII characters. */
6885 return lookup_face (f
, attrs
, 0, NULL
);
6889 /* Compute the face at character position POS in Lisp string STRING on
6890 window W, for ASCII characters.
6892 If STRING is an overlay string, it comes from position BUFPOS in
6893 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6894 not an overlay string. W must display the current buffer.
6895 REGION_BEG and REGION_END give the start and end positions of the
6896 region; both are -1 if no region is visible.
6898 BASE_FACE_ID is the id of a face to merge with. For strings coming
6899 from overlays or the `display' property it is the face at BUFPOS.
6901 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6903 Set *ENDPTR to the next position where to check for faces in
6904 STRING; -1 if the face is constant from POS to the end of the
6907 Value is the id of the face to use. The face returned is suitable
6908 for displaying ASCII characters. */
6911 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6912 region_end
, endptr
, base_face_id
, mouse_p
)
6916 int region_beg
, region_end
;
6918 enum face_id base_face_id
;
6921 Lisp_Object prop
, position
, end
, limit
;
6922 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6923 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6924 struct face
*base_face
;
6925 int multibyte_p
= STRING_MULTIBYTE (string
);
6926 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6928 /* Get the value of the face property at the current position within
6929 STRING. Value is nil if there is no face property. */
6930 XSETFASTINT (position
, pos
);
6931 prop
= Fget_text_property (position
, prop_name
, string
);
6933 /* Get the next position at which to check for faces. Value of end
6934 is nil if face is constant all the way to the end of the string.
6935 Otherwise it is a string position where to check faces next.
6936 Limit is the maximum position up to which to check for property
6937 changes in Fnext_single_property_change. Strings are usually
6938 short, so set the limit to the end of the string. */
6939 XSETFASTINT (limit
, XSTRING (string
)->size
);
6940 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6942 *endptr
= XFASTINT (end
);
6946 base_face
= FACE_FROM_ID (f
, base_face_id
);
6947 xassert (base_face
);
6949 /* Optimize the default case that there is no face property and we
6950 are not in the region. */
6952 && (base_face_id
!= DEFAULT_FACE_ID
6953 /* BUFPOS <= 0 means STRING is not an overlay string, so
6954 that the region doesn't have to be taken into account. */
6956 || bufpos
< region_beg
6957 || bufpos
>= region_end
)
6959 /* We can't realize faces for different charsets differently
6960 if we don't have fonts, so we can stop here if not working
6961 on a window-system frame. */
6962 || !FRAME_WINDOW_P (f
)
6963 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6964 return base_face
->id
;
6966 /* Begin with attributes from the base face. */
6967 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6969 /* Merge in attributes specified via text properties. */
6971 merge_face_vector_with_property (f
, attrs
, prop
);
6973 /* If in the region, merge in the region face. */
6975 && bufpos
>= region_beg
6976 && bufpos
< region_end
)
6978 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6979 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6982 /* Look up a realized face with the given face attributes,
6983 or realize a new one for ASCII characters. */
6984 return lookup_face (f
, attrs
, 0, NULL
);
6989 /***********************************************************************
6991 ***********************************************************************/
6995 /* Print the contents of the realized face FACE to stderr. */
6998 dump_realized_face (face
)
7001 fprintf (stderr
, "ID: %d\n", face
->id
);
7002 #ifdef HAVE_X_WINDOWS
7003 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7005 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7007 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7008 fprintf (stderr
, "background: 0x%lx (%s)\n",
7010 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7011 fprintf (stderr
, "font_name: %s (%s)\n",
7013 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7014 #ifdef HAVE_X_WINDOWS
7015 fprintf (stderr
, "font = %p\n", face
->font
);
7017 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7018 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7019 fprintf (stderr
, "underline: %d (%s)\n",
7021 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7022 fprintf (stderr
, "hash: %d\n", face
->hash
);
7023 fprintf (stderr
, "charset: %d\n", face
->charset
);
7027 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7035 fprintf (stderr
, "font selection order: ");
7036 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7037 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7038 fprintf (stderr
, "\n");
7040 fprintf (stderr
, "alternative fonts: ");
7041 debug_print (Vface_alternative_font_family_alist
);
7042 fprintf (stderr
, "\n");
7044 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7045 Fdump_face (make_number (i
));
7051 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7053 error ("Not a valid face");
7054 dump_realized_face (face
);
7061 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7062 0, 0, 0, doc
: /* */)
7065 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7066 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7067 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7071 #endif /* GLYPH_DEBUG != 0 */
7075 /***********************************************************************
7077 ***********************************************************************/
7082 Qface
= intern ("face");
7084 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7085 staticpro (&Qbitmap_spec_p
);
7086 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7087 staticpro (&Qframe_update_face_colors
);
7089 /* Lisp face attribute keywords. */
7090 QCfamily
= intern (":family");
7091 staticpro (&QCfamily
);
7092 QCheight
= intern (":height");
7093 staticpro (&QCheight
);
7094 QCweight
= intern (":weight");
7095 staticpro (&QCweight
);
7096 QCslant
= intern (":slant");
7097 staticpro (&QCslant
);
7098 QCunderline
= intern (":underline");
7099 staticpro (&QCunderline
);
7100 QCinverse_video
= intern (":inverse-video");
7101 staticpro (&QCinverse_video
);
7102 QCreverse_video
= intern (":reverse-video");
7103 staticpro (&QCreverse_video
);
7104 QCforeground
= intern (":foreground");
7105 staticpro (&QCforeground
);
7106 QCbackground
= intern (":background");
7107 staticpro (&QCbackground
);
7108 QCstipple
= intern (":stipple");;
7109 staticpro (&QCstipple
);
7110 QCwidth
= intern (":width");
7111 staticpro (&QCwidth
);
7112 QCfont
= intern (":font");
7113 staticpro (&QCfont
);
7114 QCbold
= intern (":bold");
7115 staticpro (&QCbold
);
7116 QCitalic
= intern (":italic");
7117 staticpro (&QCitalic
);
7118 QCoverline
= intern (":overline");
7119 staticpro (&QCoverline
);
7120 QCstrike_through
= intern (":strike-through");
7121 staticpro (&QCstrike_through
);
7122 QCbox
= intern (":box");
7124 QCinherit
= intern (":inherit");
7125 staticpro (&QCinherit
);
7127 /* Symbols used for Lisp face attribute values. */
7128 QCcolor
= intern (":color");
7129 staticpro (&QCcolor
);
7130 QCline_width
= intern (":line-width");
7131 staticpro (&QCline_width
);
7132 QCstyle
= intern (":style");
7133 staticpro (&QCstyle
);
7134 Qreleased_button
= intern ("released-button");
7135 staticpro (&Qreleased_button
);
7136 Qpressed_button
= intern ("pressed-button");
7137 staticpro (&Qpressed_button
);
7138 Qnormal
= intern ("normal");
7139 staticpro (&Qnormal
);
7140 Qultra_light
= intern ("ultra-light");
7141 staticpro (&Qultra_light
);
7142 Qextra_light
= intern ("extra-light");
7143 staticpro (&Qextra_light
);
7144 Qlight
= intern ("light");
7145 staticpro (&Qlight
);
7146 Qsemi_light
= intern ("semi-light");
7147 staticpro (&Qsemi_light
);
7148 Qsemi_bold
= intern ("semi-bold");
7149 staticpro (&Qsemi_bold
);
7150 Qbold
= intern ("bold");
7152 Qextra_bold
= intern ("extra-bold");
7153 staticpro (&Qextra_bold
);
7154 Qultra_bold
= intern ("ultra-bold");
7155 staticpro (&Qultra_bold
);
7156 Qoblique
= intern ("oblique");
7157 staticpro (&Qoblique
);
7158 Qitalic
= intern ("italic");
7159 staticpro (&Qitalic
);
7160 Qreverse_oblique
= intern ("reverse-oblique");
7161 staticpro (&Qreverse_oblique
);
7162 Qreverse_italic
= intern ("reverse-italic");
7163 staticpro (&Qreverse_italic
);
7164 Qultra_condensed
= intern ("ultra-condensed");
7165 staticpro (&Qultra_condensed
);
7166 Qextra_condensed
= intern ("extra-condensed");
7167 staticpro (&Qextra_condensed
);
7168 Qcondensed
= intern ("condensed");
7169 staticpro (&Qcondensed
);
7170 Qsemi_condensed
= intern ("semi-condensed");
7171 staticpro (&Qsemi_condensed
);
7172 Qsemi_expanded
= intern ("semi-expanded");
7173 staticpro (&Qsemi_expanded
);
7174 Qexpanded
= intern ("expanded");
7175 staticpro (&Qexpanded
);
7176 Qextra_expanded
= intern ("extra-expanded");
7177 staticpro (&Qextra_expanded
);
7178 Qultra_expanded
= intern ("ultra-expanded");
7179 staticpro (&Qultra_expanded
);
7180 Qbackground_color
= intern ("background-color");
7181 staticpro (&Qbackground_color
);
7182 Qforeground_color
= intern ("foreground-color");
7183 staticpro (&Qforeground_color
);
7184 Qunspecified
= intern ("unspecified");
7185 staticpro (&Qunspecified
);
7187 Qface_alias
= intern ("face-alias");
7188 staticpro (&Qface_alias
);
7189 Qdefault
= intern ("default");
7190 staticpro (&Qdefault
);
7191 Qtool_bar
= intern ("tool-bar");
7192 staticpro (&Qtool_bar
);
7193 Qregion
= intern ("region");
7194 staticpro (&Qregion
);
7195 Qfringe
= intern ("fringe");
7196 staticpro (&Qfringe
);
7197 Qheader_line
= intern ("header-line");
7198 staticpro (&Qheader_line
);
7199 Qscroll_bar
= intern ("scroll-bar");
7200 staticpro (&Qscroll_bar
);
7201 Qmenu
= intern ("menu");
7203 Qcursor
= intern ("cursor");
7204 staticpro (&Qcursor
);
7205 Qborder
= intern ("border");
7206 staticpro (&Qborder
);
7207 Qmouse
= intern ("mouse");
7208 staticpro (&Qmouse
);
7209 Qmode_line_inactive
= intern ("mode-line-inactive");
7210 staticpro (&Qmode_line_inactive
);
7211 Qtty_color_desc
= intern ("tty-color-desc");
7212 staticpro (&Qtty_color_desc
);
7213 Qtty_color_by_index
= intern ("tty-color-by-index");
7214 staticpro (&Qtty_color_by_index
);
7215 Qtty_color_alist
= intern ("tty-color-alist");
7216 staticpro (&Qtty_color_alist
);
7217 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7218 staticpro (&Qscalable_fonts_allowed
);
7220 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7221 staticpro (&Vparam_value_alist
);
7222 Vface_alternative_font_family_alist
= Qnil
;
7223 staticpro (&Vface_alternative_font_family_alist
);
7224 Vface_alternative_font_registry_alist
= Qnil
;
7225 staticpro (&Vface_alternative_font_registry_alist
);
7227 defsubr (&Sinternal_make_lisp_face
);
7228 defsubr (&Sinternal_lisp_face_p
);
7229 defsubr (&Sinternal_set_lisp_face_attribute
);
7230 #ifdef HAVE_WINDOW_SYSTEM
7231 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7233 defsubr (&Scolor_gray_p
);
7234 defsubr (&Scolor_supported_p
);
7235 defsubr (&Sface_attribute_relative_p
);
7236 defsubr (&Smerge_face_attribute
);
7237 defsubr (&Sinternal_get_lisp_face_attribute
);
7238 defsubr (&Sinternal_lisp_face_attribute_values
);
7239 defsubr (&Sinternal_lisp_face_equal_p
);
7240 defsubr (&Sinternal_lisp_face_empty_p
);
7241 defsubr (&Sinternal_copy_lisp_face
);
7242 defsubr (&Sinternal_merge_in_global_face
);
7243 defsubr (&Sface_font
);
7244 defsubr (&Sframe_face_alist
);
7245 defsubr (&Sinternal_set_font_selection_order
);
7246 defsubr (&Sinternal_set_alternative_font_family_alist
);
7247 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7248 defsubr (&Sface_attributes_as_vector
);
7250 defsubr (&Sdump_face
);
7251 defsubr (&Sshow_face_resources
);
7252 #endif /* GLYPH_DEBUG */
7253 defsubr (&Sclear_face_cache
);
7254 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7256 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7257 defsubr (&Sdump_colors
);
7260 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7261 doc
: /* *Limit for font matching.
7262 If an integer > 0, font matching functions won't load more than
7263 that number of fonts when searching for a matching font. */);
7264 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7266 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7267 doc
: /* List of global face definitions (for internal use only.) */);
7268 Vface_new_frame_defaults
= Qnil
;
7270 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7271 doc
: /* *Default stipple pattern used on monochrome displays.
7272 This stipple pattern is used on monochrome displays
7273 instead of shades of gray for a face background color.
7274 See `set-face-stipple' for possible values for this variable. */);
7275 Vface_default_stipple
= build_string ("gray3");
7277 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7278 doc
: /* An alist of defined terminal colors and their RGB values. */);
7279 Vtty_defined_color_alist
= Qnil
;
7281 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7282 doc
: /* Allowed scalable fonts.
7283 A value of nil means don't allow any scalable fonts.
7284 A value of t means allow any scalable font.
7285 Otherwise, value must be a list of regular expressions. A font may be
7286 scaled if its name matches a regular expression in the list.
7287 Note that if value is nil, a scalable font might still be used, if no
7288 other font of the appropriate family and registry is available. */);
7289 Vscalable_fonts_allowed
= Qnil
;
7291 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7292 doc
: /* List of ignored fonts.
7293 Each element is a regular expression that matches names of fonts to
7295 Vface_ignored_fonts
= Qnil
;
7297 #ifdef HAVE_WINDOW_SYSTEM
7298 defsubr (&Sbitmap_spec_p
);
7299 defsubr (&Sx_list_fonts
);
7300 defsubr (&Sinternal_face_x_get_resource
);
7301 defsubr (&Sx_family_fonts
);
7302 defsubr (&Sx_font_family_list
);
7303 #endif /* HAVE_WINDOW_SYSTEM */