1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001, 2002
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
199 #include "character.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 clear_face_gcs
P_ ((struct face_cache
*));
554 static void free_face_cache
P_ ((struct face_cache
*));
555 static int face_numeric_weight
P_ ((Lisp_Object
));
556 static int face_numeric_slant
P_ ((Lisp_Object
));
557 static int face_numeric_swidth
P_ ((Lisp_Object
));
558 static int face_fontset
P_ ((Lisp_Object
*));
559 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*,
560 struct face
*, 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 char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
571 struct font_name
*, int, int));
572 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
573 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
574 static int xlfd_numeric_slant
P_ ((struct font_name
*));
575 static int xlfd_numeric_weight
P_ ((struct font_name
*));
576 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
577 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
578 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
579 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
580 static int xlfd_fixed_p
P_ ((struct font_name
*));
581 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
583 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
584 struct font_name
*, int,
586 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
587 struct font_name
*, int));
589 #ifdef HAVE_WINDOW_SYSTEM
591 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
592 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
593 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
594 int (*cmpfn
) P_ ((const void *, const void *))));
595 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
596 static void x_free_gc
P_ ((struct frame
*, GC
));
597 static void clear_font_table
P_ ((struct x_display_info
*));
600 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
601 #endif /* WINDOWSNT */
604 static void x_update_menu_appearance
P_ ((struct frame
*));
606 extern void free_frame_menubar
P_ ((struct frame
*));
607 #endif /* USE_X_TOOLKIT */
609 #endif /* HAVE_WINDOW_SYSTEM */
612 /***********************************************************************
614 ***********************************************************************/
616 #ifdef HAVE_X_WINDOWS
618 #ifdef DEBUG_X_COLORS
620 /* The following is a poor mans infrastructure for debugging X color
621 allocation problems on displays with PseudoColor-8. Some X servers
622 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
623 color reference counts completely so that they don't signal an
624 error when a color is freed whose reference count is already 0.
625 Other X servers do. To help me debug this, the following code
626 implements a simple reference counting schema of its own, for a
627 single display/screen. --gerd. */
629 /* Reference counts for pixel colors. */
631 int color_count
[256];
633 /* Register color PIXEL as allocated. */
636 register_color (pixel
)
639 xassert (pixel
< 256);
640 ++color_count
[pixel
];
644 /* Register color PIXEL as deallocated. */
647 unregister_color (pixel
)
650 xassert (pixel
< 256);
651 if (color_count
[pixel
] > 0)
652 --color_count
[pixel
];
658 /* Register N colors from PIXELS as deallocated. */
661 unregister_colors (pixels
, n
)
662 unsigned long *pixels
;
666 for (i
= 0; i
< n
; ++i
)
667 unregister_color (pixels
[i
]);
671 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
672 doc
: /* Dump currently allocated colors to stderr. */)
677 fputc ('\n', stderr
);
679 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
682 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
685 fputc ('\n', stderr
);
687 fputc ('\t', stderr
);
691 fputc ('\n', stderr
);
695 #endif /* DEBUG_X_COLORS */
698 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
699 color values. Interrupt input must be blocked when this function
703 x_free_colors (f
, pixels
, npixels
)
705 unsigned long *pixels
;
708 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
710 /* If display has an immutable color map, freeing colors is not
711 necessary and some servers don't allow it. So don't do it. */
712 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
714 #ifdef DEBUG_X_COLORS
715 unregister_colors (pixels
, npixels
);
717 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
723 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
724 color values. Interrupt input must be blocked when this function
728 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
732 unsigned long *pixels
;
735 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
736 int class = dpyinfo
->visual
->class;
738 /* If display has an immutable color map, freeing colors is not
739 necessary and some servers don't allow it. So don't do it. */
740 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
742 #ifdef DEBUG_X_COLORS
743 unregister_colors (pixels
, npixels
);
745 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
750 /* Create and return a GC for use on frame F. GC values and mask
751 are given by XGCV and MASK. */
754 x_create_gc (f
, mask
, xgcv
)
761 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
768 /* Free GC which was used on frame F. */
776 xassert (--ngcs
>= 0);
777 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
781 #endif /* HAVE_X_WINDOWS */
784 /* W32 emulation of GCs */
787 x_create_gc (f
, mask
, xgcv
)
794 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
801 /* Free GC which was used on frame F. */
809 xassert (--ngcs
>= 0);
814 #endif /* WINDOWSNT */
816 /* Like stricmp. Used to compare parts of font names which are in
821 unsigned char *s1
, *s2
;
825 unsigned char c1
= tolower (*s1
);
826 unsigned char c2
= tolower (*s2
);
828 return c1
< c2
? -1 : 1;
833 return *s2
== 0 ? 0 : -1;
838 /* Like strlwr, which might not always be available. */
840 static unsigned char *
844 unsigned char *p
= s
;
853 /* Signal `error' with message S, and additional argument ARG. */
856 signal_error (s
, arg
)
860 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
864 /* If FRAME is nil, return a pointer to the selected frame.
865 Otherwise, check that FRAME is a live frame, and return a pointer
866 to it. NPARAM is the parameter number of FRAME, for
867 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
868 Lisp function definitions. */
870 static INLINE
struct frame
*
871 frame_or_selected_frame (frame
, nparam
)
876 frame
= selected_frame
;
878 CHECK_LIVE_FRAME (frame
);
879 return XFRAME (frame
);
883 /***********************************************************************
885 ***********************************************************************/
887 /* Initialize face cache and basic faces for frame F. */
893 /* Make a face cache, if F doesn't have one. */
894 if (FRAME_FACE_CACHE (f
) == NULL
)
895 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
897 #ifdef HAVE_WINDOW_SYSTEM
898 /* Make the image cache. */
899 if (FRAME_WINDOW_P (f
))
901 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
902 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
903 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
905 #endif /* HAVE_WINDOW_SYSTEM */
907 /* Realize basic faces. Must have enough information in frame
908 parameters to realize basic faces at this point. */
909 #ifdef HAVE_X_WINDOWS
910 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
913 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
915 if (!realize_basic_faces (f
))
920 /* Free face cache of frame F. Called from Fdelete_frame. */
926 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
930 free_face_cache (face_cache
);
931 FRAME_FACE_CACHE (f
) = NULL
;
934 #ifdef HAVE_WINDOW_SYSTEM
935 if (FRAME_WINDOW_P (f
))
937 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
940 --image_cache
->refcount
;
941 if (image_cache
->refcount
== 0)
942 free_image_cache (f
);
945 #endif /* HAVE_WINDOW_SYSTEM */
949 /* Clear face caches, and recompute basic faces for frame F. Call
950 this after changing frame parameters on which those faces depend,
951 or when realized faces have been freed due to changing attributes
955 recompute_basic_faces (f
)
958 if (FRAME_FACE_CACHE (f
))
960 clear_face_cache (0);
961 if (!realize_basic_faces (f
))
967 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
968 try to free unused fonts, too. */
971 clear_face_cache (clear_fonts_p
)
974 #ifdef HAVE_WINDOW_SYSTEM
975 Lisp_Object tail
, frame
;
979 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
981 struct x_display_info
*dpyinfo
;
983 /* Fonts are common for frames on one display, i.e. on
985 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
986 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
987 clear_font_table (dpyinfo
);
989 /* From time to time see if we can unload some fonts. This also
990 frees all realized faces on all frames. Fonts needed by
991 faces will be loaded again when faces are realized again. */
992 clear_font_table_count
= 0;
994 FOR_EACH_FRAME (tail
, frame
)
996 struct frame
*f
= XFRAME (frame
);
997 if (FRAME_WINDOW_P (f
)
998 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
999 free_all_realized_faces (frame
);
1004 /* Clear GCs of realized faces. */
1005 FOR_EACH_FRAME (tail
, frame
)
1008 if (FRAME_WINDOW_P (f
))
1010 clear_face_gcs (FRAME_FACE_CACHE (f
));
1011 clear_image_cache (f
, 0);
1015 #endif /* HAVE_WINDOW_SYSTEM */
1019 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1020 doc
: /* Clear face caches on all frames.
1021 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1023 Lisp_Object thoroughly
;
1025 clear_face_cache (!NILP (thoroughly
));
1026 ++face_change_count
;
1027 ++windows_or_buffers_changed
;
1033 #ifdef HAVE_WINDOW_SYSTEM
1036 /* Remove fonts from the font table of DPYINFO except for the default
1037 ASCII fonts of frames on that display. Called from clear_face_cache
1038 from time to time. */
1041 clear_font_table (dpyinfo
)
1042 struct x_display_info
*dpyinfo
;
1046 /* Free those fonts that are not used by frames on DPYINFO. */
1047 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1049 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1050 Lisp_Object tail
, frame
;
1052 /* Check if slot is already free. */
1053 if (font_info
->name
== NULL
)
1056 /* Don't free a default font of some frame on this display. */
1057 FOR_EACH_FRAME (tail
, frame
)
1059 struct frame
*f
= XFRAME (frame
);
1060 if (FRAME_WINDOW_P (f
)
1061 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1062 && font_info
->font
== FRAME_FONT (f
))
1070 if (font_info
->full_name
!= font_info
->name
)
1071 xfree (font_info
->full_name
);
1072 xfree (font_info
->name
);
1074 /* Free the font. */
1076 #ifdef HAVE_X_WINDOWS
1077 XFreeFont (dpyinfo
->display
, font_info
->font
);
1080 w32_unload_font (dpyinfo
, font_info
->font
);
1084 /* Mark font table slot free. */
1085 font_info
->font
= NULL
;
1086 font_info
->name
= font_info
->full_name
= NULL
;
1090 #endif /* HAVE_WINDOW_SYSTEM */
1094 /***********************************************************************
1096 ***********************************************************************/
1098 #ifdef HAVE_WINDOW_SYSTEM
1100 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1101 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1102 A bitmap specification is either a string, a file name, or a list
1103 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1104 HEIGHT is its height, and DATA is a string containing the bits of
1105 the pixmap. Bits are stored row by row, each row occupies
1106 \(WIDTH + 7)/8 bytes. */)
1112 if (STRINGP (object
))
1113 /* If OBJECT is a string, it's a file name. */
1115 else if (CONSP (object
))
1117 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1118 HEIGHT must be integers > 0, and DATA must be string large
1119 enough to hold a bitmap of the specified size. */
1120 Lisp_Object width
, height
, data
;
1122 height
= width
= data
= Qnil
;
1126 width
= XCAR (object
);
1127 object
= XCDR (object
);
1130 height
= XCAR (object
);
1131 object
= XCDR (object
);
1133 data
= XCAR (object
);
1137 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1139 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1141 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1146 return pixmap_p
? Qt
: Qnil
;
1150 /* Load a bitmap according to NAME (which is either a file name or a
1151 pixmap spec) for use on frame F. Value is the bitmap_id (see
1152 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1153 bitmap cannot be loaded, display a message saying so, and return
1154 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1155 if these pointers are not null. */
1158 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1161 unsigned int *w_ptr
, *h_ptr
;
1169 tem
= Fbitmap_spec_p (name
);
1171 wrong_type_argument (Qbitmap_spec_p
, name
);
1176 /* Decode a bitmap spec into a bitmap. */
1181 w
= XINT (Fcar (name
));
1182 h
= XINT (Fcar (Fcdr (name
)));
1183 bits
= Fcar (Fcdr (Fcdr (name
)));
1185 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1190 /* It must be a string -- a file name. */
1191 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1197 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1208 ++npixmaps_allocated
;
1211 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1214 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1220 #endif /* HAVE_WINDOW_SYSTEM */
1224 /***********************************************************************
1226 ***********************************************************************/
1228 #ifdef HAVE_WINDOW_SYSTEM
1230 /* Update the line_height of frame F. Return non-zero if line height
1234 frame_update_line_height (f
)
1237 int line_height
, changed_p
;
1239 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1240 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1241 FRAME_LINE_HEIGHT (f
) = line_height
;
1245 #endif /* HAVE_WINDOW_SYSTEM */
1248 /***********************************************************************
1250 ***********************************************************************/
1252 #ifdef HAVE_WINDOW_SYSTEM
1254 /* Load font of face FACE which is used on frame F to display
1255 character C. The name of the font to load is determined by lface
1256 and fontset of FACE. */
1259 load_face_font (f
, face
, c
)
1264 struct font_info
*font_info
= NULL
;
1267 face
->font_info_id
= -1;
1270 font_name
= choose_face_font (f
, face
->lface
, face
, c
);
1276 font_info
= FS_LOAD_FONT (f
, font_name
);
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
);
2116 generate_ascii_font (name
, ascii_spec
)
2117 Lisp_Object name
, ascii_spec
;
2119 struct font_name font
;
2122 font
.name
= LSTRDUPA (name
);
2123 if (! split_font_name (NULL
, &font
, 0))
2126 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
)))
2128 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
));
2129 font
.fields
[XLFD_FOUNDRY
] = p
;
2130 while (*p
!= '-') p
++;
2134 font
.fields
[XLFD_FAMILY
] = p
;
2138 font
.fields
[XLFD_FAMILY
] = font
.fields
[XLFD_FOUNDRY
];
2139 font
.fields
[XLFD_FOUNDRY
] = "*";
2142 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
)))
2143 font
.fields
[XLFD_WEIGHT
]
2144 = XSTRING (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
))->data
;
2145 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
)))
2146 font
.fields
[XLFD_SLANT
]
2147 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
))->data
;
2148 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
)))
2149 font
.fields
[XLFD_SWIDTH
]
2150 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
))->data
;
2151 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
)))
2152 font
.fields
[XLFD_ADSTYLE
]
2153 = XSTRING (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
))->data
;
2154 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
2155 font
.fields
[XLFD_REGISTRY
] = p
;
2156 while (*p
!= '-') p
++;
2161 font
.fields
[XLFD_ENCODING
] = p
;
2163 p
= build_font_name (&font
);
2164 name
= build_string (p
);
2170 #ifdef HAVE_WINDOW_SYSTEM
2172 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2176 struct font_name
*font
;
2178 /* Function split_font_name converts fields to lower-case, so there
2179 is no need to use tolower here. */
2180 return *font
->fields
[XLFD_SPACING
] != 'p';
2184 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2186 The actual height of the font when displayed on F depends on the
2187 resolution of both the font and frame. For example, a 10pt font
2188 designed for a 100dpi display will display larger than 10pt on a
2189 75dpi display. (It's not unusual to use fonts not designed for the
2190 display one is using. For example, some intlfonts are available in
2191 72dpi versions, only.)
2193 Value is the real point size of FONT on frame F, or 0 if it cannot
2197 xlfd_point_size (f
, font
)
2199 struct font_name
*font
;
2201 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2202 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2206 if (*pixel_field
== '[')
2208 /* The pixel size field is `[A B C D]' which specifies
2209 a transformation matrix.
2215 by which all glyphs of the font are transformed. The spec
2216 says that s scalar value N for the pixel size is equivalent
2217 to A = N * resx/resy, B = C = 0, D = N. */
2218 char *start
= pixel_field
+ 1, *end
;
2222 for (i
= 0; i
< 4; ++i
)
2224 matrix
[i
] = strtod (start
, &end
);
2231 pixel
= atoi (pixel_field
);
2236 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2242 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2243 of frame F. This function is used to guess a point size of font
2244 when only the pixel height of the font is available. */
2247 pixel_point_size (f
, pixel
)
2251 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2255 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2256 point size of one dot. */
2257 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2258 int_pt
= real_pt
+ 0.5;
2264 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2265 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2266 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2267 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2268 zero if the font name doesn't have the format we expect. The
2269 expected format is a font name that starts with a `-' and has
2270 XLFD_LAST fields separated by `-'. */
2273 split_font_name (f
, font
, numeric_p
)
2275 struct font_name
*font
;
2281 if (*font
->name
== '-')
2283 char *p
= xstrlwr (font
->name
) + 1;
2285 while (i
< XLFD_LAST
)
2287 font
->fields
[i
] = p
;
2290 /* Pixel and point size may be of the form `[....]'. For
2291 BNF, see XLFD spec, chapter 4. Negative values are
2292 indicated by tilde characters which we replace with
2293 `-' characters, here. */
2295 && (i
- 1 == XLFD_PIXEL_SIZE
2296 || i
- 1 == XLFD_POINT_SIZE
))
2301 for (++p
; *p
&& *p
!= ']'; ++p
)
2305 /* Check that the matrix contains 4 floating point
2307 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2310 if (strtod (start
, &end
) == 0 && start
== end
)
2317 while (*p
&& *p
!= '-')
2327 success_p
= i
== XLFD_LAST
;
2329 /* If requested, and font name was in the expected format,
2330 compute numeric values for some fields. */
2331 if (numeric_p
&& success_p
)
2333 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2334 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2335 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2336 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2337 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2338 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2341 /* Initialize it to zero. It will be overridden by font_list while
2342 trying alternate registries. */
2343 font
->registry_priority
= 0;
2349 /* Build an XLFD font name from font name fields in FONT. Value is a
2350 pointer to the font name, which is allocated via xmalloc. */
2353 build_font_name (font
)
2354 struct font_name
*font
;
2358 char *font_name
= (char *) xmalloc (size
);
2359 int total_length
= 0;
2361 for (i
= 0; i
< XLFD_LAST
; ++i
)
2363 /* Add 1 because of the leading `-'. */
2364 int len
= strlen (font
->fields
[i
]) + 1;
2366 /* Reallocate font_name if necessary. Add 1 for the final
2368 if (total_length
+ len
+ 1 >= size
)
2370 int new_size
= max (2 * size
, size
+ len
+ 1);
2371 int sz
= new_size
* sizeof *font_name
;
2372 font_name
= (char *) xrealloc (font_name
, sz
);
2376 font_name
[total_length
] = '-';
2377 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2378 total_length
+= len
;
2381 font_name
[total_length
] = 0;
2386 /* Free an array FONTS of N font_name structures. This frees FONTS
2387 itself and all `name' fields in its elements. */
2390 free_font_names (fonts
, n
)
2391 struct font_name
*fonts
;
2395 xfree (fonts
[--n
].name
);
2400 /* Sort vector FONTS of font_name structures which contains NFONTS
2401 elements using qsort and comparison function CMPFN. F is the frame
2402 on which the fonts will be used. The global variable font_frame
2403 is temporarily set to F to make it available in CMPFN. */
2406 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2408 struct font_name
*fonts
;
2410 int (*cmpfn
) P_ ((const void *, const void *));
2413 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2418 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2419 display in x_display_list. FONTS is a pointer to a vector of
2420 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2421 alternative patterns from Valternate_fontname_alist if no fonts are
2422 found matching PATTERN.
2424 For all fonts found, set FONTS[i].name to the name of the font,
2425 allocated via xmalloc, and split font names into fields. Ignore
2426 fonts that we can't parse. Value is the number of fonts found. */
2429 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2432 struct font_name
*fonts
;
2433 int nfonts
, try_alternatives_p
;
2437 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2438 better to do it the other way around. */
2440 Lisp_Object lpattern
, tem
;
2442 lpattern
= build_string (pattern
);
2444 /* Get the list of fonts matching PATTERN. */
2447 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2450 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2453 /* Make a copy of the font names we got from X, and
2454 split them into fields. */
2456 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2458 Lisp_Object elt
, tail
;
2459 char *name
= XSTRING (XCAR (tem
))->data
;
2461 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2462 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2466 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2475 /* Make a copy of the font name. */
2476 fonts
[n
].name
= xstrdup (name
);
2478 if (split_font_name (f
, fonts
+ n
, 1))
2480 if (font_scalable_p (fonts
+ n
)
2481 && !may_use_scalable_font_p (name
))
2484 xfree (fonts
[n
].name
);
2490 xfree (fonts
[n
].name
);
2493 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2494 if (n
== 0 && try_alternatives_p
)
2496 Lisp_Object list
= Valternate_fontname_alist
;
2498 while (CONSP (list
))
2500 Lisp_Object entry
= XCAR (list
);
2502 && STRINGP (XCAR (entry
))
2503 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2510 Lisp_Object patterns
= XCAR (list
);
2513 while (CONSP (patterns
)
2514 /* If list is screwed up, give up. */
2515 && (name
= XCAR (patterns
),
2517 /* Ignore patterns equal to PATTERN because we tried that
2518 already with no success. */
2519 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2520 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2523 patterns
= XCDR (patterns
);
2531 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2532 using comparison function CMPFN. Value is the number of fonts
2533 found. If value is non-zero, *FONTS is set to a vector of
2534 font_name structures allocated from the heap containing matching
2535 fonts. Each element of *FONTS contains a name member that is also
2536 allocated from the heap. Font names in these structures are split
2537 into fields. Use free_font_names to free such an array. */
2540 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2543 int (*cmpfn
) P_ ((const void *, const void *));
2544 struct font_name
**fonts
;
2548 /* Get the list of fonts matching pattern. 100 should suffice. */
2549 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2550 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2551 nfonts
= XFASTINT (Vfont_list_limit
);
2553 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2554 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2556 /* Sort the resulting array and return it in *FONTS. If no
2557 fonts were found, make sure to set *FONTS to null. */
2559 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2570 /* Compare two font_name structures *A and *B. Value is analogous to
2571 strcmp. Sort order is given by the global variable
2572 font_sort_order. Font names are sorted so that, everything else
2573 being equal, fonts with a resolution closer to that of the frame on
2574 which they are used are listed first. The global variable
2575 font_frame is the frame on which we operate. */
2578 cmp_font_names (a
, b
)
2581 struct font_name
*x
= (struct font_name
*) a
;
2582 struct font_name
*y
= (struct font_name
*) b
;
2585 /* All strings have been converted to lower-case by split_font_name,
2586 so we can use strcmp here. */
2587 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2592 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2594 int j
= font_sort_order
[i
];
2595 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2600 /* Everything else being equal, we prefer fonts with an
2601 y-resolution closer to that of the frame. */
2602 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2603 int x_resy
= x
->numeric
[XLFD_RESY
];
2604 int y_resy
= y
->numeric
[XLFD_RESY
];
2605 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2613 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2614 is non-nil list fonts matching that pattern. Otherwise, if
2615 REGISTRY is non-nil return only fonts with that registry, otherwise
2616 return fonts of any registry. Set *FONTS to a vector of font_name
2617 structures allocated from the heap containing the fonts found.
2618 Value is the number of fonts found. */
2621 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2623 Lisp_Object pattern
, family
, registry
;
2624 struct font_name
**fonts
;
2626 char *pattern_str
, *family_str
, *registry_str
;
2630 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2631 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2633 pattern_str
= (char *) alloca (strlen (family_str
)
2634 + strlen (registry_str
)
2636 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2637 strcat (pattern_str
, family_str
);
2638 strcat (pattern_str
, "-*-");
2639 strcat (pattern_str
, registry_str
);
2640 if (!index (registry_str
, '-'))
2642 if (registry_str
[strlen (registry_str
) - 1] == '*')
2643 strcat (pattern_str
, "-*");
2645 strcat (pattern_str
, "*-*");
2649 pattern_str
= (char *) XSTRING (pattern
)->data
;
2651 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2655 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2656 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2657 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2660 static struct font_name
*
2661 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2662 struct font_name
*fonts1
, *fonts2
;
2663 int nfonts1
, nfonts2
;
2665 int new_nfonts
= nfonts1
+ nfonts2
;
2666 struct font_name
*new_fonts
;
2668 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2669 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2670 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2677 /* Get a sorted list of fonts of family FAMILY on frame F.
2679 If PATTERN is non-nil list fonts matching that pattern.
2681 If REGISTRY is non-nil, return fonts with that registry and the
2682 alternative registries from Vface_alternative_font_registry_alist.
2684 If REGISTRY is nil return fonts of any registry.
2686 Set *FONTS to a vector of font_name structures allocated from the
2687 heap containing the fonts found. Value is the number of fonts
2691 font_list (f
, pattern
, family
, registry
, fonts
)
2693 Lisp_Object pattern
, family
, registry
;
2694 struct font_name
**fonts
;
2696 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2698 if (!NILP (registry
)
2699 && CONSP (Vface_alternative_font_registry_alist
))
2703 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2708 for (alter
= XCDR (alter
), reg_prio
= 1;
2710 alter
= XCDR (alter
), reg_prio
++)
2711 if (STRINGP (XCAR (alter
)))
2714 struct font_name
*fonts2
;
2716 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2718 for (i
= 0; i
< nfonts2
; i
++)
2719 fonts2
[i
].registry_priority
= reg_prio
;
2720 *fonts
= (nfonts
> 0
2721 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2732 /* Remove elements from LIST whose cars are `equal'. Called from
2733 x-family-fonts and x-font-family-list to remove duplicate font
2737 remove_duplicates (list
)
2740 Lisp_Object tail
= list
;
2742 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2744 Lisp_Object next
= XCDR (tail
);
2745 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2746 XSETCDR (tail
, XCDR (next
));
2753 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2754 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2755 If FAMILY is omitted or nil, list all families.
2756 Otherwise, FAMILY must be a string, possibly containing wildcards
2758 If FRAME is omitted or nil, use the selected frame.
2759 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2760 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2761 FAMILY is the font family name. POINT-SIZE is the size of the
2762 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2763 width, weight and slant of the font. These symbols are the same as for
2764 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2765 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2766 giving the registry and encoding of the font.
2767 The result list is sorted according to the current setting of
2768 the face font sort order. */)
2770 Lisp_Object family
, frame
;
2772 struct frame
*f
= check_x_frame (frame
);
2773 struct font_name
*fonts
;
2776 struct gcpro gcpro1
;
2779 CHECK_STRING (family
);
2783 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2784 for (i
= nfonts
- 1; i
>= 0; --i
)
2786 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2789 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2790 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2791 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2792 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2793 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2794 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2795 tem
= build_font_name (fonts
+ i
);
2796 ASET (v
, 6, build_string (tem
));
2797 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2798 fonts
[i
].fields
[XLFD_ENCODING
]);
2799 ASET (v
, 7, build_string (tem
));
2802 result
= Fcons (v
, result
);
2805 remove_duplicates (result
);
2806 free_font_names (fonts
, nfonts
);
2812 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2814 doc
: /* Return a list of available font families on FRAME.
2815 If FRAME is omitted or nil, use the selected frame.
2816 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2817 is a font family, and FIXED-P is non-nil if fonts of that family
2818 are fixed-pitch. */)
2822 struct frame
*f
= check_x_frame (frame
);
2824 struct font_name
*fonts
;
2826 struct gcpro gcpro1
;
2827 int count
= specpdl_ptr
- specpdl
;
2830 /* Let's consider all fonts. Increase the limit for matching
2831 fonts until we have them all. */
2834 specbind (intern ("font-list-limit"), make_number (limit
));
2835 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2837 if (nfonts
== limit
)
2839 free_font_names (fonts
, nfonts
);
2848 for (i
= nfonts
- 1; i
>= 0; --i
)
2849 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2850 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2853 remove_duplicates (result
);
2854 free_font_names (fonts
, nfonts
);
2856 return unbind_to (count
, result
);
2860 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2861 doc
: /* Return a list of the names of available fonts matching PATTERN.
2862 If optional arguments FACE and FRAME are specified, return only fonts
2863 the same size as FACE on FRAME.
2864 PATTERN is a string, perhaps with wildcard characters;
2865 the * character matches any substring, and
2866 the ? character matches any single character.
2867 PATTERN is case-insensitive.
2868 FACE is a face name--a symbol.
2870 The return value is a list of strings, suitable as arguments to
2873 Fonts Emacs can't use may or may not be excluded
2874 even if they match PATTERN and FACE.
2875 The optional fourth argument MAXIMUM sets a limit on how many
2876 fonts to match. The first MAXIMUM fonts are reported.
2877 The optional fifth argument WIDTH, if specified, is a number of columns
2878 occupied by a character of a font. In that case, return only fonts
2879 the WIDTH times as wide as FACE on FRAME. */)
2880 (pattern
, face
, frame
, maximum
, width
)
2881 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2888 CHECK_STRING (pattern
);
2894 CHECK_NATNUM (maximum
);
2895 maxnames
= XINT (maximum
);
2899 CHECK_NUMBER (width
);
2901 /* We can't simply call check_x_frame because this function may be
2902 called before any frame is created. */
2903 f
= frame_or_selected_frame (frame
, 2);
2904 if (!FRAME_WINDOW_P (f
))
2906 /* Perhaps we have not yet created any frame. */
2911 /* Determine the width standard for comparison with the fonts we find. */
2917 /* This is of limited utility since it works with character
2918 widths. Keep it for compatibility. --gerd. */
2919 int face_id
= lookup_named_face (f
, face
, 0);
2920 struct face
*face
= (face_id
< 0
2922 : FACE_FROM_ID (f
, face_id
));
2924 if (face
&& face
->font
)
2925 size
= FONT_WIDTH (face
->font
);
2927 size
= FONT_WIDTH (FRAME_FONT (f
));
2930 size
*= XINT (width
);
2934 Lisp_Object args
[2];
2936 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2938 /* We don't have to check fontsets. */
2940 args
[1] = list_fontsets (f
, pattern
, size
);
2941 return Fnconc (2, args
);
2945 #endif /* HAVE_WINDOW_SYSTEM */
2949 /***********************************************************************
2951 ***********************************************************************/
2953 /* Access face attributes of face LFACE, a Lisp vector. */
2955 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2956 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2957 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2958 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2959 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2960 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2961 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2962 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2963 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2964 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2965 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2966 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2967 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2968 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2969 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2970 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2972 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2973 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2975 #define LFACEP(LFACE) \
2977 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2978 && EQ (AREF (LFACE, 0), Qface))
2983 /* Check consistency of Lisp face attribute vector ATTRS. */
2986 check_lface_attrs (attrs
)
2989 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2990 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2991 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2992 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2993 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2994 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2995 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2996 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2997 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2998 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2999 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3000 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3001 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3002 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3003 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3004 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3005 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3006 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3007 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3008 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3009 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3010 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3011 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3012 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3013 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3014 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3015 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3016 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3017 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3018 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3019 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3020 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3021 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3022 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3023 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3024 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3025 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3026 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3027 #ifdef HAVE_WINDOW_SYSTEM
3028 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3029 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3030 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3031 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3032 || NILP (attrs
[LFACE_FONT_INDEX
])
3033 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3038 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3046 xassert (LFACEP (lface
));
3047 check_lface_attrs (XVECTOR (lface
)->contents
);
3051 #else /* GLYPH_DEBUG == 0 */
3053 #define check_lface_attrs(attrs) (void) 0
3054 #define check_lface(lface) (void) 0
3056 #endif /* GLYPH_DEBUG == 0 */
3059 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3060 to make it a symvol. If FACE_NAME is an alias for another face,
3061 return that face's name. */
3064 resolve_face_name (face_name
)
3065 Lisp_Object face_name
;
3067 Lisp_Object aliased
;
3069 if (STRINGP (face_name
))
3070 face_name
= intern (XSTRING (face_name
)->data
);
3072 while (SYMBOLP (face_name
))
3074 aliased
= Fget (face_name
, Qface_alias
);
3078 face_name
= aliased
;
3085 /* Return the face definition of FACE_NAME on frame F. F null means
3086 return the definition for new frames. FACE_NAME may be a string or
3087 a symbol (apparently Emacs 20.2 allowed strings as face names in
3088 face text properties; Ediff uses that). If FACE_NAME is an alias
3089 for another face, return that face's definition. If SIGNAL_P is
3090 non-zero, signal an error if FACE_NAME is not a valid face name.
3091 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3094 static INLINE Lisp_Object
3095 lface_from_face_name (f
, face_name
, signal_p
)
3097 Lisp_Object face_name
;
3102 face_name
= resolve_face_name (face_name
);
3105 lface
= assq_no_quit (face_name
, f
->face_alist
);
3107 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3110 lface
= XCDR (lface
);
3112 signal_error ("Invalid face", face_name
);
3114 check_lface (lface
);
3119 /* Get face attributes of face FACE_NAME from frame-local faces on
3120 frame F. Store the resulting attributes in ATTRS which must point
3121 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3122 is non-zero, signal an error if FACE_NAME does not name a face.
3123 Otherwise, value is zero if FACE_NAME is not a face. */
3126 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3128 Lisp_Object face_name
;
3135 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3138 bcopy (XVECTOR (lface
)->contents
, attrs
,
3139 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3149 /* Non-zero if all attributes in face attribute vector ATTRS are
3150 specified, i.e. are non-nil. */
3153 lface_fully_specified_p (attrs
)
3158 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3159 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3160 && i
!= LFACE_AVGWIDTH_INDEX
)
3161 if (UNSPECIFIEDP (attrs
[i
]))
3164 return i
== LFACE_VECTOR_SIZE
;
3167 #ifdef HAVE_WINDOW_SYSTEM
3169 /* Set font-related attributes of Lisp face LFACE from the fullname of
3170 the font opened by FONTNAME. If FORCE_P is zero, set only
3171 unspecified attributes of LFACE. The exception is `font'
3172 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3174 If FONTNAME is not available on frame F,
3175 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3176 If the fullname is not in a valid XLFD format,
3177 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3178 in LFACE and return 1.
3179 Otherwise, return 1. */
3182 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3185 Lisp_Object fontname
;
3186 int force_p
, may_fail_p
;
3188 struct font_name font
;
3193 char *font_name
= XSTRING (fontname
)->data
;
3194 struct font_info
*font_info
;
3196 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3197 fontset
= fs_query_fontset (fontname
, 0);
3199 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3201 /* Check if FONT_NAME is surely available on the system. Usually
3202 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3203 returns quickly. But, even if FONT_NAME is not yet cached,
3204 caching it now is not futail because we anyway load the font
3207 font_info
= FS_LOAD_FONT (f
, font_name
);
3217 font
.name
= STRDUPA (font_info
->full_name
);
3218 have_xlfd_p
= split_font_name (f
, &font
, 1);
3220 /* Set attributes only if unspecified, otherwise face defaults for
3221 new frames would never take effect. If we couldn't get a font
3222 name conforming to XLFD, set normal values. */
3224 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3229 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3230 + strlen (font
.fields
[XLFD_FOUNDRY
])
3232 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3233 font
.fields
[XLFD_FAMILY
]);
3234 val
= build_string (buffer
);
3237 val
= build_string ("*");
3238 LFACE_FAMILY (lface
) = val
;
3241 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3244 pt
= xlfd_point_size (f
, &font
);
3246 pt
= pixel_point_size (f
, font_info
->height
* 10);
3248 LFACE_HEIGHT (lface
) = make_number (pt
);
3251 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3252 LFACE_SWIDTH (lface
)
3253 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3255 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3256 LFACE_AVGWIDTH (lface
)
3258 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3261 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3262 LFACE_WEIGHT (lface
)
3263 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3265 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3267 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3269 LFACE_FONT (lface
) = fontname
;
3274 #endif /* HAVE_WINDOW_SYSTEM */
3277 /* Merges the face height FROM with the face height TO, and returns the
3278 merged height. If FROM is an invalid height, then INVALID is
3279 returned instead. FROM and TO may be either absolute face heights or
3280 `relative' heights; the returned value is always an absolute height
3281 unless both FROM and TO are relative. GCPRO is a lisp value that
3282 will be protected from garbage-collection if this function makes a
3286 merge_face_heights (from
, to
, invalid
, gcpro
)
3287 Lisp_Object from
, to
, invalid
, gcpro
;
3289 Lisp_Object result
= invalid
;
3291 if (INTEGERP (from
))
3292 /* FROM is absolute, just use it as is. */
3294 else if (FLOATP (from
))
3295 /* FROM is a scale, use it to adjust TO. */
3298 /* relative X absolute => absolute */
3299 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3300 else if (FLOATP (to
))
3301 /* relative X relative => relative */
3302 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3304 else if (FUNCTIONP (from
))
3305 /* FROM is a function, which use to adjust TO. */
3307 /* Call function with current height as argument.
3308 From is the new height. */
3309 Lisp_Object args
[2];
3310 struct gcpro gcpro1
;
3316 result
= safe_call (2, args
);
3320 /* Ensure that if TO was absolute, so is the result. */
3321 if (INTEGERP (to
) && !INTEGERP (result
))
3329 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3330 store the resulting attributes in TO, which must be already be
3331 completely specified and contain only absolute attributes. Every
3332 specified attribute of FROM overrides the corresponding attribute of
3333 TO; relative attributes in FROM are merged with the absolute value in
3334 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3335 face inheritance; it should be Qnil when called from other places. */
3338 merge_face_vectors (f
, from
, to
, cycle_check
)
3340 Lisp_Object
*from
, *to
;
3341 Lisp_Object cycle_check
;
3345 /* If FROM inherits from some other faces, merge their attributes into
3346 TO before merging FROM's direct attributes. Note that an :inherit
3347 attribute of `unspecified' is the same as one of nil; we never
3348 merge :inherit attributes, so nil is more correct, but lots of
3349 other code uses `unspecified' as a generic value for face attributes. */
3350 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3351 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3352 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3354 /* If TO specifies a :font attribute, and FROM specifies some
3355 font-related attribute, we need to clear TO's :font attribute
3356 (because it will be inconsistent with whatever FROM specifies, and
3357 FROM takes precedence). */
3358 if (!NILP (to
[LFACE_FONT_INDEX
])
3359 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3360 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3361 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3362 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3363 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3364 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3365 to
[LFACE_FONT_INDEX
] = Qnil
;
3367 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3368 if (!UNSPECIFIEDP (from
[i
]))
3370 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3371 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3376 /* TO is always an absolute face, which should inherit from nothing.
3377 We blindly copy the :inherit attribute above and fix it up here. */
3378 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3382 /* Checks the `cycle check' variable CHECK to see if it indicates that
3383 EL is part of a cycle; CHECK must be either Qnil or a value returned
3384 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3385 elements after which a cycle might be suspected; after that many
3386 elements, this macro begins consing in order to keep more precise
3389 Returns nil if a cycle was detected, otherwise a new value for CHECK
3392 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3393 the caller should make sure that's ok. */
3395 #define CYCLE_CHECK(check, el, suspicious) \
3398 : (INTEGERP (check) \
3399 ? (XFASTINT (check) < (suspicious) \
3400 ? make_number (XFASTINT (check) + 1) \
3401 : Fcons (el, Qnil)) \
3402 : (!NILP (Fmemq ((el), (check))) \
3404 : Fcons ((el), (check)))))
3407 /* Merge face attributes from the face on frame F whose name is
3408 INHERITS, into the vector of face attributes TO; INHERITS may also be
3409 a list of face names, in which case they are applied in order.
3410 CYCLE_CHECK is used to detect loops in face inheritance.
3411 Returns true if any of the inherited attributes are `font-related'. */
3414 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3416 Lisp_Object inherit
;
3418 Lisp_Object cycle_check
;
3420 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3421 /* Inherit from the named face INHERIT. */
3425 /* Make sure we're not in an inheritance loop. */
3426 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3427 if (NILP (cycle_check
))
3428 /* Cycle detected, ignore any further inheritance. */
3431 lface
= lface_from_face_name (f
, inherit
, 0);
3433 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3435 else if (CONSP (inherit
))
3436 /* Handle a list of inherited faces by calling ourselves recursively
3437 on each element. Note that we only do so for symbol elements, so
3438 it's not possible to infinitely recurse. */
3440 while (CONSP (inherit
))
3442 if (SYMBOLP (XCAR (inherit
)))
3443 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3445 /* Check for a circular inheritance list. */
3446 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3447 if (NILP (cycle_check
))
3448 /* Cycle detected. */
3451 inherit
= XCDR (inherit
);
3457 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3458 is a face property, determine the resulting face attributes on
3459 frame F, and store them in TO. PROP may be a single face
3460 specification or a list of such specifications. Each face
3461 specification can be
3463 1. A symbol or string naming a Lisp face.
3465 2. A property list of the form (KEYWORD VALUE ...) where each
3466 KEYWORD is a face attribute name, and value is an appropriate value
3469 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3470 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3471 for compatibility with 20.2.
3473 Face specifications earlier in lists take precedence over later
3477 merge_face_vector_with_property (f
, to
, prop
)
3484 Lisp_Object first
= XCAR (prop
);
3486 if (EQ (first
, Qforeground_color
)
3487 || EQ (first
, Qbackground_color
))
3489 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3490 . COLOR). COLOR must be a string. */
3491 Lisp_Object color_name
= XCDR (prop
);
3492 Lisp_Object color
= first
;
3494 if (STRINGP (color_name
))
3496 if (EQ (color
, Qforeground_color
))
3497 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3499 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3502 add_to_log ("Invalid face color", color_name
, Qnil
);
3504 else if (SYMBOLP (first
)
3505 && *XSYMBOL (first
)->name
->data
== ':')
3507 /* Assume this is the property list form. */
3508 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3510 Lisp_Object keyword
= XCAR (prop
);
3511 Lisp_Object value
= XCAR (XCDR (prop
));
3513 if (EQ (keyword
, QCfamily
))
3515 if (STRINGP (value
))
3516 to
[LFACE_FAMILY_INDEX
] = value
;
3518 add_to_log ("Invalid face font family", value
, Qnil
);
3520 else if (EQ (keyword
, QCheight
))
3522 Lisp_Object new_height
=
3523 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3526 if (NILP (new_height
))
3527 add_to_log ("Invalid face font height", value
, Qnil
);
3529 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3531 else if (EQ (keyword
, QCweight
))
3534 && face_numeric_weight (value
) >= 0)
3535 to
[LFACE_WEIGHT_INDEX
] = value
;
3537 add_to_log ("Invalid face weight", value
, Qnil
);
3539 else if (EQ (keyword
, QCslant
))
3542 && face_numeric_slant (value
) >= 0)
3543 to
[LFACE_SLANT_INDEX
] = value
;
3545 add_to_log ("Invalid face slant", value
, Qnil
);
3547 else if (EQ (keyword
, QCunderline
))
3552 to
[LFACE_UNDERLINE_INDEX
] = value
;
3554 add_to_log ("Invalid face underline", value
, Qnil
);
3556 else if (EQ (keyword
, QCoverline
))
3561 to
[LFACE_OVERLINE_INDEX
] = value
;
3563 add_to_log ("Invalid face overline", value
, Qnil
);
3565 else if (EQ (keyword
, QCstrike_through
))
3570 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3572 add_to_log ("Invalid face strike-through", value
, Qnil
);
3574 else if (EQ (keyword
, QCbox
))
3577 value
= make_number (1);
3578 if (INTEGERP (value
)
3582 to
[LFACE_BOX_INDEX
] = value
;
3584 add_to_log ("Invalid face box", value
, Qnil
);
3586 else if (EQ (keyword
, QCinverse_video
)
3587 || EQ (keyword
, QCreverse_video
))
3589 if (EQ (value
, Qt
) || NILP (value
))
3590 to
[LFACE_INVERSE_INDEX
] = value
;
3592 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3594 else if (EQ (keyword
, QCforeground
))
3596 if (STRINGP (value
))
3597 to
[LFACE_FOREGROUND_INDEX
] = value
;
3599 add_to_log ("Invalid face foreground", value
, Qnil
);
3601 else if (EQ (keyword
, QCbackground
))
3603 if (STRINGP (value
))
3604 to
[LFACE_BACKGROUND_INDEX
] = value
;
3606 add_to_log ("Invalid face background", value
, Qnil
);
3608 else if (EQ (keyword
, QCstipple
))
3610 #ifdef HAVE_X_WINDOWS
3611 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3612 if (!NILP (pixmap_p
))
3613 to
[LFACE_STIPPLE_INDEX
] = value
;
3615 add_to_log ("Invalid face stipple", value
, Qnil
);
3618 else if (EQ (keyword
, QCwidth
))
3621 && face_numeric_swidth (value
) >= 0)
3622 to
[LFACE_SWIDTH_INDEX
] = value
;
3624 add_to_log ("Invalid face width", value
, Qnil
);
3626 else if (EQ (keyword
, QCinherit
))
3628 if (SYMBOLP (value
))
3629 to
[LFACE_INHERIT_INDEX
] = value
;
3633 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3634 if (!SYMBOLP (XCAR (tail
)))
3637 to
[LFACE_INHERIT_INDEX
] = value
;
3639 add_to_log ("Invalid face inherit", value
, Qnil
);
3643 add_to_log ("Invalid attribute %s in face property",
3646 prop
= XCDR (XCDR (prop
));
3651 /* This is a list of face specs. Specifications at the
3652 beginning of the list take precedence over later
3653 specifications, so we have to merge starting with the
3654 last specification. */
3655 Lisp_Object next
= XCDR (prop
);
3657 merge_face_vector_with_property (f
, to
, next
);
3658 merge_face_vector_with_property (f
, to
, first
);
3663 /* PROP ought to be a face name. */
3664 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3666 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3668 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3673 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3674 Sinternal_make_lisp_face
, 1, 2, 0,
3675 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3676 If FACE was not known as a face before, create a new one.
3677 If optional argument FRAME is specified, make a frame-local face
3678 for that frame. Otherwise operate on the global face definition.
3679 Value is a vector of face attributes. */)
3681 Lisp_Object face
, frame
;
3683 Lisp_Object global_lface
, lface
;
3687 CHECK_SYMBOL (face
);
3688 global_lface
= lface_from_face_name (NULL
, face
, 0);
3692 CHECK_LIVE_FRAME (frame
);
3694 lface
= lface_from_face_name (f
, face
, 0);
3697 f
= NULL
, lface
= Qnil
;
3699 /* Add a global definition if there is none. */
3700 if (NILP (global_lface
))
3702 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3704 AREF (global_lface
, 0) = Qface
;
3705 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3706 Vface_new_frame_defaults
);
3708 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3709 face id to Lisp face is given by the vector lface_id_to_name.
3710 The mapping from Lisp face to Lisp face id is given by the
3711 property `face' of the Lisp face name. */
3712 if (next_lface_id
== lface_id_to_name_size
)
3714 int new_size
= max (50, 2 * lface_id_to_name_size
);
3715 int sz
= new_size
* sizeof *lface_id_to_name
;
3716 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3717 lface_id_to_name_size
= new_size
;
3720 lface_id_to_name
[next_lface_id
] = face
;
3721 Fput (face
, Qface
, make_number (next_lface_id
));
3725 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3726 AREF (global_lface
, i
) = Qunspecified
;
3728 /* Add a frame-local definition. */
3733 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3735 AREF (lface
, 0) = Qface
;
3736 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3739 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3740 AREF (lface
, i
) = Qunspecified
;
3743 lface
= global_lface
;
3745 /* Changing a named face means that all realized faces depending on
3746 that face are invalid. Since we cannot tell which realized faces
3747 depend on the face, make sure they are all removed. This is done
3748 by incrementing face_change_count. The next call to
3749 init_iterator will then free realized faces. */
3750 ++face_change_count
;
3751 ++windows_or_buffers_changed
;
3753 xassert (LFACEP (lface
));
3754 check_lface (lface
);
3759 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3760 Sinternal_lisp_face_p
, 1, 2, 0,
3761 doc
: /* Return non-nil if FACE names a face.
3762 If optional second parameter FRAME is non-nil, check for the
3763 existence of a frame-local face with name FACE on that frame.
3764 Otherwise check for the existence of a global face. */)
3766 Lisp_Object face
, frame
;
3772 CHECK_LIVE_FRAME (frame
);
3773 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3776 lface
= lface_from_face_name (NULL
, face
, 0);
3782 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3783 Sinternal_copy_lisp_face
, 4, 4, 0,
3784 doc
: /* Copy face FROM to TO.
3785 If FRAME it t, copy the global face definition of FROM to the
3786 global face definition of TO. Otherwise, copy the frame-local
3787 definition of FROM on FRAME to the frame-local definition of TO
3788 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3791 (from
, to
, frame
, new_frame
)
3792 Lisp_Object from
, to
, frame
, new_frame
;
3794 Lisp_Object lface
, copy
;
3796 CHECK_SYMBOL (from
);
3798 if (NILP (new_frame
))
3803 /* Copy global definition of FROM. We don't make copies of
3804 strings etc. because 20.2 didn't do it either. */
3805 lface
= lface_from_face_name (NULL
, from
, 1);
3806 copy
= Finternal_make_lisp_face (to
, Qnil
);
3810 /* Copy frame-local definition of FROM. */
3811 CHECK_LIVE_FRAME (frame
);
3812 CHECK_LIVE_FRAME (new_frame
);
3813 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3814 copy
= Finternal_make_lisp_face (to
, new_frame
);
3817 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3818 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3820 /* Changing a named face means that all realized faces depending on
3821 that face are invalid. Since we cannot tell which realized faces
3822 depend on the face, make sure they are all removed. This is done
3823 by incrementing face_change_count. The next call to
3824 init_iterator will then free realized faces. */
3825 ++face_change_count
;
3826 ++windows_or_buffers_changed
;
3832 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3833 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3834 doc
: /* Set attribute ATTR of FACE to VALUE.
3835 FRAME being a frame means change the face on that frame.
3836 FRAME nil means change the face of the selected frame.
3837 FRAME t means change the default for new frames.
3838 FRAME 0 means change the face on all frames, and change the default
3840 (face
, attr
, value
, frame
)
3841 Lisp_Object face
, attr
, value
, frame
;
3844 Lisp_Object old_value
= Qnil
;
3845 /* Set 1 if ATTR is QCfont. */
3846 int font_attr_p
= 0;
3847 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3848 int font_related_attr_p
= 0;
3850 CHECK_SYMBOL (face
);
3851 CHECK_SYMBOL (attr
);
3853 face
= resolve_face_name (face
);
3855 /* If FRAME is 0, change face on all frames, and change the
3856 default for new frames. */
3857 if (INTEGERP (frame
) && XINT (frame
) == 0)
3860 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3861 FOR_EACH_FRAME (tail
, frame
)
3862 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3866 /* Set lface to the Lisp attribute vector of FACE. */
3868 lface
= lface_from_face_name (NULL
, face
, 1);
3872 frame
= selected_frame
;
3874 CHECK_LIVE_FRAME (frame
);
3875 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3877 /* If a frame-local face doesn't exist yet, create one. */
3879 lface
= Finternal_make_lisp_face (face
, frame
);
3882 if (EQ (attr
, QCfamily
))
3884 if (!UNSPECIFIEDP (value
))
3886 CHECK_STRING (value
);
3887 if (XSTRING (value
)->size
== 0)
3888 signal_error ("Invalid face family", value
);
3890 old_value
= LFACE_FAMILY (lface
);
3891 LFACE_FAMILY (lface
) = value
;
3892 font_related_attr_p
= 1;
3894 else if (EQ (attr
, QCheight
))
3896 if (!UNSPECIFIEDP (value
))
3900 test
= (EQ (face
, Qdefault
)
3902 /* The default face must have an absolute size,
3903 otherwise, we do a test merge with a random
3904 height to see if VALUE's ok. */
3905 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3907 if (!INTEGERP (test
) || XINT (test
) <= 0)
3908 signal_error ("Invalid face height", value
);
3911 old_value
= LFACE_HEIGHT (lface
);
3912 LFACE_HEIGHT (lface
) = value
;
3913 font_related_attr_p
= 1;
3915 else if (EQ (attr
, QCweight
))
3917 if (!UNSPECIFIEDP (value
))
3919 CHECK_SYMBOL (value
);
3920 if (face_numeric_weight (value
) < 0)
3921 signal_error ("Invalid face weight", value
);
3923 old_value
= LFACE_WEIGHT (lface
);
3924 LFACE_WEIGHT (lface
) = value
;
3925 font_related_attr_p
= 1;
3927 else if (EQ (attr
, QCslant
))
3929 if (!UNSPECIFIEDP (value
))
3931 CHECK_SYMBOL (value
);
3932 if (face_numeric_slant (value
) < 0)
3933 signal_error ("Invalid face slant", value
);
3935 old_value
= LFACE_SLANT (lface
);
3936 LFACE_SLANT (lface
) = value
;
3937 font_related_attr_p
= 1;
3939 else if (EQ (attr
, QCunderline
))
3941 if (!UNSPECIFIEDP (value
))
3942 if ((SYMBOLP (value
)
3944 && !EQ (value
, Qnil
))
3945 /* Underline color. */
3947 && XSTRING (value
)->size
== 0))
3948 signal_error ("Invalid face underline", value
);
3950 old_value
= LFACE_UNDERLINE (lface
);
3951 LFACE_UNDERLINE (lface
) = value
;
3953 else if (EQ (attr
, QCoverline
))
3955 if (!UNSPECIFIEDP (value
))
3956 if ((SYMBOLP (value
)
3958 && !EQ (value
, Qnil
))
3959 /* Overline color. */
3961 && XSTRING (value
)->size
== 0))
3962 signal_error ("Invalid face overline", value
);
3964 old_value
= LFACE_OVERLINE (lface
);
3965 LFACE_OVERLINE (lface
) = value
;
3967 else if (EQ (attr
, QCstrike_through
))
3969 if (!UNSPECIFIEDP (value
))
3970 if ((SYMBOLP (value
)
3972 && !EQ (value
, Qnil
))
3973 /* Strike-through color. */
3975 && XSTRING (value
)->size
== 0))
3976 signal_error ("Invalid face strike-through", value
);
3978 old_value
= LFACE_STRIKE_THROUGH (lface
);
3979 LFACE_STRIKE_THROUGH (lface
) = value
;
3981 else if (EQ (attr
, QCbox
))
3985 /* Allow t meaning a simple box of width 1 in foreground color
3988 value
= make_number (1);
3990 if (UNSPECIFIEDP (value
))
3992 else if (NILP (value
))
3994 else if (INTEGERP (value
))
3995 valid_p
= XINT (value
) != 0;
3996 else if (STRINGP (value
))
3997 valid_p
= XSTRING (value
)->size
> 0;
3998 else if (CONSP (value
))
4014 if (EQ (k
, QCline_width
))
4016 if (!INTEGERP (v
) || XINT (v
) == 0)
4019 else if (EQ (k
, QCcolor
))
4021 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
4024 else if (EQ (k
, QCstyle
))
4026 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4033 valid_p
= NILP (tem
);
4039 signal_error ("Invalid face box", value
);
4041 old_value
= LFACE_BOX (lface
);
4042 LFACE_BOX (lface
) = value
;
4044 else if (EQ (attr
, QCinverse_video
)
4045 || EQ (attr
, QCreverse_video
))
4047 if (!UNSPECIFIEDP (value
))
4049 CHECK_SYMBOL (value
);
4050 if (!EQ (value
, Qt
) && !NILP (value
))
4051 signal_error ("Invalid inverse-video face attribute value", value
);
4053 old_value
= LFACE_INVERSE (lface
);
4054 LFACE_INVERSE (lface
) = value
;
4056 else if (EQ (attr
, QCforeground
))
4058 if (!UNSPECIFIEDP (value
))
4060 /* Don't check for valid color names here because it depends
4061 on the frame (display) whether the color will be valid
4062 when the face is realized. */
4063 CHECK_STRING (value
);
4064 if (XSTRING (value
)->size
== 0)
4065 signal_error ("Empty foreground color value", value
);
4067 old_value
= LFACE_FOREGROUND (lface
);
4068 LFACE_FOREGROUND (lface
) = value
;
4070 else if (EQ (attr
, QCbackground
))
4072 if (!UNSPECIFIEDP (value
))
4074 /* Don't check for valid color names here because it depends
4075 on the frame (display) whether the color will be valid
4076 when the face is realized. */
4077 CHECK_STRING (value
);
4078 if (XSTRING (value
)->size
== 0)
4079 signal_error ("Empty background color value", value
);
4081 old_value
= LFACE_BACKGROUND (lface
);
4082 LFACE_BACKGROUND (lface
) = value
;
4084 else if (EQ (attr
, QCstipple
))
4086 #ifdef HAVE_X_WINDOWS
4087 if (!UNSPECIFIEDP (value
)
4089 && NILP (Fbitmap_spec_p (value
)))
4090 signal_error ("Invalid stipple attribute", value
);
4091 old_value
= LFACE_STIPPLE (lface
);
4092 LFACE_STIPPLE (lface
) = value
;
4093 #endif /* HAVE_X_WINDOWS */
4095 else if (EQ (attr
, QCwidth
))
4097 if (!UNSPECIFIEDP (value
))
4099 CHECK_SYMBOL (value
);
4100 if (face_numeric_swidth (value
) < 0)
4101 signal_error ("Invalid face width", value
);
4103 old_value
= LFACE_SWIDTH (lface
);
4104 LFACE_SWIDTH (lface
) = value
;
4105 font_related_attr_p
= 1;
4107 else if (EQ (attr
, QCfont
))
4109 #ifdef HAVE_WINDOW_SYSTEM
4110 if (FRAME_WINDOW_P (XFRAME (frame
)))
4112 /* Set font-related attributes of the Lisp face from an XLFD
4117 CHECK_STRING (value
);
4119 f
= SELECTED_FRAME ();
4121 f
= check_x_frame (frame
);
4123 /* VALUE may be a fontset name or an alias of fontset. In
4124 such a case, use the base fontset name. */
4125 tmp
= Fquery_fontset (value
, Qnil
);
4129 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4130 signal_error ("Invalid font or fontset name", value
);
4134 #endif /* HAVE_WINDOW_SYSTEM */
4136 else if (EQ (attr
, QCinherit
))
4139 if (SYMBOLP (value
))
4142 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4143 if (!SYMBOLP (XCAR (tail
)))
4146 LFACE_INHERIT (lface
) = value
;
4148 signal_error ("Invalid face inheritance", value
);
4150 else if (EQ (attr
, QCbold
))
4152 old_value
= LFACE_WEIGHT (lface
);
4153 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4154 font_related_attr_p
= 1;
4156 else if (EQ (attr
, QCitalic
))
4158 old_value
= LFACE_SLANT (lface
);
4159 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4160 font_related_attr_p
= 1;
4163 signal_error ("Invalid face attribute name", attr
);
4165 if (font_related_attr_p
4166 && !UNSPECIFIEDP (value
))
4167 /* If a font-related attribute other than QCfont is specified, the
4168 original `font' attribute nor that of default face is useless
4169 to determine a new font. Thus, we set it to nil so that font
4170 selection mechanism doesn't use it. */
4171 LFACE_FONT (lface
) = Qnil
;
4173 /* Changing a named face means that all realized faces depending on
4174 that face are invalid. Since we cannot tell which realized faces
4175 depend on the face, make sure they are all removed. This is done
4176 by incrementing face_change_count. The next call to
4177 init_iterator will then free realized faces. */
4179 && (EQ (attr
, QCfont
)
4180 || NILP (Fequal (old_value
, value
))))
4182 ++face_change_count
;
4183 ++windows_or_buffers_changed
;
4186 if (!UNSPECIFIEDP (value
)
4187 && NILP (Fequal (old_value
, value
)))
4193 if (EQ (face
, Qdefault
))
4195 #ifdef HAVE_WINDOW_SYSTEM
4196 /* Changed font-related attributes of the `default' face are
4197 reflected in changed `font' frame parameters. */
4199 && (font_related_attr_p
|| font_attr_p
)
4200 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4201 set_font_frame_param (frame
, lface
);
4203 #endif /* HAVE_WINDOW_SYSTEM */
4205 if (EQ (attr
, QCforeground
))
4206 param
= Qforeground_color
;
4207 else if (EQ (attr
, QCbackground
))
4208 param
= Qbackground_color
;
4210 #ifdef HAVE_WINDOW_SYSTEM
4212 else if (EQ (face
, Qscroll_bar
))
4214 /* Changing the colors of `scroll-bar' sets frame parameters
4215 `scroll-bar-foreground' and `scroll-bar-background'. */
4216 if (EQ (attr
, QCforeground
))
4217 param
= Qscroll_bar_foreground
;
4218 else if (EQ (attr
, QCbackground
))
4219 param
= Qscroll_bar_background
;
4221 #endif /* not WINDOWSNT */
4222 else if (EQ (face
, Qborder
))
4224 /* Changing background color of `border' sets frame parameter
4226 if (EQ (attr
, QCbackground
))
4227 param
= Qborder_color
;
4229 else if (EQ (face
, Qcursor
))
4231 /* Changing background color of `cursor' sets frame parameter
4233 if (EQ (attr
, QCbackground
))
4234 param
= Qcursor_color
;
4236 else if (EQ (face
, Qmouse
))
4238 /* Changing background color of `mouse' sets frame parameter
4240 if (EQ (attr
, QCbackground
))
4241 param
= Qmouse_color
;
4243 #endif /* HAVE_WINDOW_SYSTEM */
4244 else if (EQ (face
, Qmenu
))
4246 /* Indicate that we have to update the menu bar when
4247 realizing faces on FRAME. FRAME t change the
4248 default for new frames. We do this by setting
4249 setting the flag in new face caches */
4252 struct frame
*f
= XFRAME (frame
);
4253 if (FRAME_FACE_CACHE (f
) == NULL
)
4254 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4255 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4258 menu_face_changed_default
= 1;
4264 /* Update `default-frame-alist', which is used for new frames. */
4266 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4269 /* Update the current frame's parameters. */
4272 cons
= XCAR (Vparam_value_alist
);
4273 XSETCAR (cons
, param
);
4274 XSETCDR (cons
, value
);
4275 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4284 #ifdef HAVE_WINDOW_SYSTEM
4286 /* Set the `font' frame parameter of FRAME determined from `default'
4287 face attributes LFACE. If a face or fontset name is explicitely
4288 specfied in LFACE, use it as is. Otherwise, determine a font name
4289 from the other font-related atrributes of LFACE. In that case, if
4290 there's no matching font, signals an error. */
4293 set_font_frame_param (frame
, lface
)
4294 Lisp_Object frame
, lface
;
4296 struct frame
*f
= XFRAME (frame
);
4298 if (FRAME_WINDOW_P (f
))
4300 Lisp_Object font_name
;
4303 if (STRINGP (LFACE_FONT (lface
)))
4304 font_name
= LFACE_FONT (lface
);
4307 /* Choose a font name that reflects LFACE's attributes and has
4308 the registry and encoding pattern specified in the default
4309 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4310 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, NULL
, 0);
4312 error ("No font matches the specified attribute");
4313 font_name
= build_string (font
);
4317 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4322 /* Update the corresponding face when frame parameter PARAM on frame F
4323 has been assigned the value NEW_VALUE. */
4326 update_face_from_frame_parameter (f
, param
, new_value
)
4328 Lisp_Object param
, new_value
;
4332 /* If there are no faces yet, give up. This is the case when called
4333 from Fx_create_frame, and we do the necessary things later in
4334 face-set-after-frame-defaults. */
4335 if (NILP (f
->face_alist
))
4338 /* Changing a named face means that all realized faces depending on
4339 that face are invalid. Since we cannot tell which realized faces
4340 depend on the face, make sure they are all removed. This is done
4341 by incrementing face_change_count. The next call to
4342 init_iterator will then free realized faces. */
4343 ++face_change_count
;
4344 ++windows_or_buffers_changed
;
4346 if (EQ (param
, Qforeground_color
))
4348 lface
= lface_from_face_name (f
, Qdefault
, 1);
4349 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4350 ? new_value
: Qunspecified
);
4351 realize_basic_faces (f
);
4353 else if (EQ (param
, Qbackground_color
))
4357 /* Changing the background color might change the background
4358 mode, so that we have to load new defface specs. Call
4359 frame-update-face-colors to do that. */
4360 XSETFRAME (frame
, f
);
4361 call1 (Qframe_update_face_colors
, frame
);
4363 lface
= lface_from_face_name (f
, Qdefault
, 1);
4364 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4365 ? new_value
: Qunspecified
);
4366 realize_basic_faces (f
);
4368 if (EQ (param
, Qborder_color
))
4370 lface
= lface_from_face_name (f
, Qborder
, 1);
4371 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4372 ? new_value
: Qunspecified
);
4374 else if (EQ (param
, Qcursor_color
))
4376 lface
= lface_from_face_name (f
, Qcursor
, 1);
4377 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4378 ? new_value
: Qunspecified
);
4380 else if (EQ (param
, Qmouse_color
))
4382 lface
= lface_from_face_name (f
, Qmouse
, 1);
4383 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4384 ? new_value
: Qunspecified
);
4389 /* Get the value of X resource RESOURCE, class CLASS for the display
4390 of frame FRAME. This is here because ordinary `x-get-resource'
4391 doesn't take a frame argument. */
4393 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4394 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4395 (resource
, class, frame
)
4396 Lisp_Object resource
, class, frame
;
4398 Lisp_Object value
= Qnil
;
4401 CHECK_STRING (resource
);
4402 CHECK_STRING (class);
4403 CHECK_LIVE_FRAME (frame
);
4405 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4406 resource
, class, Qnil
, Qnil
);
4408 #endif /* not macintosh */
4409 #endif /* not WINDOWSNT */
4414 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4415 If VALUE is "on" or "true", return t. If VALUE is "off" or
4416 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4417 error; if SIGNAL_P is zero, return 0. */
4420 face_boolean_x_resource_value (value
, signal_p
)
4424 Lisp_Object result
= make_number (0);
4426 xassert (STRINGP (value
));
4428 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4429 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4431 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4432 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4434 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4435 result
= Qunspecified
;
4437 signal_error ("Invalid face attribute value from X resource", value
);
4443 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4444 Finternal_set_lisp_face_attribute_from_resource
,
4445 Sinternal_set_lisp_face_attribute_from_resource
,
4446 3, 4, 0, doc
: /* */)
4447 (face
, attr
, value
, frame
)
4448 Lisp_Object face
, attr
, value
, frame
;
4450 CHECK_SYMBOL (face
);
4451 CHECK_SYMBOL (attr
);
4452 CHECK_STRING (value
);
4454 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4455 value
= Qunspecified
;
4456 else if (EQ (attr
, QCheight
))
4458 value
= Fstring_to_number (value
, make_number (10));
4459 if (XINT (value
) <= 0)
4460 signal_error ("Invalid face height from X resource", value
);
4462 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4463 value
= face_boolean_x_resource_value (value
, 1);
4464 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4465 value
= intern (XSTRING (value
)->data
);
4466 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4467 value
= face_boolean_x_resource_value (value
, 1);
4468 else if (EQ (attr
, QCunderline
)
4469 || EQ (attr
, QCoverline
)
4470 || EQ (attr
, QCstrike_through
))
4472 Lisp_Object boolean_value
;
4474 /* If the result of face_boolean_x_resource_value is t or nil,
4475 VALUE does NOT specify a color. */
4476 boolean_value
= face_boolean_x_resource_value (value
, 0);
4477 if (SYMBOLP (boolean_value
))
4478 value
= boolean_value
;
4480 else if (EQ (attr
, QCbox
))
4481 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4483 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4486 #endif /* HAVE_WINDOW_SYSTEM */
4489 /***********************************************************************
4491 ***********************************************************************/
4493 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4495 /* Make menus on frame F appear as specified by the `menu' face. */
4498 x_update_menu_appearance (f
)
4501 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4505 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4509 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4510 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4511 char *myname
= XSTRING (Vx_resource_name
)->data
;
4514 const char *popup_path
= "popup_menu";
4516 const char *popup_path
= "menu.popup";
4519 if (STRINGP (LFACE_FOREGROUND (lface
)))
4521 sprintf (line
, "%s.%s*foreground: %s",
4523 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4524 XrmPutLineResource (&rdb
, line
);
4525 sprintf (line
, "%s.pane.menubar*foreground: %s",
4526 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4527 XrmPutLineResource (&rdb
, line
);
4531 if (STRINGP (LFACE_BACKGROUND (lface
)))
4533 sprintf (line
, "%s.%s*background: %s",
4535 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4536 XrmPutLineResource (&rdb
, line
);
4537 sprintf (line
, "%s.pane.menubar*background: %s",
4538 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4539 XrmPutLineResource (&rdb
, line
);
4544 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4545 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4546 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4547 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4548 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4549 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4552 const char *suffix
= "List";
4554 const char *suffix
= "";
4556 sprintf (line
, "%s.pane.menubar*font%s: %s",
4557 myname
, suffix
, face
->font_name
);
4558 XrmPutLineResource (&rdb
, line
);
4559 sprintf (line
, "%s.%s*font%s: %s",
4560 myname
, popup_path
, suffix
, face
->font_name
);
4561 XrmPutLineResource (&rdb
, line
);
4565 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4566 free_frame_menubar (f
);
4570 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4573 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4574 Sface_attribute_relative_p
,
4576 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4578 Lisp_Object attribute
, value
;
4580 if (EQ (value
, Qunspecified
))
4582 else if (EQ (attribute
, QCheight
))
4583 return INTEGERP (value
) ? Qnil
: Qt
;
4588 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4590 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4591 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4592 the result will be absolute, otherwise it will be relative. */)
4593 (attribute
, value1
, value2
)
4594 Lisp_Object attribute
, value1
, value2
;
4596 if (EQ (value1
, Qunspecified
))
4598 else if (EQ (attribute
, QCheight
))
4599 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4605 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4606 Sinternal_get_lisp_face_attribute
,
4608 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4609 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4610 face attribute name, signal an error.
4611 If the optional argument FRAME is given, report on face FACE in that
4612 frame. If FRAME is t, report on the defaults for face FACE (for new
4613 frames). If FRAME is omitted or nil, use the selected frame. */)
4614 (symbol
, keyword
, frame
)
4615 Lisp_Object symbol
, keyword
, frame
;
4617 Lisp_Object lface
, value
= Qnil
;
4619 CHECK_SYMBOL (symbol
);
4620 CHECK_SYMBOL (keyword
);
4623 lface
= lface_from_face_name (NULL
, symbol
, 1);
4627 frame
= selected_frame
;
4628 CHECK_LIVE_FRAME (frame
);
4629 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4632 if (EQ (keyword
, QCfamily
))
4633 value
= LFACE_FAMILY (lface
);
4634 else if (EQ (keyword
, QCheight
))
4635 value
= LFACE_HEIGHT (lface
);
4636 else if (EQ (keyword
, QCweight
))
4637 value
= LFACE_WEIGHT (lface
);
4638 else if (EQ (keyword
, QCslant
))
4639 value
= LFACE_SLANT (lface
);
4640 else if (EQ (keyword
, QCunderline
))
4641 value
= LFACE_UNDERLINE (lface
);
4642 else if (EQ (keyword
, QCoverline
))
4643 value
= LFACE_OVERLINE (lface
);
4644 else if (EQ (keyword
, QCstrike_through
))
4645 value
= LFACE_STRIKE_THROUGH (lface
);
4646 else if (EQ (keyword
, QCbox
))
4647 value
= LFACE_BOX (lface
);
4648 else if (EQ (keyword
, QCinverse_video
)
4649 || EQ (keyword
, QCreverse_video
))
4650 value
= LFACE_INVERSE (lface
);
4651 else if (EQ (keyword
, QCforeground
))
4652 value
= LFACE_FOREGROUND (lface
);
4653 else if (EQ (keyword
, QCbackground
))
4654 value
= LFACE_BACKGROUND (lface
);
4655 else if (EQ (keyword
, QCstipple
))
4656 value
= LFACE_STIPPLE (lface
);
4657 else if (EQ (keyword
, QCwidth
))
4658 value
= LFACE_SWIDTH (lface
);
4659 else if (EQ (keyword
, QCinherit
))
4660 value
= LFACE_INHERIT (lface
);
4661 else if (EQ (keyword
, QCfont
))
4662 value
= LFACE_FONT (lface
);
4664 signal_error ("Invalid face attribute name", keyword
);
4670 DEFUN ("internal-lisp-face-attribute-values",
4671 Finternal_lisp_face_attribute_values
,
4672 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4673 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4674 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4678 Lisp_Object result
= Qnil
;
4680 CHECK_SYMBOL (attr
);
4682 if (EQ (attr
, QCweight
)
4683 || EQ (attr
, QCslant
)
4684 || EQ (attr
, QCwidth
))
4686 /* Extract permissible symbols from tables. */
4687 struct table_entry
*table
;
4690 if (EQ (attr
, QCweight
))
4691 table
= weight_table
, dim
= DIM (weight_table
);
4692 else if (EQ (attr
, QCslant
))
4693 table
= slant_table
, dim
= DIM (slant_table
);
4695 table
= swidth_table
, dim
= DIM (swidth_table
);
4697 for (i
= 0; i
< dim
; ++i
)
4699 Lisp_Object symbol
= *table
[i
].symbol
;
4700 Lisp_Object tail
= result
;
4703 && !EQ (XCAR (tail
), symbol
))
4707 result
= Fcons (symbol
, result
);
4710 else if (EQ (attr
, QCunderline
))
4711 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4712 else if (EQ (attr
, QCoverline
))
4713 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4714 else if (EQ (attr
, QCstrike_through
))
4715 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4716 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4717 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4723 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4724 Sinternal_merge_in_global_face
, 2, 2, 0,
4725 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4726 Default face attributes override any local face attributes. */)
4728 Lisp_Object face
, frame
;
4731 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4733 CHECK_LIVE_FRAME (frame
);
4734 global_lface
= lface_from_face_name (NULL
, face
, 1);
4735 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4736 if (NILP (local_lface
))
4737 local_lface
= Finternal_make_lisp_face (face
, frame
);
4739 /* Make every specified global attribute override the local one.
4740 BEWARE!! This is only used from `face-set-after-frame-default' where
4741 the local frame is defined from default specs in `face-defface-spec'
4742 and those should be overridden by global settings. Hence the strange
4743 "global before local" priority. */
4744 lvec
= XVECTOR (local_lface
)->contents
;
4745 gvec
= XVECTOR (global_lface
)->contents
;
4746 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4747 if (! UNSPECIFIEDP (gvec
[i
]))
4754 /* The following function is implemented for compatibility with 20.2.
4755 The function is used in x-resolve-fonts when it is asked to
4756 return fonts with the same size as the font of a face. This is
4757 done in fontset.el. */
4759 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4760 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4761 If the optional argument FRAME is given, report on face FACE in that frame.
4762 If FRAME is t, report on the defaults for face FACE (for new frames).
4763 The font default for a face is either nil, or a list
4764 of the form (bold), (italic) or (bold italic).
4765 If FRAME is omitted or nil, use the selected frame. */)
4767 Lisp_Object face
, frame
;
4771 Lisp_Object result
= Qnil
;
4772 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4774 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4775 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4776 result
= Fcons (Qbold
, result
);
4778 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4779 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4780 result
= Fcons (Qitalic
, result
);
4786 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4787 int face_id
= lookup_named_face (f
, face
, 0);
4788 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4789 return face
? build_string (face
->font_name
) : Qnil
;
4794 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4795 all attributes are `equal'. Tries to be fast because this function
4796 is called quite often. */
4799 lface_equal_p (v1
, v2
)
4800 Lisp_Object
*v1
, *v2
;
4804 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4806 Lisp_Object a
= v1
[i
];
4807 Lisp_Object b
= v2
[i
];
4809 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4810 and the other is specified. */
4811 equal_p
= XTYPE (a
) == XTYPE (b
);
4820 equal_p
= ((STRING_BYTES (XSTRING (a
))
4821 == STRING_BYTES (XSTRING (b
)))
4822 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4823 STRING_BYTES (XSTRING (a
))) == 0);
4832 equal_p
= !NILP (Fequal (a
, b
));
4842 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4843 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4844 doc
: /* True if FACE1 and FACE2 are equal.
4845 If the optional argument FRAME is given, report on face FACE in that frame.
4846 If FRAME is t, report on the defaults for face FACE (for new frames).
4847 If FRAME is omitted or nil, use the selected frame. */)
4848 (face1
, face2
, frame
)
4849 Lisp_Object face1
, face2
, frame
;
4853 Lisp_Object lface1
, lface2
;
4858 /* Don't use check_x_frame here because this function is called
4859 before X frames exist. At that time, if FRAME is nil,
4860 selected_frame will be used which is the frame dumped with
4861 Emacs. That frame is not an X frame. */
4862 f
= frame_or_selected_frame (frame
, 2);
4864 lface1
= lface_from_face_name (NULL
, face1
, 1);
4865 lface2
= lface_from_face_name (NULL
, face2
, 1);
4866 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4867 XVECTOR (lface2
)->contents
);
4868 return equal_p
? Qt
: Qnil
;
4872 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4873 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4874 doc
: /* True if FACE has no attribute specified.
4875 If the optional argument FRAME is given, report on face FACE in that frame.
4876 If FRAME is t, report on the defaults for face FACE (for new frames).
4877 If FRAME is omitted or nil, use the selected frame. */)
4879 Lisp_Object face
, frame
;
4886 frame
= selected_frame
;
4887 CHECK_LIVE_FRAME (frame
);
4891 lface
= lface_from_face_name (NULL
, face
, 1);
4893 lface
= lface_from_face_name (f
, face
, 1);
4895 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4896 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4899 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4903 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4905 doc
: /* Return an alist of frame-local faces defined on FRAME.
4906 For internal use only. */)
4910 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4911 return f
->face_alist
;
4915 /* Return a hash code for Lisp string STRING with case ignored. Used
4916 below in computing a hash value for a Lisp face. */
4918 static INLINE
unsigned
4919 hash_string_case_insensitive (string
)
4924 xassert (STRINGP (string
));
4925 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4926 hash
= (hash
<< 1) ^ tolower (*s
);
4931 /* Return a hash code for face attribute vector V. */
4933 static INLINE
unsigned
4937 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4938 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4939 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4940 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4941 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4942 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4943 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4947 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4948 considering charsets/registries). They do if they specify the same
4949 family, point size, weight, width, slant, and fontset. Both LFACE1
4950 and LFACE2 must be fully-specified. */
4953 lface_same_font_attributes_p (lface1
, lface2
)
4954 Lisp_Object
*lface1
, *lface2
;
4956 xassert (lface_fully_specified_p (lface1
)
4957 && lface_fully_specified_p (lface2
));
4958 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4959 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4960 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4961 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4962 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4963 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4964 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4965 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4966 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4967 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4968 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4969 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4974 /***********************************************************************
4976 ***********************************************************************/
4978 /* Allocate and return a new realized face for Lisp face attribute
4981 static struct face
*
4982 make_realized_face (attr
)
4985 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4986 bzero (face
, sizeof *face
);
4987 face
->ascii_face
= face
;
4988 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4993 /* Free realized face FACE, including its X resources. FACE may
4997 free_realized_face (f
, face
)
5003 #ifdef HAVE_WINDOW_SYSTEM
5004 if (FRAME_WINDOW_P (f
))
5006 /* Free fontset of FACE if it is ASCII face. */
5007 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5008 free_face_fontset (f
, face
);
5011 x_free_gc (f
, face
->gc
);
5015 free_face_colors (f
, face
);
5016 x_destroy_bitmap (f
, face
->stipple
);
5018 #endif /* HAVE_WINDOW_SYSTEM */
5025 /* Prepare face FACE for subsequent display on frame F. This
5026 allocated GCs if they haven't been allocated yet or have been freed
5027 by clearing the face cache. */
5030 prepare_face_for_display (f
, face
)
5034 #ifdef HAVE_WINDOW_SYSTEM
5035 xassert (FRAME_WINDOW_P (f
));
5040 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5042 xgcv
.foreground
= face
->foreground
;
5043 xgcv
.background
= face
->background
;
5044 #ifdef HAVE_X_WINDOWS
5045 xgcv
.graphics_exposures
= False
;
5047 /* The font of FACE may be null if we couldn't load it. */
5050 #ifdef HAVE_X_WINDOWS
5051 xgcv
.font
= face
->font
->fid
;
5054 xgcv
.font
= face
->font
;
5057 xgcv
.font
= face
->font
;
5063 #ifdef HAVE_X_WINDOWS
5066 xgcv
.fill_style
= FillOpaqueStippled
;
5067 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5068 mask
|= GCFillStyle
| GCStipple
;
5071 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5074 #endif /* HAVE_WINDOW_SYSTEM */
5078 /***********************************************************************
5080 ***********************************************************************/
5082 /* Return a new face cache for frame F. */
5084 static struct face_cache
*
5088 struct face_cache
*c
;
5091 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5092 bzero (c
, sizeof *c
);
5093 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5094 c
->buckets
= (struct face
**) xmalloc (size
);
5095 bzero (c
->buckets
, size
);
5097 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5099 c
->menu_face_changed_p
= menu_face_changed_default
;
5104 /* Clear out all graphics contexts for all realized faces, except for
5105 the basic faces. This should be done from time to time just to avoid
5106 keeping too many graphics contexts that are no longer needed. */
5110 struct face_cache
*c
;
5112 if (c
&& FRAME_WINDOW_P (c
->f
))
5114 #ifdef HAVE_WINDOW_SYSTEM
5116 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5118 struct face
*face
= c
->faces_by_id
[i
];
5119 if (face
&& face
->gc
)
5121 x_free_gc (c
->f
, face
->gc
);
5125 #endif /* HAVE_WINDOW_SYSTEM */
5130 /* Free all realized faces in face cache C, including basic faces. C
5131 may be null. If faces are freed, make sure the frame's current
5132 matrix is marked invalid, so that a display caused by an expose
5133 event doesn't try to use faces we destroyed. */
5136 free_realized_faces (c
)
5137 struct face_cache
*c
;
5142 struct frame
*f
= c
->f
;
5144 /* We must block input here because we can't process X events
5145 safely while only some faces are freed, or when the frame's
5146 current matrix still references freed faces. */
5149 for (i
= 0; i
< c
->used
; ++i
)
5151 free_realized_face (f
, c
->faces_by_id
[i
]);
5152 c
->faces_by_id
[i
] = NULL
;
5156 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5157 bzero (c
->buckets
, size
);
5159 /* Must do a thorough redisplay the next time. Mark current
5160 matrices as invalid because they will reference faces freed
5161 above. This function is also called when a frame is
5162 destroyed. In this case, the root window of F is nil. */
5163 if (WINDOWP (f
->root_window
))
5165 clear_current_matrices (f
);
5166 ++windows_or_buffers_changed
;
5174 /* Free all realized faces that are using FONTSET on frame F. */
5177 free_realized_faces_for_fontset (f
, fontset
)
5181 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5185 /* We must block input here because we can't process X events safely
5186 while only some faces are freed, or when the frame's current
5187 matrix still references freed faces. */
5190 for (i
= 0; i
< cache
->used
; i
++)
5192 face
= cache
->faces_by_id
[i
];
5194 && face
->fontset
== fontset
)
5196 uncache_face (cache
, face
);
5197 free_realized_face (f
, face
);
5201 /* Must do a thorough redisplay the next time. Mark current
5202 matrices as invalid because they will reference faces freed
5203 above. This function is also called when a frame is destroyed.
5204 In this case, the root window of F is nil. */
5205 if (WINDOWP (f
->root_window
))
5207 clear_current_matrices (f
);
5208 ++windows_or_buffers_changed
;
5215 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5216 This is done after attributes of a named face have been changed,
5217 because we can't tell which realized faces depend on that face. */
5220 free_all_realized_faces (frame
)
5226 FOR_EACH_FRAME (rest
, frame
)
5227 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5230 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5234 /* Free face cache C and faces in it, including their X resources. */
5238 struct face_cache
*c
;
5242 free_realized_faces (c
);
5244 xfree (c
->faces_by_id
);
5250 /* Cache realized face FACE in face cache C. HASH is the hash value
5251 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5252 collision list of the face hash table of C. This is done because
5253 otherwise lookup_face would find FACE for every character, even if
5254 faces with the same attributes but for specific characters exist. */
5257 cache_face (c
, face
, hash
)
5258 struct face_cache
*c
;
5262 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5266 if (face
->fontset
>= 0)
5268 struct face
*last
= c
->buckets
[i
];
5279 c
->buckets
[i
] = face
;
5280 face
->prev
= face
->next
= NULL
;
5286 face
->next
= c
->buckets
[i
];
5288 face
->next
->prev
= face
;
5289 c
->buckets
[i
] = face
;
5292 /* Find a free slot in C->faces_by_id and use the index of the free
5293 slot as FACE->id. */
5294 for (i
= 0; i
< c
->used
; ++i
)
5295 if (c
->faces_by_id
[i
] == NULL
)
5299 /* Maybe enlarge C->faces_by_id. */
5300 if (i
== c
->used
&& c
->used
== c
->size
)
5302 int new_size
= 2 * c
->size
;
5303 int sz
= new_size
* sizeof *c
->faces_by_id
;
5304 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5309 /* Check that FACE got a unique id. */
5314 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5315 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5321 #endif /* GLYPH_DEBUG */
5323 c
->faces_by_id
[i
] = face
;
5329 /* Remove face FACE from cache C. */
5332 uncache_face (c
, face
)
5333 struct face_cache
*c
;
5336 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5339 face
->prev
->next
= face
->next
;
5341 c
->buckets
[i
] = face
->next
;
5344 face
->next
->prev
= face
->prev
;
5346 c
->faces_by_id
[face
->id
] = NULL
;
5347 if (face
->id
== c
->used
)
5352 /* Look up a realized face with face attributes ATTR in the face cache
5353 of frame F. The face will be used to display character C. Value
5354 is the ID of the face found. If no suitable face is found, realize
5355 a new one. In that case, if C is a multibyte character, BASE_FACE
5356 is a face that has the same attributes. */
5359 lookup_face (f
, attr
, c
, base_face
)
5363 struct face
*base_face
;
5365 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5370 xassert (cache
!= NULL
);
5371 check_lface_attrs (attr
);
5373 /* Look up ATTR in the face cache. */
5374 hash
= lface_hash (attr
);
5375 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5377 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5378 if (face
->hash
== hash
5379 && (!FRAME_WINDOW_P (f
)
5380 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5381 && lface_equal_p (face
->lface
, attr
))
5384 /* If not found, realize a new face. */
5386 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5389 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5391 /* When this function is called from face_for_char (in this case, C is
5392 a multibyte character), a fontset of a face returned by
5393 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5394 C) is not sutisfied. The fontset is set for this face by
5395 face_for_char later. */
5397 if (FRAME_WINDOW_P (f
))
5398 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5400 #endif /* GLYPH_DEBUG */
5406 /* Return the face id of the realized face for named face SYMBOL on
5407 frame F suitable for displaying character C. Value is -1 if the
5408 face couldn't be determined, which might happen if the default face
5409 isn't realized and cannot be realized. */
5412 lookup_named_face (f
, symbol
, c
)
5417 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5418 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5419 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5421 if (default_face
== NULL
)
5423 if (!realize_basic_faces (f
))
5425 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5428 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5429 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5430 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5431 return lookup_face (f
, attrs
, c
, NULL
);
5435 /* Return the ID of the realized ASCII face of Lisp face with ID
5436 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5439 ascii_face_of_lisp_face (f
, lface_id
)
5445 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5447 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5448 face_id
= lookup_named_face (f
, face_name
, 0);
5457 /* Return a face for charset ASCII that is like the face with id
5458 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5459 STEPS < 0 means larger. Value is the id of the face. */
5462 smaller_face (f
, face_id
, steps
)
5466 #ifdef HAVE_WINDOW_SYSTEM
5468 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5469 int pt
, last_pt
, last_height
;
5472 struct face
*new_face
;
5474 /* If not called for an X frame, just return the original face. */
5475 if (FRAME_TERMCAP_P (f
))
5478 /* Try in increments of 1/2 pt. */
5479 delta
= steps
< 0 ? 5 : -5;
5480 steps
= abs (steps
);
5482 face
= FACE_FROM_ID (f
, face_id
);
5483 bcopy (face
->lface
, attrs
, sizeof attrs
);
5484 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5485 new_face_id
= face_id
;
5486 last_height
= FONT_HEIGHT (face
->font
);
5490 /* Give up if we cannot find a font within 10pt. */
5491 && abs (last_pt
- pt
) < 100)
5493 /* Look up a face for a slightly smaller/larger font. */
5495 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5496 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5497 new_face
= FACE_FROM_ID (f
, new_face_id
);
5499 /* If height changes, count that as one step. */
5500 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5501 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5504 last_height
= FONT_HEIGHT (new_face
->font
);
5511 #else /* not HAVE_WINDOW_SYSTEM */
5515 #endif /* not HAVE_WINDOW_SYSTEM */
5519 /* Return a face for charset ASCII that is like the face with id
5520 FACE_ID on frame F, but has height HEIGHT. */
5523 face_with_height (f
, face_id
, height
)
5528 #ifdef HAVE_WINDOW_SYSTEM
5530 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5532 if (FRAME_TERMCAP_P (f
)
5536 face
= FACE_FROM_ID (f
, face_id
);
5537 bcopy (face
->lface
, attrs
, sizeof attrs
);
5538 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5539 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5540 #endif /* HAVE_WINDOW_SYSTEM */
5546 /* Return the face id of the realized face for named face SYMBOL on
5547 frame F suitable for displaying character C, and use attributes of
5548 the face FACE_ID for attributes that aren't completely specified by
5549 SYMBOL. This is like lookup_named_face, except that the default
5550 attributes come from FACE_ID, not from the default face. FACE_ID
5551 is assumed to be already realized. */
5554 lookup_derived_face (f
, symbol
, c
, face_id
)
5560 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5561 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5562 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5567 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5568 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5569 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5570 return lookup_face (f
, attrs
, c
, default_face
);
5573 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5574 Sface_attributes_as_vector
, 1, 1, 0,
5575 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5580 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5582 merge_face_vector_with_property (XFRAME (selected_frame
),
5583 XVECTOR (lface
)->contents
,
5590 /***********************************************************************
5592 ***********************************************************************/
5594 DEFUN ("internal-set-font-selection-order",
5595 Finternal_set_font_selection_order
,
5596 Sinternal_set_font_selection_order
, 1, 1, 0,
5597 doc
: /* Set font selection order for face font selection to ORDER.
5598 ORDER must be a list of length 4 containing the symbols `:width',
5599 `:height', `:weight', and `:slant'. Face attributes appearing
5600 first in ORDER are matched first, e.g. if `:height' appears before
5601 `:weight' in ORDER, font selection first tries to find a font with
5602 a suitable height, and then tries to match the font weight.
5609 int indices
[DIM (font_sort_order
)];
5612 bzero (indices
, sizeof indices
);
5616 CONSP (list
) && i
< DIM (indices
);
5617 list
= XCDR (list
), ++i
)
5619 Lisp_Object attr
= XCAR (list
);
5622 if (EQ (attr
, QCwidth
))
5624 else if (EQ (attr
, QCheight
))
5625 xlfd
= XLFD_POINT_SIZE
;
5626 else if (EQ (attr
, QCweight
))
5628 else if (EQ (attr
, QCslant
))
5633 if (indices
[i
] != 0)
5638 if (!NILP (list
) || i
!= DIM (indices
))
5639 signal_error ("Invalid font sort order", order
);
5640 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5641 if (indices
[i
] == 0)
5642 signal_error ("Invalid font sort order", order
);
5644 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5646 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5647 free_all_realized_faces (Qnil
);
5654 DEFUN ("internal-set-alternative-font-family-alist",
5655 Finternal_set_alternative_font_family_alist
,
5656 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5657 doc
: /* Define alternative font families to try in face font selection.
5658 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5659 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5660 be found. Value is ALIST. */)
5665 Vface_alternative_font_family_alist
= alist
;
5666 free_all_realized_faces (Qnil
);
5671 DEFUN ("internal-set-alternative-font-registry-alist",
5672 Finternal_set_alternative_font_registry_alist
,
5673 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5674 doc
: /* Define alternative font registries to try in face font selection.
5675 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5676 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5677 be found. Value is ALIST. */)
5682 Vface_alternative_font_registry_alist
= alist
;
5683 free_all_realized_faces (Qnil
);
5688 #ifdef HAVE_WINDOW_SYSTEM
5690 /* Value is non-zero if FONT is the name of a scalable font. The
5691 X11R6 XLFD spec says that point size, pixel size, and average width
5692 are zero for scalable fonts. Intlfonts contain at least one
5693 scalable font ("*-muleindian-1") for which this isn't true, so we
5694 just test average width. */
5697 font_scalable_p (font
)
5698 struct font_name
*font
;
5700 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5701 return (*s
== '0' && *(s
+ 1) == '\0')
5703 /* Windows implementation of XLFD is slightly broken for backward
5704 compatibility with previous broken versions, so test for
5705 wildcards as well as 0. */
5712 /* Ignore the difference of font point size less than this value. */
5714 #define FONT_POINT_SIZE_QUANTUM 5
5716 /* Value is non-zero if FONT1 is a better match for font attributes
5717 VALUES than FONT2. VALUES is an array of face attribute values in
5718 font sort order. COMPARE_PT_P zero means don't compare point
5719 sizes. AVGWIDTH, if not zero, is a specified font average width
5723 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5725 struct font_name
*font1
, *font2
;
5726 int compare_pt_p
, avgwidth
;
5730 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5732 int xlfd_idx
= font_sort_order
[i
];
5734 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5736 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5737 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5739 if (xlfd_idx
== XLFD_POINT_SIZE
5740 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5742 if (delta1
> delta2
)
5744 else if (delta1
< delta2
)
5748 /* The difference may be equal because, e.g., the face
5749 specifies `italic' but we have only `regular' and
5750 `oblique'. Prefer `oblique' in this case. */
5751 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5752 && font1
->numeric
[xlfd_idx
] > values
[i
]
5753 && font2
->numeric
[xlfd_idx
] < values
[i
])
5761 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5762 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5763 if (delta1
> delta2
)
5765 else if (delta1
< delta2
)
5769 return font1
->registry_priority
< font2
->registry_priority
;
5773 /* Value is non-zero if FONT is an exact match for face attributes in
5774 SPECIFIED. SPECIFIED is an array of face attribute values in font
5775 sort order. AVGWIDTH, if non-zero, is an average width to compare
5779 exact_face_match_p (specified
, font
, avgwidth
)
5781 struct font_name
*font
;
5786 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5787 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5790 return (i
== DIM (font_sort_order
)
5792 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5796 /* Value is the name of a scaled font, generated from scalable font
5797 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5798 Value is allocated from heap. */
5801 build_scalable_font_name (f
, font
, specified_pt
)
5803 struct font_name
*font
;
5806 char point_size
[20], pixel_size
[20];
5808 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5811 /* If scalable font is for a specific resolution, compute
5812 the point size we must specify from the resolution of
5813 the display and the specified resolution of the font. */
5814 if (font
->numeric
[XLFD_RESY
] != 0)
5816 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5817 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5822 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5825 /* Set point size of the font. */
5826 sprintf (point_size
, "%d", (int) pt
);
5827 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5828 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5830 /* Set pixel size. */
5831 sprintf (pixel_size
, "%d", pixel_value
);
5832 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5833 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5835 /* If font doesn't specify its resolution, use the
5836 resolution of the display. */
5837 if (font
->numeric
[XLFD_RESY
] == 0)
5840 sprintf (buffer
, "%d", (int) resy
);
5841 font
->fields
[XLFD_RESY
] = buffer
;
5842 font
->numeric
[XLFD_RESY
] = resy
;
5845 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5848 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5849 sprintf (buffer
, "%d", resx
);
5850 font
->fields
[XLFD_RESX
] = buffer
;
5851 font
->numeric
[XLFD_RESX
] = resx
;
5854 return build_font_name (font
);
5858 /* Value is non-zero if we are allowed to use scalable font FONT. We
5859 can't run a Lisp function here since this function may be called
5860 with input blocked. */
5863 may_use_scalable_font_p (font
)
5866 if (EQ (Vscalable_fonts_allowed
, Qt
))
5868 else if (CONSP (Vscalable_fonts_allowed
))
5870 Lisp_Object tail
, regexp
;
5872 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5874 regexp
= XCAR (tail
);
5875 if (STRINGP (regexp
)
5876 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5886 /* Return the name of the best matching font for face attributes ATTRS
5887 in the array of font_name structures FONTS which contains NFONTS
5888 elements. WIDTH_RATIO is a factor with which to multiply average
5889 widths if ATTRS specifies such a width.
5891 Value is a font name which is allocated from the heap. FONTS is
5892 freed by this function. */
5895 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5898 struct font_name
*fonts
;
5903 struct font_name
*best
;
5906 int exact_p
, avgwidth
;
5911 /* Make specified font attributes available in `specified',
5912 indexed by sort order. */
5913 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5915 int xlfd_idx
= font_sort_order
[i
];
5917 if (xlfd_idx
== XLFD_SWIDTH
)
5918 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5919 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5920 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5921 else if (xlfd_idx
== XLFD_WEIGHT
)
5922 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5923 else if (xlfd_idx
== XLFD_SLANT
)
5924 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5929 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5931 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5935 /* Start with the first non-scalable font in the list. */
5936 for (i
= 0; i
< nfonts
; ++i
)
5937 if (!font_scalable_p (fonts
+ i
))
5940 /* Find the best match among the non-scalable fonts. */
5945 for (i
= 1; i
< nfonts
; ++i
)
5946 if (!font_scalable_p (fonts
+ i
)
5947 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5951 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5960 /* Unless we found an exact match among non-scalable fonts, see if
5961 we can find a better match among scalable fonts. */
5964 /* A scalable font is better if
5966 1. its weight, slant, swidth attributes are better, or.
5968 2. the best non-scalable font doesn't have the required
5969 point size, and the scalable fonts weight, slant, swidth
5972 int non_scalable_has_exact_height_p
;
5974 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5975 non_scalable_has_exact_height_p
= 1;
5977 non_scalable_has_exact_height_p
= 0;
5979 for (i
= 0; i
< nfonts
; ++i
)
5980 if (font_scalable_p (fonts
+ i
))
5983 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5984 || (!non_scalable_has_exact_height_p
5985 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5990 if (font_scalable_p (best
))
5991 font_name
= build_scalable_font_name (f
, best
, pt
);
5993 font_name
= build_font_name (best
);
5995 /* Free font_name structures. */
5996 free_font_names (fonts
, nfonts
);
6002 /* Get a list of matching fonts on frame F, considering FAMILY
6003 and alternative font families from Vface_alternative_font_registry_alist.
6005 FAMILY is the font family whose alternatives are considered.
6007 REGISTRY, if a string, specifies a font registry and encoding to
6008 match. A value of nil means include fonts of any registry and
6011 Return in *FONTS a pointer to a vector of font_name structures for
6012 the fonts matched. Value is the number of fonts found. */
6015 try_alternative_families (f
, family
, registry
, fonts
)
6017 Lisp_Object family
, registry
;
6018 struct font_name
**fonts
;
6023 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6026 /* Try alternative font families. */
6027 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6030 for (alter
= XCDR (alter
);
6031 CONSP (alter
) && nfonts
== 0;
6032 alter
= XCDR (alter
))
6034 if (STRINGP (XCAR (alter
)))
6035 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6039 /* Try scalable fonts before giving up. */
6040 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
6042 int count
= BINDING_STACK_SIZE ();
6043 specbind (Qscalable_fonts_allowed
, Qt
);
6044 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6045 unbind_to (count
, Qnil
);
6052 /* Get a list of matching fonts on frame F.
6054 FAMILY, if a string, specifies a font family derived from the fontset.
6055 It is only used if the face does not specify any family in ATTRS or
6056 if we cannot find any font of the face's family.
6058 REGISTRY, if a string, specifies a font registry and encoding to
6059 match. A value of nil means include fonts of any registry and
6062 Return in *FONTS a pointer to a vector of font_name structures for
6063 the fonts matched. Value is the number of fonts found. */
6066 try_font_list (f
, attrs
, family
, registry
, fonts
)
6069 Lisp_Object family
, registry
;
6070 struct font_name
**fonts
;
6073 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
6076 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6078 if (nfonts
== 0 && STRINGP (face_family
))
6079 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
6081 /* Try font family of the default face or "fixed". */
6084 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6086 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6088 family
= build_string ("fixed");
6089 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6092 /* Try any family with the given registry. */
6094 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6100 /* Return the fontset id of the base fontset name or alias name given
6101 by the fontset attribute of ATTRS. Value is -1 if the fontset
6102 attribute of ATTRS doesn't name a fontset. */
6105 face_fontset (attrs
)
6110 name
= attrs
[LFACE_FONT_INDEX
];
6111 if (!STRINGP (name
))
6113 return fs_query_fontset (name
, 0);
6117 /* Choose a name of font to use on frame F to display character C with
6118 Lisp face attributes specified by ATTRS. The font name is
6119 determined by the font-related attributes in ATTRS and the name
6120 pattern for C in FACE->fontset (or Vdefault_fontset if FACE is
6121 null). Value is the font name which is allocated from the heap and
6122 must be freed by the caller, or NULL if we can get no information
6123 about the font name of C. It is assured that we always get some
6124 information for a single byte character. */
6127 choose_face_font (f
, attrs
, face
, c
)
6134 Lisp_Object pattern
, family
, registry
;
6135 Lisp_Object new_attrs
[LFACE_VECTOR_SIZE
];
6136 char *font_name
= NULL
;
6137 struct font_name
*fonts
;
6138 int nfonts
, width_ratio
;
6140 /* Get font spec of a font for C. */
6141 pattern
= fontset_font_pattern (f
, face
, c
);
6144 xassert (!SINGLE_BYTE_CHAR_P (c
));
6148 /* If what we got is a name pattern, return it. */
6149 if (STRINGP (pattern
))
6150 return xstrdup (XSTRING (pattern
)->data
);
6152 family
= AREF (pattern
, FONT_SPEC_FAMILY_INDEX
);
6153 registry
= AREF (pattern
, FONT_SPEC_REGISTRY_INDEX
);
6155 bcopy (attrs
, new_attrs
, sizeof (Lisp_Object
) * LFACE_VECTOR_SIZE
);
6158 /* This doesn't work well for the moment. */
6159 if (! NILP (AREF (pattern
, FONT_SPEC_WEIGHT_INDEX
)))
6160 new_attrs
[LFACE_WEIGHT_INDEX
] = AREF (pattern
, FONT_SPEC_WEIGHT_INDEX
);
6161 if (! NILP (AREF (pattern
, FONT_SPEC_SLANT_INDEX
)))
6162 new_attrs
[LFACE_SLANT_INDEX
] = AREF (pattern
, FONT_SPEC_SLANT_INDEX
);
6163 if (! NILP (AREF (pattern
, FONT_SPEC_SWIDTH_INDEX
)))
6164 new_attrs
[LFACE_SWIDTH_INDEX
] = AREF (pattern
, FONT_SPEC_SWIDTH_INDEX
);
6167 /* If C is an ASCII character, family name in ATTRS has higher
6168 priority than what specified in the fontset. */
6169 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
6170 && ASCII_CHAR_P (c
))
6173 /* Get a list of fonts matching that pattern and choose the
6174 best match for the specified face attributes from it. */
6175 nfonts
= try_font_list (f
, new_attrs
, family
, registry
, &fonts
);
6176 width_ratio
= (ASCII_CHAR_P (c
)
6179 font_name
= best_matching_font (f
, new_attrs
, fonts
, nfonts
, width_ratio
);
6183 #endif /* HAVE_WINDOW_SYSTEM */
6187 /***********************************************************************
6189 ***********************************************************************/
6191 /* Realize basic faces on frame F. Value is zero if frame parameters
6192 of F don't contain enough information needed to realize the default
6196 realize_basic_faces (f
)
6200 int count
= BINDING_STACK_SIZE ();
6202 /* Block input here so that we won't be surprised by an X expose
6203 event, for instance, without having the faces set up. */
6205 specbind (Qscalable_fonts_allowed
, Qt
);
6207 if (realize_default_face (f
))
6209 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6210 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6211 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6212 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6213 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6214 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6215 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6216 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6217 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6218 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6220 /* Reflect changes in the `menu' face in menu bars. */
6221 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6223 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6224 #ifdef USE_X_TOOLKIT
6225 x_update_menu_appearance (f
);
6232 unbind_to (count
, Qnil
);
6238 /* Realize the default face on frame F. If the face is not fully
6239 specified, make it fully-specified. Attributes of the default face
6240 that are not explicitly specified are taken from frame parameters. */
6243 realize_default_face (f
)
6246 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6248 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6249 Lisp_Object frame_font
;
6252 /* If the `default' face is not yet known, create it. */
6253 lface
= lface_from_face_name (f
, Qdefault
, 0);
6257 XSETFRAME (frame
, f
);
6258 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6261 #ifdef HAVE_WINDOW_SYSTEM
6262 if (FRAME_WINDOW_P (f
))
6264 /* Set frame_font to the value of the `font' frame parameter. */
6265 frame_font
= Fassq (Qfont
, f
->param_alist
);
6266 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6267 frame_font
= XCDR (frame_font
);
6268 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6270 #endif /* HAVE_WINDOW_SYSTEM */
6272 if (!FRAME_WINDOW_P (f
))
6274 LFACE_FAMILY (lface
) = build_string ("default");
6275 LFACE_SWIDTH (lface
) = Qnormal
;
6276 LFACE_HEIGHT (lface
) = make_number (1);
6277 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6278 LFACE_WEIGHT (lface
) = Qnormal
;
6279 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6280 LFACE_SLANT (lface
) = Qnormal
;
6281 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6284 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6285 LFACE_UNDERLINE (lface
) = Qnil
;
6287 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6288 LFACE_OVERLINE (lface
) = Qnil
;
6290 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6291 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6293 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6294 LFACE_BOX (lface
) = Qnil
;
6296 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6297 LFACE_INVERSE (lface
) = Qnil
;
6299 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6301 /* This function is called so early that colors are not yet
6302 set in the frame parameter list. */
6303 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6305 if (CONSP (color
) && STRINGP (XCDR (color
)))
6306 LFACE_FOREGROUND (lface
) = XCDR (color
);
6307 else if (FRAME_WINDOW_P (f
))
6309 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6310 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6315 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6317 /* This function is called so early that colors are not yet
6318 set in the frame parameter list. */
6319 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6320 if (CONSP (color
) && STRINGP (XCDR (color
)))
6321 LFACE_BACKGROUND (lface
) = XCDR (color
);
6322 else if (FRAME_WINDOW_P (f
))
6324 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6325 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6330 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6331 LFACE_STIPPLE (lface
) = Qnil
;
6333 /* Realize the face; it must be fully-specified now. */
6334 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6335 check_lface (lface
);
6336 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6337 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6342 /* Realize basic faces other than the default face in face cache C.
6343 SYMBOL is the face name, ID is the face id the realized face must
6344 have. The default face must have been realized already. */
6347 realize_named_face (f
, symbol
, id
)
6352 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6353 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6354 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6355 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6356 struct face
*new_face
;
6358 /* The default face must exist and be fully specified. */
6359 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6360 check_lface_attrs (attrs
);
6361 xassert (lface_fully_specified_p (attrs
));
6363 /* If SYMBOL isn't know as a face, create it. */
6367 XSETFRAME (frame
, f
);
6368 lface
= Finternal_make_lisp_face (symbol
, frame
);
6371 /* Merge SYMBOL's face with the default face. */
6372 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6373 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6375 /* Realize the face. */
6376 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6380 /* Realize the fully-specified face with attributes ATTRS in face
6381 cache CACHE for character C. If C is a multibyte character,
6382 BASE_FACE is a face that has the same attributes. Otherwise,
6383 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6384 ID of face to remove before caching the new face. Value is a
6385 pointer to the newly created realized face. */
6387 static struct face
*
6388 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6389 struct face_cache
*cache
;
6392 struct face
*base_face
;
6397 /* LFACE must be fully specified. */
6398 xassert (cache
!= NULL
);
6399 check_lface_attrs (attrs
);
6401 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6403 /* Remove the former face. */
6404 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6405 uncache_face (cache
, former_face
);
6406 free_realized_face (cache
->f
, former_face
);
6409 if (FRAME_WINDOW_P (cache
->f
))
6410 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6411 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6412 face
= realize_tty_face (cache
, attrs
, c
);
6416 /* Insert the new face. */
6417 cache_face (cache
, face
, lface_hash (attrs
));
6418 #ifdef HAVE_WINDOW_SYSTEM
6419 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6420 load_face_font (cache
->f
, face
, c
);
6421 #endif /* HAVE_WINDOW_SYSTEM */
6426 /* Realize the fully-specified face with attributes ATTRS in face
6427 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6428 a multibyte character, BASE_FACE is a face that has the same
6429 attributes. Otherwise, BASE_FACE is ignored. If the new face
6430 doesn't share font with the default face, a fontname is allocated
6431 from the heap and set in `font_name' of the new face, but it is not
6432 yet loaded here. Value is a pointer to the newly created realized
6435 static struct face
*
6436 realize_x_face (cache
, attrs
, c
, base_face
)
6437 struct face_cache
*cache
;
6440 struct face
*base_face
;
6442 #ifdef HAVE_WINDOW_SYSTEM
6443 struct face
*face
, *default_face
;
6445 Lisp_Object stipple
, overline
, strike_through
, box
;
6447 xassert (FRAME_WINDOW_P (cache
->f
));
6448 xassert (SINGLE_BYTE_CHAR_P (c
)
6451 /* Allocate a new realized face. */
6452 face
= make_realized_face (attrs
);
6456 /* If C is a non-ASCII character, we share all face attirbutes with
6457 BASE_FACE including the realized fontset. But, we must load a
6459 if (! ASCII_CHAR_P (c
))
6461 bcopy (base_face
, face
, sizeof *face
);
6464 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6465 face
->colors_copied_bitwise_p
= 1;
6467 /* to force realize_face to load font */
6472 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6474 /* Determine the font to use. Most of the time, the font will be
6475 the same as the font of the default face, so try that first. */
6476 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6478 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6479 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6481 face
->font
= default_face
->font
;
6482 face
->fontset
= default_face
->fontset
;
6483 face
->font_info_id
= default_face
->font_info_id
;
6484 face
->font_name
= default_face
->font_name
;
6485 face
->ascii_face
= face
;
6487 /* But, as we can't share the fontset, make a new realized
6488 fontset that has the same base fontset as of the default
6491 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6495 /* If the face attribute ATTRS specifies a fontset, use it as
6496 the base of a new realized fontset. Otherwise, use the same
6497 base fontset as of the default face. The base determines
6498 registry and encoding of a font. It may also determine
6499 foundry and family. The other fields of font name pattern
6500 are constructed from ATTRS. */
6501 int fontset
= face_fontset (attrs
);
6503 if ((fontset
== -1) && default_face
)
6504 fontset
= default_face
->fontset
;
6505 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6506 face
->font
= NULL
; /* to force realize_face to load font */
6509 /* Load the font if it is specified in ATTRS. This fixes
6510 changing frame font on the Mac. */
6511 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6513 struct font_info
*font_info
=
6514 FS_LOAD_FONT (f
, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6516 face
->font
= font_info
->font
;
6521 /* Load colors, and set remaining attributes. */
6523 load_face_colors (f
, face
, attrs
);
6526 box
= attrs
[LFACE_BOX_INDEX
];
6529 /* A simple box of line width 1 drawn in color given by
6531 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6533 face
->box
= FACE_SIMPLE_BOX
;
6534 face
->box_line_width
= 1;
6536 else if (INTEGERP (box
))
6538 /* Simple box of specified line width in foreground color of the
6540 xassert (XINT (box
) != 0);
6541 face
->box
= FACE_SIMPLE_BOX
;
6542 face
->box_line_width
= XINT (box
);
6543 face
->box_color
= face
->foreground
;
6544 face
->box_color_defaulted_p
= 1;
6546 else if (CONSP (box
))
6548 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6549 being one of `raised' or `sunken'. */
6550 face
->box
= FACE_SIMPLE_BOX
;
6551 face
->box_color
= face
->foreground
;
6552 face
->box_color_defaulted_p
= 1;
6553 face
->box_line_width
= 1;
6557 Lisp_Object keyword
, value
;
6559 keyword
= XCAR (box
);
6567 if (EQ (keyword
, QCline_width
))
6569 if (INTEGERP (value
) && XINT (value
) != 0)
6570 face
->box_line_width
= XINT (value
);
6572 else if (EQ (keyword
, QCcolor
))
6574 if (STRINGP (value
))
6576 face
->box_color
= load_color (f
, face
, value
,
6578 face
->use_box_color_for_shadows_p
= 1;
6581 else if (EQ (keyword
, QCstyle
))
6583 if (EQ (value
, Qreleased_button
))
6584 face
->box
= FACE_RAISED_BOX
;
6585 else if (EQ (value
, Qpressed_button
))
6586 face
->box
= FACE_SUNKEN_BOX
;
6591 /* Text underline, overline, strike-through. */
6593 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6595 /* Use default color (same as foreground color). */
6596 face
->underline_p
= 1;
6597 face
->underline_defaulted_p
= 1;
6598 face
->underline_color
= 0;
6600 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6602 /* Use specified color. */
6603 face
->underline_p
= 1;
6604 face
->underline_defaulted_p
= 0;
6605 face
->underline_color
6606 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6607 LFACE_UNDERLINE_INDEX
);
6609 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6611 face
->underline_p
= 0;
6612 face
->underline_defaulted_p
= 0;
6613 face
->underline_color
= 0;
6616 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6617 if (STRINGP (overline
))
6619 face
->overline_color
6620 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6621 LFACE_OVERLINE_INDEX
);
6622 face
->overline_p
= 1;
6624 else if (EQ (overline
, Qt
))
6626 face
->overline_color
= face
->foreground
;
6627 face
->overline_color_defaulted_p
= 1;
6628 face
->overline_p
= 1;
6631 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6632 if (STRINGP (strike_through
))
6634 face
->strike_through_color
6635 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6636 LFACE_STRIKE_THROUGH_INDEX
);
6637 face
->strike_through_p
= 1;
6639 else if (EQ (strike_through
, Qt
))
6641 face
->strike_through_color
= face
->foreground
;
6642 face
->strike_through_color_defaulted_p
= 1;
6643 face
->strike_through_p
= 1;
6646 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6647 if (!NILP (stipple
))
6648 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6650 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6652 #endif /* HAVE_WINDOW_SYSTEM */
6656 /* Map a specified color of face FACE on frame F to a tty color index.
6657 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6658 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6659 default foreground/background colors. */
6662 map_tty_color (f
, face
, idx
, defaulted
)
6665 enum lface_attribute_index idx
;
6668 Lisp_Object frame
, color
, def
;
6669 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6670 unsigned long default_pixel
, default_other_pixel
, pixel
;
6672 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6676 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6677 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6681 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6682 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6685 XSETFRAME (frame
, f
);
6686 color
= face
->lface
[idx
];
6689 && XSTRING (color
)->size
6690 && CONSP (Vtty_defined_color_alist
)
6691 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6694 /* Associations in tty-defined-color-alist are of the form
6695 (NAME INDEX R G B). We need the INDEX part. */
6696 pixel
= XINT (XCAR (XCDR (def
)));
6699 if (pixel
== default_pixel
&& STRINGP (color
))
6701 pixel
= load_color (f
, face
, color
, idx
);
6703 #if defined (MSDOS) || defined (WINDOWSNT)
6704 /* If the foreground of the default face is the default color,
6705 use the foreground color defined by the frame. */
6707 if (FRAME_MSDOS_P (f
))
6710 if (pixel
== default_pixel
6711 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6714 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6716 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6717 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6720 else if (pixel
== default_other_pixel
)
6723 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6725 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6726 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6732 #endif /* MSDOS or WINDOWSNT */
6736 face
->foreground
= pixel
;
6738 face
->background
= pixel
;
6742 /* Realize the fully-specified face with attributes ATTRS in face
6743 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6744 pointer to the newly created realized face. */
6746 static struct face
*
6747 realize_tty_face (cache
, attrs
, c
)
6748 struct face_cache
*cache
;
6754 int face_colors_defaulted
= 0;
6755 struct frame
*f
= cache
->f
;
6757 /* Frame must be a termcap frame. */
6758 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6760 /* Allocate a new realized face. */
6761 face
= make_realized_face (attrs
);
6762 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6764 /* Map face attributes to TTY appearances. We map slant to
6765 dimmed text because we want italic text to appear differently
6766 and because dimmed text is probably used infrequently. */
6767 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6768 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6770 if (weight
> XLFD_WEIGHT_MEDIUM
)
6771 face
->tty_bold_p
= 1;
6772 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6773 face
->tty_dim_p
= 1;
6774 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6775 face
->tty_underline_p
= 1;
6776 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6777 face
->tty_reverse_p
= 1;
6779 /* Map color names to color indices. */
6780 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6781 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6783 /* Swap colors if face is inverse-video. If the colors are taken
6784 from the frame colors, they are already inverted, since the
6785 frame-creation function calls x-handle-reverse-video. */
6786 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6788 unsigned long tem
= face
->foreground
;
6789 face
->foreground
= face
->background
;
6790 face
->background
= tem
;
6793 if (tty_suppress_bold_inverse_default_colors_p
6795 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6796 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6797 face
->tty_bold_p
= 0;
6803 DEFUN ("tty-suppress-bold-inverse-default-colors",
6804 Ftty_suppress_bold_inverse_default_colors
,
6805 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6806 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6807 SUPPRESS non-nil means suppress it.
6808 This affects bold faces on TTYs whose foreground is the default background
6809 color of the display and whose background is the default foreground color.
6810 For such faces, the bold face attribute is ignored if this variable
6813 Lisp_Object suppress
;
6815 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6816 ++face_change_count
;
6822 /***********************************************************************
6824 ***********************************************************************/
6826 /* Return the ID of the face to use to display character CH with face
6827 property PROP on frame F in current_buffer. */
6830 compute_char_face (f
, ch
, prop
)
6837 if (NILP (current_buffer
->enable_multibyte_characters
))
6842 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6843 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6847 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6848 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6849 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6850 merge_face_vector_with_property (f
, attrs
, prop
);
6851 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6857 /* Return the face ID associated with buffer position POS for
6858 displaying ASCII characters. Return in *ENDPTR the position at
6859 which a different face is needed, as far as text properties and
6860 overlays are concerned. W is a window displaying current_buffer.
6862 REGION_BEG, REGION_END delimit the region, so it can be
6865 LIMIT is a position not to scan beyond. That is to limit the time
6866 this function can take.
6868 If MOUSE is non-zero, use the character's mouse-face, not its face.
6870 The face returned is suitable for displaying ASCII characters. */
6873 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6874 endptr
, limit
, mouse
)
6877 int region_beg
, region_end
;
6882 struct frame
*f
= XFRAME (w
->frame
);
6883 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6884 Lisp_Object prop
, position
;
6886 Lisp_Object
*overlay_vec
;
6889 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6890 Lisp_Object limit1
, end
;
6891 struct face
*default_face
;
6893 /* W must display the current buffer. We could write this function
6894 to use the frame and buffer of W, but right now it doesn't. */
6895 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6897 XSETFRAME (frame
, f
);
6898 XSETFASTINT (position
, pos
);
6901 if (pos
< region_beg
&& region_beg
< endpos
)
6902 endpos
= region_beg
;
6904 /* Get the `face' or `mouse_face' text property at POS, and
6905 determine the next position at which the property changes. */
6906 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6907 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6908 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6910 endpos
= XINT (end
);
6912 /* Look at properties from overlays. */
6917 /* First try with room for 40 overlays. */
6919 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6920 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6921 &next_overlay
, NULL
, 0);
6923 /* If there are more than 40, make enough space for all, and try
6925 if (noverlays
> len
)
6928 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6929 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6930 &next_overlay
, NULL
, 0);
6933 if (next_overlay
< endpos
)
6934 endpos
= next_overlay
;
6939 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6941 /* Optimize common cases where we can use the default face. */
6944 && !(pos
>= region_beg
&& pos
< region_end
))
6945 return DEFAULT_FACE_ID
;
6947 /* Begin with attributes from the default face. */
6948 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6950 /* Merge in attributes specified via text properties. */
6952 merge_face_vector_with_property (f
, attrs
, prop
);
6954 /* Now merge the overlay data. */
6955 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6956 for (i
= 0; i
< noverlays
; i
++)
6961 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6963 merge_face_vector_with_property (f
, attrs
, prop
);
6965 oend
= OVERLAY_END (overlay_vec
[i
]);
6966 oendpos
= OVERLAY_POSITION (oend
);
6967 if (oendpos
< endpos
)
6971 /* If in the region, merge in the region face. */
6972 if (pos
>= region_beg
&& pos
< region_end
)
6974 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6975 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6977 if (region_end
< endpos
)
6978 endpos
= region_end
;
6983 /* Look up a realized face with the given face attributes,
6984 or realize a new one for ASCII characters. */
6985 return lookup_face (f
, attrs
, 0, NULL
);
6989 /* Compute the face at character position POS in Lisp string STRING on
6990 window W, for ASCII characters.
6992 If STRING is an overlay string, it comes from position BUFPOS in
6993 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6994 not an overlay string. W must display the current buffer.
6995 REGION_BEG and REGION_END give the start and end positions of the
6996 region; both are -1 if no region is visible.
6998 BASE_FACE_ID is the id of a face to merge with. For strings coming
6999 from overlays or the `display' property it is the face at BUFPOS.
7001 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7003 Set *ENDPTR to the next position where to check for faces in
7004 STRING; -1 if the face is constant from POS to the end of the
7007 Value is the id of the face to use. The face returned is suitable
7008 for displaying ASCII characters. */
7011 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7012 region_end
, endptr
, base_face_id
, mouse_p
)
7016 int region_beg
, region_end
;
7018 enum face_id base_face_id
;
7021 Lisp_Object prop
, position
, end
, limit
;
7022 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7023 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7024 struct face
*base_face
;
7025 int multibyte_p
= STRING_MULTIBYTE (string
);
7026 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7028 /* Get the value of the face property at the current position within
7029 STRING. Value is nil if there is no face property. */
7030 XSETFASTINT (position
, pos
);
7031 prop
= Fget_text_property (position
, prop_name
, string
);
7033 /* Get the next position at which to check for faces. Value of end
7034 is nil if face is constant all the way to the end of the string.
7035 Otherwise it is a string position where to check faces next.
7036 Limit is the maximum position up to which to check for property
7037 changes in Fnext_single_property_change. Strings are usually
7038 short, so set the limit to the end of the string. */
7039 XSETFASTINT (limit
, XSTRING (string
)->size
);
7040 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7042 *endptr
= XFASTINT (end
);
7046 base_face
= FACE_FROM_ID (f
, base_face_id
);
7047 xassert (base_face
);
7049 /* Optimize the default case that there is no face property and we
7050 are not in the region. */
7052 && (base_face_id
!= DEFAULT_FACE_ID
7053 /* BUFPOS <= 0 means STRING is not an overlay string, so
7054 that the region doesn't have to be taken into account. */
7056 || bufpos
< region_beg
7057 || bufpos
>= region_end
)
7059 /* We can't realize faces for different charsets differently
7060 if we don't have fonts, so we can stop here if not working
7061 on a window-system frame. */
7062 || !FRAME_WINDOW_P (f
)
7063 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7064 return base_face
->id
;
7066 /* Begin with attributes from the base face. */
7067 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7069 /* Merge in attributes specified via text properties. */
7071 merge_face_vector_with_property (f
, attrs
, prop
);
7073 /* If in the region, merge in the region face. */
7075 && bufpos
>= region_beg
7076 && bufpos
< region_end
)
7078 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7079 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7082 /* Look up a realized face with the given face attributes,
7083 or realize a new one for ASCII characters. */
7084 return lookup_face (f
, attrs
, 0, NULL
);
7089 /***********************************************************************
7091 ***********************************************************************/
7095 /* Print the contents of the realized face FACE to stderr. */
7098 dump_realized_face (face
)
7101 fprintf (stderr
, "ID: %d\n", face
->id
);
7102 #ifdef HAVE_X_WINDOWS
7103 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7105 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7107 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7108 fprintf (stderr
, "background: 0x%lx (%s)\n",
7110 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7111 fprintf (stderr
, "font_name: %s (%s)\n",
7113 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7114 #ifdef HAVE_X_WINDOWS
7115 fprintf (stderr
, "font = %p\n", face
->font
);
7117 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7118 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7119 fprintf (stderr
, "underline: %d (%s)\n",
7121 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7122 fprintf (stderr
, "hash: %d\n", face
->hash
);
7123 fprintf (stderr
, "charset: %d\n", face
->charset
);
7127 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7135 fprintf (stderr
, "font selection order: ");
7136 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7137 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7138 fprintf (stderr
, "\n");
7140 fprintf (stderr
, "alternative fonts: ");
7141 debug_print (Vface_alternative_font_family_alist
);
7142 fprintf (stderr
, "\n");
7144 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7145 Fdump_face (make_number (i
));
7151 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7153 error ("Not a valid face");
7154 dump_realized_face (face
);
7161 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7162 0, 0, 0, doc
: /* */)
7165 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7166 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7167 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7171 #endif /* GLYPH_DEBUG != 0 */
7175 /***********************************************************************
7177 ***********************************************************************/
7182 Qface
= intern ("face");
7184 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7185 staticpro (&Qbitmap_spec_p
);
7186 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7187 staticpro (&Qframe_update_face_colors
);
7189 /* Lisp face attribute keywords. */
7190 QCfamily
= intern (":family");
7191 staticpro (&QCfamily
);
7192 QCheight
= intern (":height");
7193 staticpro (&QCheight
);
7194 QCweight
= intern (":weight");
7195 staticpro (&QCweight
);
7196 QCslant
= intern (":slant");
7197 staticpro (&QCslant
);
7198 QCunderline
= intern (":underline");
7199 staticpro (&QCunderline
);
7200 QCinverse_video
= intern (":inverse-video");
7201 staticpro (&QCinverse_video
);
7202 QCreverse_video
= intern (":reverse-video");
7203 staticpro (&QCreverse_video
);
7204 QCforeground
= intern (":foreground");
7205 staticpro (&QCforeground
);
7206 QCbackground
= intern (":background");
7207 staticpro (&QCbackground
);
7208 QCstipple
= intern (":stipple");;
7209 staticpro (&QCstipple
);
7210 QCwidth
= intern (":width");
7211 staticpro (&QCwidth
);
7212 QCfont
= intern (":font");
7213 staticpro (&QCfont
);
7214 QCbold
= intern (":bold");
7215 staticpro (&QCbold
);
7216 QCitalic
= intern (":italic");
7217 staticpro (&QCitalic
);
7218 QCoverline
= intern (":overline");
7219 staticpro (&QCoverline
);
7220 QCstrike_through
= intern (":strike-through");
7221 staticpro (&QCstrike_through
);
7222 QCbox
= intern (":box");
7224 QCinherit
= intern (":inherit");
7225 staticpro (&QCinherit
);
7227 /* Symbols used for Lisp face attribute values. */
7228 QCcolor
= intern (":color");
7229 staticpro (&QCcolor
);
7230 QCline_width
= intern (":line-width");
7231 staticpro (&QCline_width
);
7232 QCstyle
= intern (":style");
7233 staticpro (&QCstyle
);
7234 Qreleased_button
= intern ("released-button");
7235 staticpro (&Qreleased_button
);
7236 Qpressed_button
= intern ("pressed-button");
7237 staticpro (&Qpressed_button
);
7238 Qnormal
= intern ("normal");
7239 staticpro (&Qnormal
);
7240 Qultra_light
= intern ("ultra-light");
7241 staticpro (&Qultra_light
);
7242 Qextra_light
= intern ("extra-light");
7243 staticpro (&Qextra_light
);
7244 Qlight
= intern ("light");
7245 staticpro (&Qlight
);
7246 Qsemi_light
= intern ("semi-light");
7247 staticpro (&Qsemi_light
);
7248 Qsemi_bold
= intern ("semi-bold");
7249 staticpro (&Qsemi_bold
);
7250 Qbold
= intern ("bold");
7252 Qextra_bold
= intern ("extra-bold");
7253 staticpro (&Qextra_bold
);
7254 Qultra_bold
= intern ("ultra-bold");
7255 staticpro (&Qultra_bold
);
7256 Qoblique
= intern ("oblique");
7257 staticpro (&Qoblique
);
7258 Qitalic
= intern ("italic");
7259 staticpro (&Qitalic
);
7260 Qreverse_oblique
= intern ("reverse-oblique");
7261 staticpro (&Qreverse_oblique
);
7262 Qreverse_italic
= intern ("reverse-italic");
7263 staticpro (&Qreverse_italic
);
7264 Qultra_condensed
= intern ("ultra-condensed");
7265 staticpro (&Qultra_condensed
);
7266 Qextra_condensed
= intern ("extra-condensed");
7267 staticpro (&Qextra_condensed
);
7268 Qcondensed
= intern ("condensed");
7269 staticpro (&Qcondensed
);
7270 Qsemi_condensed
= intern ("semi-condensed");
7271 staticpro (&Qsemi_condensed
);
7272 Qsemi_expanded
= intern ("semi-expanded");
7273 staticpro (&Qsemi_expanded
);
7274 Qexpanded
= intern ("expanded");
7275 staticpro (&Qexpanded
);
7276 Qextra_expanded
= intern ("extra-expanded");
7277 staticpro (&Qextra_expanded
);
7278 Qultra_expanded
= intern ("ultra-expanded");
7279 staticpro (&Qultra_expanded
);
7280 Qbackground_color
= intern ("background-color");
7281 staticpro (&Qbackground_color
);
7282 Qforeground_color
= intern ("foreground-color");
7283 staticpro (&Qforeground_color
);
7284 Qunspecified
= intern ("unspecified");
7285 staticpro (&Qunspecified
);
7287 Qface_alias
= intern ("face-alias");
7288 staticpro (&Qface_alias
);
7289 Qdefault
= intern ("default");
7290 staticpro (&Qdefault
);
7291 Qtool_bar
= intern ("tool-bar");
7292 staticpro (&Qtool_bar
);
7293 Qregion
= intern ("region");
7294 staticpro (&Qregion
);
7295 Qfringe
= intern ("fringe");
7296 staticpro (&Qfringe
);
7297 Qheader_line
= intern ("header-line");
7298 staticpro (&Qheader_line
);
7299 Qscroll_bar
= intern ("scroll-bar");
7300 staticpro (&Qscroll_bar
);
7301 Qmenu
= intern ("menu");
7303 Qcursor
= intern ("cursor");
7304 staticpro (&Qcursor
);
7305 Qborder
= intern ("border");
7306 staticpro (&Qborder
);
7307 Qmouse
= intern ("mouse");
7308 staticpro (&Qmouse
);
7309 Qmode_line_inactive
= intern ("mode-line-inactive");
7310 staticpro (&Qmode_line_inactive
);
7311 Qtty_color_desc
= intern ("tty-color-desc");
7312 staticpro (&Qtty_color_desc
);
7313 Qtty_color_by_index
= intern ("tty-color-by-index");
7314 staticpro (&Qtty_color_by_index
);
7315 Qtty_color_alist
= intern ("tty-color-alist");
7316 staticpro (&Qtty_color_alist
);
7317 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7318 staticpro (&Qscalable_fonts_allowed
);
7320 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7321 staticpro (&Vparam_value_alist
);
7322 Vface_alternative_font_family_alist
= Qnil
;
7323 staticpro (&Vface_alternative_font_family_alist
);
7324 Vface_alternative_font_registry_alist
= Qnil
;
7325 staticpro (&Vface_alternative_font_registry_alist
);
7327 defsubr (&Sinternal_make_lisp_face
);
7328 defsubr (&Sinternal_lisp_face_p
);
7329 defsubr (&Sinternal_set_lisp_face_attribute
);
7330 #ifdef HAVE_WINDOW_SYSTEM
7331 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7333 defsubr (&Scolor_gray_p
);
7334 defsubr (&Scolor_supported_p
);
7335 defsubr (&Sface_attribute_relative_p
);
7336 defsubr (&Smerge_face_attribute
);
7337 defsubr (&Sinternal_get_lisp_face_attribute
);
7338 defsubr (&Sinternal_lisp_face_attribute_values
);
7339 defsubr (&Sinternal_lisp_face_equal_p
);
7340 defsubr (&Sinternal_lisp_face_empty_p
);
7341 defsubr (&Sinternal_copy_lisp_face
);
7342 defsubr (&Sinternal_merge_in_global_face
);
7343 defsubr (&Sface_font
);
7344 defsubr (&Sframe_face_alist
);
7345 defsubr (&Sinternal_set_font_selection_order
);
7346 defsubr (&Sinternal_set_alternative_font_family_alist
);
7347 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7348 defsubr (&Sface_attributes_as_vector
);
7350 defsubr (&Sdump_face
);
7351 defsubr (&Sshow_face_resources
);
7352 #endif /* GLYPH_DEBUG */
7353 defsubr (&Sclear_face_cache
);
7354 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7356 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7357 defsubr (&Sdump_colors
);
7360 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7361 doc
: /* *Limit for font matching.
7362 If an integer > 0, font matching functions won't load more than
7363 that number of fonts when searching for a matching font. */);
7364 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7366 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7367 doc
: /* List of global face definitions (for internal use only.) */);
7368 Vface_new_frame_defaults
= Qnil
;
7370 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7371 doc
: /* *Default stipple pattern used on monochrome displays.
7372 This stipple pattern is used on monochrome displays
7373 instead of shades of gray for a face background color.
7374 See `set-face-stipple' for possible values for this variable. */);
7375 Vface_default_stipple
= build_string ("gray3");
7377 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7378 doc
: /* An alist of defined terminal colors and their RGB values. */);
7379 Vtty_defined_color_alist
= Qnil
;
7381 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7382 doc
: /* Allowed scalable fonts.
7383 A value of nil means don't allow any scalable fonts.
7384 A value of t means allow any scalable font.
7385 Otherwise, value must be a list of regular expressions. A font may be
7386 scaled if its name matches a regular expression in the list.
7387 Note that if value is nil, a scalable font might still be used, if no
7388 other font of the appropriate family and registry is available. */);
7389 Vscalable_fonts_allowed
= Qnil
;
7391 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7392 doc
: /* List of ignored fonts.
7393 Each element is a regular expression that matches names of fonts to
7395 Vface_ignored_fonts
= Qnil
;
7397 #ifdef HAVE_WINDOW_SYSTEM
7398 defsubr (&Sbitmap_spec_p
);
7399 defsubr (&Sx_list_fonts
);
7400 defsubr (&Sinternal_face_x_get_resource
);
7401 defsubr (&Sx_family_fonts
);
7402 defsubr (&Sx_font_family_list
);
7403 #endif /* HAVE_WINDOW_SYSTEM */