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"
201 #include "keyboard.h"
204 #ifdef HAVE_WINDOW_SYSTEM
206 #endif /* HAVE_WINDOW_SYSTEM */
208 #ifdef HAVE_X_WINDOWS
212 #include <Xm/XmStrDefs.h>
213 #endif /* USE_MOTIF */
214 #endif /* HAVE_X_WINDOWS */
223 /* Redefine X specifics to W32 equivalents to avoid cluttering the
224 code with #ifdef blocks. */
225 #undef FRAME_X_DISPLAY_INFO
226 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
227 #define x_display_info w32_display_info
228 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
229 #define check_x check_w32
230 #define x_list_fonts w32_list_fonts
231 #define GCGraphicsExposures 0
232 /* For historic reasons, FONT_WIDTH refers to average width on W32,
233 not maximum as on X. Redefine here. */
235 #define FONT_WIDTH FONT_MAX_WIDTH
236 #endif /* WINDOWSNT */
240 #define x_display_info mac_display_info
241 #define check_x check_mac
243 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
246 x_create_gc (f
, mask
, xgcv
)
252 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
261 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
266 #include "dispextern.h"
267 #include "blockinput.h"
269 #include "intervals.h"
271 #ifdef HAVE_X_WINDOWS
273 /* Compensate for a bug in Xos.h on some systems, on which it requires
274 time.h. On some such systems, Xos.h tries to redefine struct
275 timeval and struct timezone if USG is #defined while it is
278 #ifdef XOS_NEEDS_TIME_H
284 #else /* not XOS_NEEDS_TIME_H */
286 #endif /* not XOS_NEEDS_TIME_H */
288 #endif /* HAVE_X_WINDOWS */
293 #define abs(X) ((X) < 0 ? -(X) : (X))
295 /* Number of pt per inch (from the TeXbook). */
297 #define PT_PER_INCH 72.27
299 /* Non-zero if face attribute ATTR is unspecified. */
301 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
303 /* Value is the number of elements of VECTOR. */
305 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
307 /* Make a copy of string S on the stack using alloca. Value is a pointer
310 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
312 /* Make a copy of the contents of Lisp string S on the stack using
313 alloca. Value is a pointer to the copy. */
315 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
317 /* Size of hash table of realized faces in face caches (should be a
320 #define FACE_CACHE_BUCKETS_SIZE 1001
322 /* A definition of XColor for non-X frames. */
324 #ifndef HAVE_X_WINDOWS
329 unsigned short red
, green
, blue
;
335 #endif /* not HAVE_X_WINDOWS */
337 /* Keyword symbols used for face attribute names. */
339 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
340 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
341 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
342 Lisp_Object QCreverse_video
;
343 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
345 /* Symbols used for attribute values. */
347 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
348 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
349 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
350 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
351 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
352 Lisp_Object Qultra_expanded
;
353 Lisp_Object Qreleased_button
, Qpressed_button
;
354 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
355 Lisp_Object Qunspecified
;
357 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
359 /* The name of the function to call when the background of the frame
360 has changed, frame_update_face_colors. */
362 Lisp_Object Qframe_update_face_colors
;
364 /* Names of basic faces. */
366 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
367 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
368 Lisp_Object Qmode_line_inactive
;
369 extern Lisp_Object Qmode_line
;
371 /* The symbol `face-alias'. A symbols having that property is an
372 alias for another face. Value of the property is the name of
375 Lisp_Object Qface_alias
;
377 /* Names of frame parameters related to faces. */
379 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
380 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
382 /* Default stipple pattern used on monochrome displays. This stipple
383 pattern is used on monochrome displays instead of shades of gray
384 for a face background color. See `set-face-stipple' for possible
385 values for this variable. */
387 Lisp_Object Vface_default_stipple
;
389 /* Alist of alternative font families. Each element is of the form
390 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
391 try FAMILY1, then FAMILY2, ... */
393 Lisp_Object Vface_alternative_font_family_alist
;
395 /* Alist of alternative font registries. Each element is of the form
396 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
397 loaded, try REGISTRY1, then REGISTRY2, ... */
399 Lisp_Object Vface_alternative_font_registry_alist
;
401 /* Allowed scalable fonts. A value of nil means don't allow any
402 scalable fonts. A value of t means allow the use of any scalable
403 font. Otherwise, value must be a list of regular expressions. A
404 font may be scaled if its name matches a regular expression in the
407 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
409 /* List of regular expressions that matches names of fonts to ignore. */
411 Lisp_Object Vface_ignored_fonts
;
413 /* Maximum number of fonts to consider in font_list. If not an
414 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
416 Lisp_Object Vfont_list_limit
;
417 #define DEFAULT_FONT_LIST_LIMIT 100
419 /* The symbols `foreground-color' and `background-color' which can be
420 used as part of a `face' property. This is for compatibility with
423 Lisp_Object Qforeground_color
, Qbackground_color
;
425 /* The symbols `face' and `mouse-face' used as text properties. */
428 extern Lisp_Object Qmouse_face
;
430 /* Error symbol for wrong_type_argument in load_pixmap. */
432 Lisp_Object Qbitmap_spec_p
;
434 /* Alist of global face definitions. Each element is of the form
435 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
436 is a Lisp vector of face attributes. These faces are used
437 to initialize faces for new frames. */
439 Lisp_Object Vface_new_frame_defaults
;
441 /* The next ID to assign to Lisp faces. */
443 static int next_lface_id
;
445 /* A vector mapping Lisp face Id's to face names. */
447 static Lisp_Object
*lface_id_to_name
;
448 static int lface_id_to_name_size
;
450 /* TTY color-related functions (defined in tty-colors.el). */
452 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
454 /* The name of the function used to compute colors on TTYs. */
456 Lisp_Object Qtty_color_alist
;
458 /* An alist of defined terminal colors and their RGB values. */
460 Lisp_Object Vtty_defined_color_alist
;
462 /* Counter for calls to clear_face_cache. If this counter reaches
463 CLEAR_FONT_TABLE_COUNT, and a frame has more than
464 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
466 static int clear_font_table_count
;
467 #define CLEAR_FONT_TABLE_COUNT 100
468 #define CLEAR_FONT_TABLE_NFONTS 10
470 /* Non-zero means face attributes have been changed since the last
471 redisplay. Used in redisplay_internal. */
473 int face_change_count
;
475 /* Non-zero means don't display bold text if a face's foreground
476 and background colors are the inverse of the default colors of the
477 display. This is a kluge to suppress `bold black' foreground text
478 which is hard to read on an LCD monitor. */
480 int tty_suppress_bold_inverse_default_colors_p
;
482 /* A list of the form `((x . y))' used to avoid consing in
483 Finternal_set_lisp_face_attribute. */
485 static Lisp_Object Vparam_value_alist
;
487 /* The total number of colors currently allocated. */
490 static int ncolors_allocated
;
491 static int npixmaps_allocated
;
495 /* Non-zero means the definition of the `menu' face for new frames has
498 int menu_face_changed_default
;
501 /* Function prototypes. */
506 static void map_tty_color
P_ ((struct frame
*, struct face
*,
507 enum lface_attribute_index
, int *));
508 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
509 static int may_use_scalable_font_p
P_ ((char *));
510 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
511 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
513 static int x_face_list_fonts
P_ ((struct frame
*, char *,
514 struct font_name
*, int, int));
515 static int font_scalable_p
P_ ((struct font_name
*));
516 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
517 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
518 static unsigned char *xstrlwr
P_ ((unsigned char *));
519 static void signal_error
P_ ((char *, Lisp_Object
));
520 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
521 static void load_face_font
P_ ((struct frame
*, struct face
*));
522 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
523 static void free_face_colors
P_ ((struct frame
*, struct face
*));
524 static int face_color_gray_p
P_ ((struct frame
*, char *));
525 static char *build_font_name
P_ ((struct font_name
*));
526 static void free_font_names
P_ ((struct font_name
*, int));
527 static int sorted_font_list
P_ ((struct frame
*, char *,
528 int (*cmpfn
) P_ ((const void *, const void *)),
529 struct font_name
**));
530 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
531 Lisp_Object
, struct font_name
**));
532 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
533 Lisp_Object
, struct font_name
**));
534 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
535 Lisp_Object
, Lisp_Object
, struct font_name
**));
536 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
537 Lisp_Object
, struct font_name
**));
538 static int cmp_font_names
P_ ((const void *, const void *));
539 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
541 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
544 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
545 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
546 static int realize_basic_faces
P_ ((struct frame
*));
547 static int realize_default_face
P_ ((struct frame
*));
548 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
549 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
550 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
551 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
552 static unsigned lface_hash
P_ ((Lisp_Object
*));
553 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
554 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
555 static void clear_face_gcs
P_ ((struct face_cache
*));
556 static void free_face_cache
P_ ((struct face_cache
*));
557 static int face_numeric_weight
P_ ((Lisp_Object
));
558 static int face_numeric_slant
P_ ((Lisp_Object
));
559 static int face_numeric_swidth
P_ ((Lisp_Object
));
560 static int face_fontset
P_ ((Lisp_Object
*));
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 ASCII
1255 characters. The name of the font to load is determined by lface
1256 and fontset of FACE. */
1259 load_face_font (f
, face
)
1263 struct font_info
*font_info
= NULL
;
1266 face
->font_info_id
= -1;
1268 face
->font_name
= NULL
;
1270 font_name
= choose_face_font (f
, face
->lface
, Qnil
);
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
);
2115 /* Return an ASCII font name generated from fontset name NAME and
2116 ASCII font specification ASCII_SPEC. NAME is a string conforming
2117 to XLFD. ASCII_SPEC is a vector:
2118 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
2121 generate_ascii_font_name (name
, ascii_spec
)
2122 Lisp_Object name
, ascii_spec
;
2124 struct font_name font
;
2127 font
.name
= LSTRDUPA (name
);
2128 if (! split_font_name (NULL
, &font
, 0))
2131 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
)))
2133 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
));
2134 font
.fields
[XLFD_FOUNDRY
] = p
;
2135 while (*p
!= '-') p
++;
2139 font
.fields
[XLFD_FAMILY
] = p
;
2143 font
.fields
[XLFD_FAMILY
] = font
.fields
[XLFD_FOUNDRY
];
2144 font
.fields
[XLFD_FOUNDRY
] = "*";
2147 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
)))
2148 font
.fields
[XLFD_WEIGHT
]
2149 = XSTRING (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
))->data
;
2150 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
)))
2151 font
.fields
[XLFD_SLANT
]
2152 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
))->data
;
2153 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
)))
2154 font
.fields
[XLFD_SWIDTH
]
2155 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
))->data
;
2156 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
)))
2157 font
.fields
[XLFD_ADSTYLE
]
2158 = XSTRING (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
))->data
;
2159 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
2160 font
.fields
[XLFD_REGISTRY
] = p
;
2161 while (*p
!= '-') p
++;
2166 font
.fields
[XLFD_ENCODING
] = p
;
2168 p
= build_font_name (&font
);
2169 name
= build_string (p
);
2176 font_name_registry (fontname
)
2177 Lisp_Object fontname
;
2179 struct font_name font
;
2181 font
.name
= LSTRDUPA (fontname
);
2182 if (! split_font_name (NULL
, &font
, 0))
2184 font
.fields
[XLFD_ENCODING
][-1] = '-';
2185 return build_string (font
.fields
[XLFD_REGISTRY
]);
2188 #ifdef HAVE_WINDOW_SYSTEM
2190 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2194 struct font_name
*font
;
2196 /* Function split_font_name converts fields to lower-case, so there
2197 is no need to use tolower here. */
2198 return *font
->fields
[XLFD_SPACING
] != 'p';
2202 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2204 The actual height of the font when displayed on F depends on the
2205 resolution of both the font and frame. For example, a 10pt font
2206 designed for a 100dpi display will display larger than 10pt on a
2207 75dpi display. (It's not unusual to use fonts not designed for the
2208 display one is using. For example, some intlfonts are available in
2209 72dpi versions, only.)
2211 Value is the real point size of FONT on frame F, or 0 if it cannot
2215 xlfd_point_size (f
, font
)
2217 struct font_name
*font
;
2219 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2220 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2224 if (*pixel_field
== '[')
2226 /* The pixel size field is `[A B C D]' which specifies
2227 a transformation matrix.
2233 by which all glyphs of the font are transformed. The spec
2234 says that s scalar value N for the pixel size is equivalent
2235 to A = N * resx/resy, B = C = 0, D = N. */
2236 char *start
= pixel_field
+ 1, *end
;
2240 for (i
= 0; i
< 4; ++i
)
2242 matrix
[i
] = strtod (start
, &end
);
2249 pixel
= atoi (pixel_field
);
2254 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2260 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2261 of frame F. This function is used to guess a point size of font
2262 when only the pixel height of the font is available. */
2265 pixel_point_size (f
, pixel
)
2269 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2273 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2274 point size of one dot. */
2275 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2276 int_pt
= real_pt
+ 0.5;
2282 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2283 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2284 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2285 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2286 zero if the font name doesn't have the format we expect. The
2287 expected format is a font name that starts with a `-' and has
2288 XLFD_LAST fields separated by `-'. */
2291 split_font_name (f
, font
, numeric_p
)
2293 struct font_name
*font
;
2299 if (*font
->name
== '-')
2301 char *p
= xstrlwr (font
->name
) + 1;
2303 while (i
< XLFD_LAST
)
2305 font
->fields
[i
] = p
;
2308 /* Pixel and point size may be of the form `[....]'. For
2309 BNF, see XLFD spec, chapter 4. Negative values are
2310 indicated by tilde characters which we replace with
2311 `-' characters, here. */
2313 && (i
- 1 == XLFD_PIXEL_SIZE
2314 || i
- 1 == XLFD_POINT_SIZE
))
2319 for (++p
; *p
&& *p
!= ']'; ++p
)
2323 /* Check that the matrix contains 4 floating point
2325 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2328 if (strtod (start
, &end
) == 0 && start
== end
)
2335 while (*p
&& *p
!= '-')
2345 success_p
= i
== XLFD_LAST
;
2347 /* If requested, and font name was in the expected format,
2348 compute numeric values for some fields. */
2349 if (numeric_p
&& success_p
)
2351 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2352 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2353 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2354 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2355 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2356 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2359 /* Initialize it to zero. It will be overridden by font_list while
2360 trying alternate registries. */
2361 font
->registry_priority
= 0;
2367 /* Build an XLFD font name from font name fields in FONT. Value is a
2368 pointer to the font name, which is allocated via xmalloc. */
2371 build_font_name (font
)
2372 struct font_name
*font
;
2376 char *font_name
= (char *) xmalloc (size
);
2377 int total_length
= 0;
2379 for (i
= 0; i
< XLFD_LAST
; ++i
)
2381 /* Add 1 because of the leading `-'. */
2382 int len
= strlen (font
->fields
[i
]) + 1;
2384 /* Reallocate font_name if necessary. Add 1 for the final
2386 if (total_length
+ len
+ 1 >= size
)
2388 int new_size
= max (2 * size
, size
+ len
+ 1);
2389 int sz
= new_size
* sizeof *font_name
;
2390 font_name
= (char *) xrealloc (font_name
, sz
);
2394 font_name
[total_length
] = '-';
2395 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2396 total_length
+= len
;
2399 font_name
[total_length
] = 0;
2404 /* Free an array FONTS of N font_name structures. This frees FONTS
2405 itself and all `name' fields in its elements. */
2408 free_font_names (fonts
, n
)
2409 struct font_name
*fonts
;
2413 xfree (fonts
[--n
].name
);
2418 /* Sort vector FONTS of font_name structures which contains NFONTS
2419 elements using qsort and comparison function CMPFN. F is the frame
2420 on which the fonts will be used. The global variable font_frame
2421 is temporarily set to F to make it available in CMPFN. */
2424 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2426 struct font_name
*fonts
;
2428 int (*cmpfn
) P_ ((const void *, const void *));
2431 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2436 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2437 display in x_display_list. FONTS is a pointer to a vector of
2438 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2439 alternative patterns from Valternate_fontname_alist if no fonts are
2440 found matching PATTERN.
2442 For all fonts found, set FONTS[i].name to the name of the font,
2443 allocated via xmalloc, and split font names into fields. Ignore
2444 fonts that we can't parse. Value is the number of fonts found. */
2447 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2450 struct font_name
*fonts
;
2451 int nfonts
, try_alternatives_p
;
2455 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2456 better to do it the other way around. */
2458 Lisp_Object lpattern
, tem
;
2460 lpattern
= build_string (pattern
);
2462 /* Get the list of fonts matching PATTERN. */
2465 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2468 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2471 /* Make a copy of the font names we got from X, and
2472 split them into fields. */
2474 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2476 Lisp_Object elt
, tail
;
2477 char *name
= XSTRING (XCAR (tem
))->data
;
2479 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2480 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2484 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2493 /* Make a copy of the font name. */
2494 fonts
[n
].name
= xstrdup (name
);
2496 if (split_font_name (f
, fonts
+ n
, 1))
2498 if (font_scalable_p (fonts
+ n
)
2499 && !may_use_scalable_font_p (name
))
2502 xfree (fonts
[n
].name
);
2508 xfree (fonts
[n
].name
);
2511 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2512 if (n
== 0 && try_alternatives_p
)
2514 Lisp_Object list
= Valternate_fontname_alist
;
2516 while (CONSP (list
))
2518 Lisp_Object entry
= XCAR (list
);
2520 && STRINGP (XCAR (entry
))
2521 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2528 Lisp_Object patterns
= XCAR (list
);
2531 while (CONSP (patterns
)
2532 /* If list is screwed up, give up. */
2533 && (name
= XCAR (patterns
),
2535 /* Ignore patterns equal to PATTERN because we tried that
2536 already with no success. */
2537 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2538 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2541 patterns
= XCDR (patterns
);
2549 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2550 using comparison function CMPFN. Value is the number of fonts
2551 found. If value is non-zero, *FONTS is set to a vector of
2552 font_name structures allocated from the heap containing matching
2553 fonts. Each element of *FONTS contains a name member that is also
2554 allocated from the heap. Font names in these structures are split
2555 into fields. Use free_font_names to free such an array. */
2558 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2561 int (*cmpfn
) P_ ((const void *, const void *));
2562 struct font_name
**fonts
;
2566 /* Get the list of fonts matching pattern. 100 should suffice. */
2567 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2568 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2569 nfonts
= XFASTINT (Vfont_list_limit
);
2571 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2572 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2574 /* Sort the resulting array and return it in *FONTS. If no
2575 fonts were found, make sure to set *FONTS to null. */
2577 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2588 /* Compare two font_name structures *A and *B. Value is analogous to
2589 strcmp. Sort order is given by the global variable
2590 font_sort_order. Font names are sorted so that, everything else
2591 being equal, fonts with a resolution closer to that of the frame on
2592 which they are used are listed first. The global variable
2593 font_frame is the frame on which we operate. */
2596 cmp_font_names (a
, b
)
2599 struct font_name
*x
= (struct font_name
*) a
;
2600 struct font_name
*y
= (struct font_name
*) b
;
2603 /* All strings have been converted to lower-case by split_font_name,
2604 so we can use strcmp here. */
2605 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2610 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2612 int j
= font_sort_order
[i
];
2613 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2618 /* Everything else being equal, we prefer fonts with an
2619 y-resolution closer to that of the frame. */
2620 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2621 int x_resy
= x
->numeric
[XLFD_RESY
];
2622 int y_resy
= y
->numeric
[XLFD_RESY
];
2623 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2631 /* Get a sorted list of fonts matching PATTERN. If PATTERN is nil,
2632 list fonts matching FAMILY and REGISTRY. FAMILY is a family name
2633 string or nil. REGISTRY is a registry name string. Set *FONTS to
2634 a vector of font_name structures allocated from the heap containing
2635 the fonts found. Value is the number of fonts found. */
2638 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2640 Lisp_Object pattern
, family
, registry
;
2641 struct font_name
**fonts
;
2643 char *pattern_str
, *family_str
, *registry_str
;
2647 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2648 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2650 pattern_str
= (char *) alloca (strlen (family_str
)
2651 + strlen (registry_str
)
2653 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2654 strcat (pattern_str
, family_str
);
2655 strcat (pattern_str
, "-*-");
2656 strcat (pattern_str
, registry_str
);
2657 if (!index (registry_str
, '-'))
2659 if (registry_str
[strlen (registry_str
) - 1] == '*')
2660 strcat (pattern_str
, "-*");
2662 strcat (pattern_str
, "*-*");
2666 pattern_str
= (char *) XSTRING (pattern
)->data
;
2668 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2672 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2673 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2674 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2677 static struct font_name
*
2678 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2679 struct font_name
*fonts1
, *fonts2
;
2680 int nfonts1
, nfonts2
;
2682 int new_nfonts
= nfonts1
+ nfonts2
;
2683 struct font_name
*new_fonts
;
2685 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2686 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2687 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2694 /* Get a sorted list of fonts of family FAMILY on frame F.
2696 If PATTERN is non-nil, list fonts matching that pattern.
2698 If REGISTRY is non-nil, return fonts with that registry and the
2699 alternative registries from Vface_alternative_font_registry_alist.
2701 If REGISTRY is nil return fonts of any registry.
2703 Set *FONTS to a vector of font_name structures allocated from the
2704 heap containing the fonts found. Value is the number of fonts
2708 font_list (f
, pattern
, family
, registry
, fonts
)
2710 Lisp_Object pattern
, family
, registry
;
2711 struct font_name
**fonts
;
2713 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2715 if (!NILP (registry
)
2716 && CONSP (Vface_alternative_font_registry_alist
))
2720 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2725 for (alter
= XCDR (alter
), reg_prio
= 1;
2727 alter
= XCDR (alter
), reg_prio
++)
2728 if (STRINGP (XCAR (alter
)))
2731 struct font_name
*fonts2
;
2733 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2735 for (i
= 0; i
< nfonts2
; i
++)
2736 fonts2
[i
].registry_priority
= reg_prio
;
2737 *fonts
= (nfonts
> 0
2738 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2749 /* Remove elements from LIST whose cars are `equal'. Called from
2750 x-family-fonts and x-font-family-list to remove duplicate font
2754 remove_duplicates (list
)
2757 Lisp_Object tail
= list
;
2759 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2761 Lisp_Object next
= XCDR (tail
);
2762 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2763 XSETCDR (tail
, XCDR (next
));
2770 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2771 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2772 If FAMILY is omitted or nil, list all families.
2773 Otherwise, FAMILY must be a string, possibly containing wildcards
2775 If FRAME is omitted or nil, use the selected frame.
2776 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2777 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2778 FAMILY is the font family name. POINT-SIZE is the size of the
2779 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2780 width, weight and slant of the font. These symbols are the same as for
2781 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2782 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2783 giving the registry and encoding of the font.
2784 The result list is sorted according to the current setting of
2785 the face font sort order. */)
2787 Lisp_Object family
, frame
;
2789 struct frame
*f
= check_x_frame (frame
);
2790 struct font_name
*fonts
;
2793 struct gcpro gcpro1
;
2796 CHECK_STRING (family
);
2800 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2801 for (i
= nfonts
- 1; i
>= 0; --i
)
2803 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2806 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2807 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2808 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2809 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2810 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2811 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2812 tem
= build_font_name (fonts
+ i
);
2813 ASET (v
, 6, build_string (tem
));
2814 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2815 fonts
[i
].fields
[XLFD_ENCODING
]);
2816 ASET (v
, 7, build_string (tem
));
2819 result
= Fcons (v
, result
);
2822 remove_duplicates (result
);
2823 free_font_names (fonts
, nfonts
);
2829 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2831 doc
: /* Return a list of available font families on FRAME.
2832 If FRAME is omitted or nil, use the selected frame.
2833 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2834 is a font family, and FIXED-P is non-nil if fonts of that family
2835 are fixed-pitch. */)
2839 struct frame
*f
= check_x_frame (frame
);
2841 struct font_name
*fonts
;
2843 struct gcpro gcpro1
;
2844 int count
= specpdl_ptr
- specpdl
;
2847 /* Let's consider all fonts. Increase the limit for matching
2848 fonts until we have them all. */
2851 specbind (intern ("font-list-limit"), make_number (limit
));
2852 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2854 if (nfonts
== limit
)
2856 free_font_names (fonts
, nfonts
);
2865 for (i
= nfonts
- 1; i
>= 0; --i
)
2866 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2867 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2870 remove_duplicates (result
);
2871 free_font_names (fonts
, nfonts
);
2873 return unbind_to (count
, result
);
2877 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2878 doc
: /* Return a list of the names of available fonts matching PATTERN.
2879 If optional arguments FACE and FRAME are specified, return only fonts
2880 the same size as FACE on FRAME.
2881 PATTERN is a string, perhaps with wildcard characters;
2882 the * character matches any substring, and
2883 the ? character matches any single character.
2884 PATTERN is case-insensitive.
2885 FACE is a face name--a symbol.
2887 The return value is a list of strings, suitable as arguments to
2890 Fonts Emacs can't use may or may not be excluded
2891 even if they match PATTERN and FACE.
2892 The optional fourth argument MAXIMUM sets a limit on how many
2893 fonts to match. The first MAXIMUM fonts are reported.
2894 The optional fifth argument WIDTH, if specified, is a number of columns
2895 occupied by a character of a font. In that case, return only fonts
2896 the WIDTH times as wide as FACE on FRAME. */)
2897 (pattern
, face
, frame
, maximum
, width
)
2898 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2905 CHECK_STRING (pattern
);
2911 CHECK_NATNUM (maximum
);
2912 maxnames
= XINT (maximum
);
2916 CHECK_NUMBER (width
);
2918 /* We can't simply call check_x_frame because this function may be
2919 called before any frame is created. */
2920 f
= frame_or_selected_frame (frame
, 2);
2921 if (!FRAME_WINDOW_P (f
))
2923 /* Perhaps we have not yet created any frame. */
2928 /* Determine the width standard for comparison with the fonts we find. */
2934 /* This is of limited utility since it works with character
2935 widths. Keep it for compatibility. --gerd. */
2936 int face_id
= lookup_named_face (f
, face
);
2937 struct face
*face
= (face_id
< 0
2939 : FACE_FROM_ID (f
, face_id
));
2941 if (face
&& face
->font
)
2942 size
= FONT_WIDTH (face
->font
);
2944 size
= FONT_WIDTH (FRAME_FONT (f
));
2947 size
*= XINT (width
);
2951 Lisp_Object args
[2];
2953 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2955 /* We don't have to check fontsets. */
2957 args
[1] = list_fontsets (f
, pattern
, size
);
2958 return Fnconc (2, args
);
2962 #endif /* HAVE_WINDOW_SYSTEM */
2966 /***********************************************************************
2968 ***********************************************************************/
2970 /* Access face attributes of face LFACE, a Lisp vector. */
2972 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2973 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2974 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2975 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2976 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2977 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2978 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2979 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2980 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2981 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2982 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2983 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2984 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2985 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2986 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2987 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2989 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2990 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2992 #define LFACEP(LFACE) \
2994 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2995 && EQ (AREF (LFACE, 0), Qface))
3000 /* Check consistency of Lisp face attribute vector ATTRS. */
3003 check_lface_attrs (attrs
)
3006 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3007 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3008 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3009 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3010 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3011 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3012 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3013 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3014 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3015 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3016 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3017 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3018 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3019 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3020 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3021 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3022 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3023 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3024 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3025 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3026 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3027 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3028 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3029 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3030 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3031 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3032 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3033 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3034 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3035 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3036 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3037 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3038 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3039 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3040 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3041 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3042 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3043 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3044 #ifdef HAVE_WINDOW_SYSTEM
3045 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3046 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3047 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3048 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3049 || NILP (attrs
[LFACE_FONT_INDEX
])
3050 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3055 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3063 xassert (LFACEP (lface
));
3064 check_lface_attrs (XVECTOR (lface
)->contents
);
3068 #else /* GLYPH_DEBUG == 0 */
3070 #define check_lface_attrs(attrs) (void) 0
3071 #define check_lface(lface) (void) 0
3073 #endif /* GLYPH_DEBUG == 0 */
3076 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3077 to make it a symvol. If FACE_NAME is an alias for another face,
3078 return that face's name. */
3081 resolve_face_name (face_name
)
3082 Lisp_Object face_name
;
3084 Lisp_Object aliased
;
3086 if (STRINGP (face_name
))
3087 face_name
= intern (XSTRING (face_name
)->data
);
3089 while (SYMBOLP (face_name
))
3091 aliased
= Fget (face_name
, Qface_alias
);
3095 face_name
= aliased
;
3102 /* Return the face definition of FACE_NAME on frame F. F null means
3103 return the definition for new frames. FACE_NAME may be a string or
3104 a symbol (apparently Emacs 20.2 allowed strings as face names in
3105 face text properties; Ediff uses that). If FACE_NAME is an alias
3106 for another face, return that face's definition. If SIGNAL_P is
3107 non-zero, signal an error if FACE_NAME is not a valid face name.
3108 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3111 static INLINE Lisp_Object
3112 lface_from_face_name (f
, face_name
, signal_p
)
3114 Lisp_Object face_name
;
3119 face_name
= resolve_face_name (face_name
);
3122 lface
= assq_no_quit (face_name
, f
->face_alist
);
3124 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3127 lface
= XCDR (lface
);
3129 signal_error ("Invalid face", face_name
);
3131 check_lface (lface
);
3136 /* Get face attributes of face FACE_NAME from frame-local faces on
3137 frame F. Store the resulting attributes in ATTRS which must point
3138 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3139 is non-zero, signal an error if FACE_NAME does not name a face.
3140 Otherwise, value is zero if FACE_NAME is not a face. */
3143 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3145 Lisp_Object face_name
;
3152 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3155 bcopy (XVECTOR (lface
)->contents
, attrs
,
3156 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3166 /* Non-zero if all attributes in face attribute vector ATTRS are
3167 specified, i.e. are non-nil. */
3170 lface_fully_specified_p (attrs
)
3175 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3176 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3177 && i
!= LFACE_AVGWIDTH_INDEX
)
3178 if (UNSPECIFIEDP (attrs
[i
]))
3181 return i
== LFACE_VECTOR_SIZE
;
3184 #ifdef HAVE_WINDOW_SYSTEM
3186 /* Set font-related attributes of Lisp face LFACE from the fullname of
3187 the font opened by FONTNAME. If FORCE_P is zero, set only
3188 unspecified attributes of LFACE. The exception is `font'
3189 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3191 If FONTNAME is not available on frame F,
3192 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3193 If the fullname is not in a valid XLFD format,
3194 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3195 in LFACE and return 1.
3196 Otherwise, return 1.
3198 Currently this function is always called with both FORCE_P and
3199 MAIL_FAIL_P non-zero. */
3202 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3205 Lisp_Object fontname
;
3206 int force_p
, may_fail_p
;
3208 struct font_name font
;
3213 char *font_name
= XSTRING (fontname
)->data
;
3214 struct font_info
*font_info
;
3216 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3217 fontset
= fs_query_fontset (fontname
, 0);
3219 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3221 /* Check if FONT_NAME is surely available on the system. Usually
3222 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3223 returns quickly. But, even if FONT_NAME is not yet cached,
3224 caching it now is not futail because we anyway load the font
3227 font_info
= FS_LOAD_FONT (f
, font_name
);
3237 font
.name
= STRDUPA (font_info
->full_name
);
3238 have_xlfd_p
= split_font_name (f
, &font
, 1);
3240 /* Set attributes only if unspecified, otherwise face defaults for
3241 new frames would never take effect. If we couldn't get a font
3242 name conforming to XLFD, set normal values. */
3244 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3249 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3250 + strlen (font
.fields
[XLFD_FOUNDRY
])
3252 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3253 font
.fields
[XLFD_FAMILY
]);
3254 val
= build_string (buffer
);
3257 val
= build_string ("*");
3258 LFACE_FAMILY (lface
) = val
;
3261 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3264 pt
= xlfd_point_size (f
, &font
);
3266 pt
= pixel_point_size (f
, font_info
->height
* 10);
3268 LFACE_HEIGHT (lface
) = make_number (pt
);
3271 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3272 LFACE_SWIDTH (lface
)
3273 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3275 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3276 LFACE_AVGWIDTH (lface
)
3278 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3281 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3282 LFACE_WEIGHT (lface
)
3283 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3285 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3287 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3289 LFACE_FONT (lface
) = fontname
;
3294 #endif /* HAVE_WINDOW_SYSTEM */
3297 /* Merges the face height FROM with the face height TO, and returns the
3298 merged height. If FROM is an invalid height, then INVALID is
3299 returned instead. FROM and TO may be either absolute face heights or
3300 `relative' heights; the returned value is always an absolute height
3301 unless both FROM and TO are relative. GCPRO is a lisp value that
3302 will be protected from garbage-collection if this function makes a
3306 merge_face_heights (from
, to
, invalid
, gcpro
)
3307 Lisp_Object from
, to
, invalid
, gcpro
;
3309 Lisp_Object result
= invalid
;
3311 if (INTEGERP (from
))
3312 /* FROM is absolute, just use it as is. */
3314 else if (FLOATP (from
))
3315 /* FROM is a scale, use it to adjust TO. */
3318 /* relative X absolute => absolute */
3319 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3320 else if (FLOATP (to
))
3321 /* relative X relative => relative */
3322 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3324 else if (FUNCTIONP (from
))
3325 /* FROM is a function, which use to adjust TO. */
3327 /* Call function with current height as argument.
3328 From is the new height. */
3329 Lisp_Object args
[2];
3330 struct gcpro gcpro1
;
3336 result
= safe_call (2, args
);
3340 /* Ensure that if TO was absolute, so is the result. */
3341 if (INTEGERP (to
) && !INTEGERP (result
))
3349 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3350 store the resulting attributes in TO, which must be already be
3351 completely specified and contain only absolute attributes. Every
3352 specified attribute of FROM overrides the corresponding attribute of
3353 TO; relative attributes in FROM are merged with the absolute value in
3354 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3355 face inheritance; it should be Qnil when called from other places. */
3358 merge_face_vectors (f
, from
, to
, cycle_check
)
3360 Lisp_Object
*from
, *to
;
3361 Lisp_Object cycle_check
;
3365 /* If FROM inherits from some other faces, merge their attributes into
3366 TO before merging FROM's direct attributes. Note that an :inherit
3367 attribute of `unspecified' is the same as one of nil; we never
3368 merge :inherit attributes, so nil is more correct, but lots of
3369 other code uses `unspecified' as a generic value for face attributes. */
3370 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3371 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3372 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3374 /* If TO specifies a :font attribute, and FROM specifies some
3375 font-related attribute, we need to clear TO's :font attribute
3376 (because it will be inconsistent with whatever FROM specifies, and
3377 FROM takes precedence). */
3378 if (!NILP (to
[LFACE_FONT_INDEX
])
3379 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3380 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3381 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3382 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3383 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3384 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3385 to
[LFACE_FONT_INDEX
] = Qnil
;
3387 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3388 if (!UNSPECIFIEDP (from
[i
]))
3390 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3391 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3396 /* TO is always an absolute face, which should inherit from nothing.
3397 We blindly copy the :inherit attribute above and fix it up here. */
3398 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3402 /* Checks the `cycle check' variable CHECK to see if it indicates that
3403 EL is part of a cycle; CHECK must be either Qnil or a value returned
3404 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3405 elements after which a cycle might be suspected; after that many
3406 elements, this macro begins consing in order to keep more precise
3409 Returns nil if a cycle was detected, otherwise a new value for CHECK
3412 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3413 the caller should make sure that's ok. */
3415 #define CYCLE_CHECK(check, el, suspicious) \
3418 : (INTEGERP (check) \
3419 ? (XFASTINT (check) < (suspicious) \
3420 ? make_number (XFASTINT (check) + 1) \
3421 : Fcons (el, Qnil)) \
3422 : (!NILP (Fmemq ((el), (check))) \
3424 : Fcons ((el), (check)))))
3427 /* Merge face attributes from the face on frame F whose name is
3428 INHERITS, into the vector of face attributes TO; INHERITS may also be
3429 a list of face names, in which case they are applied in order.
3430 CYCLE_CHECK is used to detect loops in face inheritance.
3431 Returns true if any of the inherited attributes are `font-related'. */
3434 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3436 Lisp_Object inherit
;
3438 Lisp_Object cycle_check
;
3440 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3441 /* Inherit from the named face INHERIT. */
3445 /* Make sure we're not in an inheritance loop. */
3446 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3447 if (NILP (cycle_check
))
3448 /* Cycle detected, ignore any further inheritance. */
3451 lface
= lface_from_face_name (f
, inherit
, 0);
3453 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3455 else if (CONSP (inherit
))
3456 /* Handle a list of inherited faces by calling ourselves recursively
3457 on each element. Note that we only do so for symbol elements, so
3458 it's not possible to infinitely recurse. */
3460 while (CONSP (inherit
))
3462 if (SYMBOLP (XCAR (inherit
)))
3463 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3465 /* Check for a circular inheritance list. */
3466 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3467 if (NILP (cycle_check
))
3468 /* Cycle detected. */
3471 inherit
= XCDR (inherit
);
3477 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3478 is a face property, determine the resulting face attributes on
3479 frame F, and store them in TO. PROP may be a single face
3480 specification or a list of such specifications. Each face
3481 specification can be
3483 1. A symbol or string naming a Lisp face.
3485 2. A property list of the form (KEYWORD VALUE ...) where each
3486 KEYWORD is a face attribute name, and value is an appropriate value
3489 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3490 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3491 for compatibility with 20.2.
3493 Face specifications earlier in lists take precedence over later
3497 merge_face_vector_with_property (f
, to
, prop
)
3504 Lisp_Object first
= XCAR (prop
);
3506 if (EQ (first
, Qforeground_color
)
3507 || EQ (first
, Qbackground_color
))
3509 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3510 . COLOR). COLOR must be a string. */
3511 Lisp_Object color_name
= XCDR (prop
);
3512 Lisp_Object color
= first
;
3514 if (STRINGP (color_name
))
3516 if (EQ (color
, Qforeground_color
))
3517 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3519 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3522 add_to_log ("Invalid face color", color_name
, Qnil
);
3524 else if (SYMBOLP (first
)
3525 && *XSYMBOL (first
)->name
->data
== ':')
3527 /* Assume this is the property list form. */
3528 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3530 Lisp_Object keyword
= XCAR (prop
);
3531 Lisp_Object value
= XCAR (XCDR (prop
));
3533 if (EQ (keyword
, QCfamily
))
3535 if (STRINGP (value
))
3536 to
[LFACE_FAMILY_INDEX
] = value
;
3538 add_to_log ("Invalid face font family", value
, Qnil
);
3540 else if (EQ (keyword
, QCheight
))
3542 Lisp_Object new_height
=
3543 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3546 if (NILP (new_height
))
3547 add_to_log ("Invalid face font height", value
, Qnil
);
3549 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3551 else if (EQ (keyword
, QCweight
))
3554 && face_numeric_weight (value
) >= 0)
3555 to
[LFACE_WEIGHT_INDEX
] = value
;
3557 add_to_log ("Invalid face weight", value
, Qnil
);
3559 else if (EQ (keyword
, QCslant
))
3562 && face_numeric_slant (value
) >= 0)
3563 to
[LFACE_SLANT_INDEX
] = value
;
3565 add_to_log ("Invalid face slant", value
, Qnil
);
3567 else if (EQ (keyword
, QCunderline
))
3572 to
[LFACE_UNDERLINE_INDEX
] = value
;
3574 add_to_log ("Invalid face underline", value
, Qnil
);
3576 else if (EQ (keyword
, QCoverline
))
3581 to
[LFACE_OVERLINE_INDEX
] = value
;
3583 add_to_log ("Invalid face overline", value
, Qnil
);
3585 else if (EQ (keyword
, QCstrike_through
))
3590 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3592 add_to_log ("Invalid face strike-through", value
, Qnil
);
3594 else if (EQ (keyword
, QCbox
))
3597 value
= make_number (1);
3598 if (INTEGERP (value
)
3602 to
[LFACE_BOX_INDEX
] = value
;
3604 add_to_log ("Invalid face box", value
, Qnil
);
3606 else if (EQ (keyword
, QCinverse_video
)
3607 || EQ (keyword
, QCreverse_video
))
3609 if (EQ (value
, Qt
) || NILP (value
))
3610 to
[LFACE_INVERSE_INDEX
] = value
;
3612 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3614 else if (EQ (keyword
, QCforeground
))
3616 if (STRINGP (value
))
3617 to
[LFACE_FOREGROUND_INDEX
] = value
;
3619 add_to_log ("Invalid face foreground", value
, Qnil
);
3621 else if (EQ (keyword
, QCbackground
))
3623 if (STRINGP (value
))
3624 to
[LFACE_BACKGROUND_INDEX
] = value
;
3626 add_to_log ("Invalid face background", value
, Qnil
);
3628 else if (EQ (keyword
, QCstipple
))
3630 #ifdef HAVE_X_WINDOWS
3631 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3632 if (!NILP (pixmap_p
))
3633 to
[LFACE_STIPPLE_INDEX
] = value
;
3635 add_to_log ("Invalid face stipple", value
, Qnil
);
3638 else if (EQ (keyword
, QCwidth
))
3641 && face_numeric_swidth (value
) >= 0)
3642 to
[LFACE_SWIDTH_INDEX
] = value
;
3644 add_to_log ("Invalid face width", value
, Qnil
);
3646 else if (EQ (keyword
, QCinherit
))
3648 if (SYMBOLP (value
))
3649 to
[LFACE_INHERIT_INDEX
] = value
;
3653 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3654 if (!SYMBOLP (XCAR (tail
)))
3657 to
[LFACE_INHERIT_INDEX
] = value
;
3659 add_to_log ("Invalid face inherit", value
, Qnil
);
3663 add_to_log ("Invalid attribute %s in face property",
3666 prop
= XCDR (XCDR (prop
));
3671 /* This is a list of face specs. Specifications at the
3672 beginning of the list take precedence over later
3673 specifications, so we have to merge starting with the
3674 last specification. */
3675 Lisp_Object next
= XCDR (prop
);
3677 merge_face_vector_with_property (f
, to
, next
);
3678 merge_face_vector_with_property (f
, to
, first
);
3683 /* PROP ought to be a face name. */
3684 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3686 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3688 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3693 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3694 Sinternal_make_lisp_face
, 1, 2, 0,
3695 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3696 If FACE was not known as a face before, create a new one.
3697 If optional argument FRAME is specified, make a frame-local face
3698 for that frame. Otherwise operate on the global face definition.
3699 Value is a vector of face attributes. */)
3701 Lisp_Object face
, frame
;
3703 Lisp_Object global_lface
, lface
;
3707 CHECK_SYMBOL (face
);
3708 global_lface
= lface_from_face_name (NULL
, face
, 0);
3712 CHECK_LIVE_FRAME (frame
);
3714 lface
= lface_from_face_name (f
, face
, 0);
3717 f
= NULL
, lface
= Qnil
;
3719 /* Add a global definition if there is none. */
3720 if (NILP (global_lface
))
3722 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3724 AREF (global_lface
, 0) = Qface
;
3725 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3726 Vface_new_frame_defaults
);
3728 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3729 face id to Lisp face is given by the vector lface_id_to_name.
3730 The mapping from Lisp face to Lisp face id is given by the
3731 property `face' of the Lisp face name. */
3732 if (next_lface_id
== lface_id_to_name_size
)
3734 int new_size
= max (50, 2 * lface_id_to_name_size
);
3735 int sz
= new_size
* sizeof *lface_id_to_name
;
3736 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3737 lface_id_to_name_size
= new_size
;
3740 lface_id_to_name
[next_lface_id
] = face
;
3741 Fput (face
, Qface
, make_number (next_lface_id
));
3745 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3746 AREF (global_lface
, i
) = Qunspecified
;
3748 /* Add a frame-local definition. */
3753 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3755 AREF (lface
, 0) = Qface
;
3756 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3759 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3760 AREF (lface
, i
) = Qunspecified
;
3763 lface
= global_lface
;
3765 /* Changing a named face means that all realized faces depending on
3766 that face are invalid. Since we cannot tell which realized faces
3767 depend on the face, make sure they are all removed. This is done
3768 by incrementing face_change_count. The next call to
3769 init_iterator will then free realized faces. */
3770 ++face_change_count
;
3771 ++windows_or_buffers_changed
;
3773 xassert (LFACEP (lface
));
3774 check_lface (lface
);
3779 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3780 Sinternal_lisp_face_p
, 1, 2, 0,
3781 doc
: /* Return non-nil if FACE names a face.
3782 If optional second parameter FRAME is non-nil, check for the
3783 existence of a frame-local face with name FACE on that frame.
3784 Otherwise check for the existence of a global face. */)
3786 Lisp_Object face
, frame
;
3792 CHECK_LIVE_FRAME (frame
);
3793 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3796 lface
= lface_from_face_name (NULL
, face
, 0);
3802 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3803 Sinternal_copy_lisp_face
, 4, 4, 0,
3804 doc
: /* Copy face FROM to TO.
3805 If FRAME it t, copy the global face definition of FROM to the
3806 global face definition of TO. Otherwise, copy the frame-local
3807 definition of FROM on FRAME to the frame-local definition of TO
3808 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3811 (from
, to
, frame
, new_frame
)
3812 Lisp_Object from
, to
, frame
, new_frame
;
3814 Lisp_Object lface
, copy
;
3816 CHECK_SYMBOL (from
);
3818 if (NILP (new_frame
))
3823 /* Copy global definition of FROM. We don't make copies of
3824 strings etc. because 20.2 didn't do it either. */
3825 lface
= lface_from_face_name (NULL
, from
, 1);
3826 copy
= Finternal_make_lisp_face (to
, Qnil
);
3830 /* Copy frame-local definition of FROM. */
3831 CHECK_LIVE_FRAME (frame
);
3832 CHECK_LIVE_FRAME (new_frame
);
3833 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3834 copy
= Finternal_make_lisp_face (to
, new_frame
);
3837 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3838 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3840 /* Changing a named face means that all realized faces depending on
3841 that face are invalid. Since we cannot tell which realized faces
3842 depend on the face, make sure they are all removed. This is done
3843 by incrementing face_change_count. The next call to
3844 init_iterator will then free realized faces. */
3845 ++face_change_count
;
3846 ++windows_or_buffers_changed
;
3852 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3853 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3854 doc
: /* Set attribute ATTR of FACE to VALUE.
3855 FRAME being a frame means change the face on that frame.
3856 FRAME nil means change the face of the selected frame.
3857 FRAME t means change the default for new frames.
3858 FRAME 0 means change the face on all frames, and change the default
3860 (face
, attr
, value
, frame
)
3861 Lisp_Object face
, attr
, value
, frame
;
3864 Lisp_Object old_value
= Qnil
;
3865 /* Set 1 if ATTR is QCfont. */
3866 int font_attr_p
= 0;
3867 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3868 int font_related_attr_p
= 0;
3870 CHECK_SYMBOL (face
);
3871 CHECK_SYMBOL (attr
);
3873 face
= resolve_face_name (face
);
3875 /* If FRAME is 0, change face on all frames, and change the
3876 default for new frames. */
3877 if (INTEGERP (frame
) && XINT (frame
) == 0)
3880 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3881 FOR_EACH_FRAME (tail
, frame
)
3882 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3886 /* Set lface to the Lisp attribute vector of FACE. */
3888 lface
= lface_from_face_name (NULL
, face
, 1);
3892 frame
= selected_frame
;
3894 CHECK_LIVE_FRAME (frame
);
3895 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3897 /* If a frame-local face doesn't exist yet, create one. */
3899 lface
= Finternal_make_lisp_face (face
, frame
);
3902 if (EQ (attr
, QCfamily
))
3904 if (!UNSPECIFIEDP (value
))
3906 CHECK_STRING (value
);
3907 if (XSTRING (value
)->size
== 0)
3908 signal_error ("Invalid face family", value
);
3910 old_value
= LFACE_FAMILY (lface
);
3911 LFACE_FAMILY (lface
) = value
;
3912 font_related_attr_p
= 1;
3914 else if (EQ (attr
, QCheight
))
3916 if (!UNSPECIFIEDP (value
))
3920 test
= (EQ (face
, Qdefault
)
3922 /* The default face must have an absolute size,
3923 otherwise, we do a test merge with a random
3924 height to see if VALUE's ok. */
3925 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3927 if (!INTEGERP (test
) || XINT (test
) <= 0)
3928 signal_error ("Invalid face height", value
);
3931 old_value
= LFACE_HEIGHT (lface
);
3932 LFACE_HEIGHT (lface
) = value
;
3933 font_related_attr_p
= 1;
3935 else if (EQ (attr
, QCweight
))
3937 if (!UNSPECIFIEDP (value
))
3939 CHECK_SYMBOL (value
);
3940 if (face_numeric_weight (value
) < 0)
3941 signal_error ("Invalid face weight", value
);
3943 old_value
= LFACE_WEIGHT (lface
);
3944 LFACE_WEIGHT (lface
) = value
;
3945 font_related_attr_p
= 1;
3947 else if (EQ (attr
, QCslant
))
3949 if (!UNSPECIFIEDP (value
))
3951 CHECK_SYMBOL (value
);
3952 if (face_numeric_slant (value
) < 0)
3953 signal_error ("Invalid face slant", value
);
3955 old_value
= LFACE_SLANT (lface
);
3956 LFACE_SLANT (lface
) = value
;
3957 font_related_attr_p
= 1;
3959 else if (EQ (attr
, QCunderline
))
3961 if (!UNSPECIFIEDP (value
))
3962 if ((SYMBOLP (value
)
3964 && !EQ (value
, Qnil
))
3965 /* Underline color. */
3967 && XSTRING (value
)->size
== 0))
3968 signal_error ("Invalid face underline", value
);
3970 old_value
= LFACE_UNDERLINE (lface
);
3971 LFACE_UNDERLINE (lface
) = value
;
3973 else if (EQ (attr
, QCoverline
))
3975 if (!UNSPECIFIEDP (value
))
3976 if ((SYMBOLP (value
)
3978 && !EQ (value
, Qnil
))
3979 /* Overline color. */
3981 && XSTRING (value
)->size
== 0))
3982 signal_error ("Invalid face overline", value
);
3984 old_value
= LFACE_OVERLINE (lface
);
3985 LFACE_OVERLINE (lface
) = value
;
3987 else if (EQ (attr
, QCstrike_through
))
3989 if (!UNSPECIFIEDP (value
))
3990 if ((SYMBOLP (value
)
3992 && !EQ (value
, Qnil
))
3993 /* Strike-through color. */
3995 && XSTRING (value
)->size
== 0))
3996 signal_error ("Invalid face strike-through", value
);
3998 old_value
= LFACE_STRIKE_THROUGH (lface
);
3999 LFACE_STRIKE_THROUGH (lface
) = value
;
4001 else if (EQ (attr
, QCbox
))
4005 /* Allow t meaning a simple box of width 1 in foreground color
4008 value
= make_number (1);
4010 if (UNSPECIFIEDP (value
))
4012 else if (NILP (value
))
4014 else if (INTEGERP (value
))
4015 valid_p
= XINT (value
) != 0;
4016 else if (STRINGP (value
))
4017 valid_p
= XSTRING (value
)->size
> 0;
4018 else if (CONSP (value
))
4034 if (EQ (k
, QCline_width
))
4036 if (!INTEGERP (v
) || XINT (v
) == 0)
4039 else if (EQ (k
, QCcolor
))
4041 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
4044 else if (EQ (k
, QCstyle
))
4046 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4053 valid_p
= NILP (tem
);
4059 signal_error ("Invalid face box", value
);
4061 old_value
= LFACE_BOX (lface
);
4062 LFACE_BOX (lface
) = value
;
4064 else if (EQ (attr
, QCinverse_video
)
4065 || EQ (attr
, QCreverse_video
))
4067 if (!UNSPECIFIEDP (value
))
4069 CHECK_SYMBOL (value
);
4070 if (!EQ (value
, Qt
) && !NILP (value
))
4071 signal_error ("Invalid inverse-video face attribute value", value
);
4073 old_value
= LFACE_INVERSE (lface
);
4074 LFACE_INVERSE (lface
) = value
;
4076 else if (EQ (attr
, QCforeground
))
4078 if (!UNSPECIFIEDP (value
))
4080 /* Don't check for valid color names here because it depends
4081 on the frame (display) whether the color will be valid
4082 when the face is realized. */
4083 CHECK_STRING (value
);
4084 if (XSTRING (value
)->size
== 0)
4085 signal_error ("Empty foreground color value", value
);
4087 old_value
= LFACE_FOREGROUND (lface
);
4088 LFACE_FOREGROUND (lface
) = value
;
4090 else if (EQ (attr
, QCbackground
))
4092 if (!UNSPECIFIEDP (value
))
4094 /* Don't check for valid color names here because it depends
4095 on the frame (display) whether the color will be valid
4096 when the face is realized. */
4097 CHECK_STRING (value
);
4098 if (XSTRING (value
)->size
== 0)
4099 signal_error ("Empty background color value", value
);
4101 old_value
= LFACE_BACKGROUND (lface
);
4102 LFACE_BACKGROUND (lface
) = value
;
4104 else if (EQ (attr
, QCstipple
))
4106 #ifdef HAVE_X_WINDOWS
4107 if (!UNSPECIFIEDP (value
)
4109 && NILP (Fbitmap_spec_p (value
)))
4110 signal_error ("Invalid stipple attribute", value
);
4111 old_value
= LFACE_STIPPLE (lface
);
4112 LFACE_STIPPLE (lface
) = value
;
4113 #endif /* HAVE_X_WINDOWS */
4115 else if (EQ (attr
, QCwidth
))
4117 if (!UNSPECIFIEDP (value
))
4119 CHECK_SYMBOL (value
);
4120 if (face_numeric_swidth (value
) < 0)
4121 signal_error ("Invalid face width", value
);
4123 old_value
= LFACE_SWIDTH (lface
);
4124 LFACE_SWIDTH (lface
) = value
;
4125 font_related_attr_p
= 1;
4127 else if (EQ (attr
, QCfont
))
4129 #ifdef HAVE_WINDOW_SYSTEM
4130 if (FRAME_WINDOW_P (XFRAME (frame
)))
4132 /* Set font-related attributes of the Lisp face from an XLFD
4137 CHECK_STRING (value
);
4139 f
= SELECTED_FRAME ();
4141 f
= check_x_frame (frame
);
4143 /* VALUE may be a fontset name or an alias of fontset. In
4144 such a case, use the base fontset name. */
4145 tmp
= Fquery_fontset (value
, Qnil
);
4149 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4150 signal_error ("Invalid font or fontset name", value
);
4154 #endif /* HAVE_WINDOW_SYSTEM */
4156 else if (EQ (attr
, QCinherit
))
4159 if (SYMBOLP (value
))
4162 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4163 if (!SYMBOLP (XCAR (tail
)))
4166 LFACE_INHERIT (lface
) = value
;
4168 signal_error ("Invalid face inheritance", value
);
4170 else if (EQ (attr
, QCbold
))
4172 old_value
= LFACE_WEIGHT (lface
);
4173 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4174 font_related_attr_p
= 1;
4176 else if (EQ (attr
, QCitalic
))
4178 old_value
= LFACE_SLANT (lface
);
4179 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4180 font_related_attr_p
= 1;
4183 signal_error ("Invalid face attribute name", attr
);
4185 if (font_related_attr_p
4186 && !UNSPECIFIEDP (value
))
4187 /* If a font-related attribute other than QCfont is specified, the
4188 original `font' attribute nor that of default face is useless
4189 to determine a new font. Thus, we set it to nil so that font
4190 selection mechanism doesn't use it. */
4191 LFACE_FONT (lface
) = Qnil
;
4193 /* Changing a named face means that all realized faces depending on
4194 that face are invalid. Since we cannot tell which realized faces
4195 depend on the face, make sure they are all removed. This is done
4196 by incrementing face_change_count. The next call to
4197 init_iterator will then free realized faces. */
4199 && (EQ (attr
, QCfont
)
4200 || NILP (Fequal (old_value
, value
))))
4202 ++face_change_count
;
4203 ++windows_or_buffers_changed
;
4206 if (!UNSPECIFIEDP (value
)
4207 && NILP (Fequal (old_value
, value
)))
4213 if (EQ (face
, Qdefault
))
4215 #ifdef HAVE_WINDOW_SYSTEM
4216 /* Changed font-related attributes of the `default' face are
4217 reflected in changed `font' frame parameters. */
4219 && (font_related_attr_p
|| font_attr_p
)
4220 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4221 set_font_frame_param (frame
, lface
);
4223 #endif /* HAVE_WINDOW_SYSTEM */
4225 if (EQ (attr
, QCforeground
))
4226 param
= Qforeground_color
;
4227 else if (EQ (attr
, QCbackground
))
4228 param
= Qbackground_color
;
4230 #ifdef HAVE_WINDOW_SYSTEM
4232 else if (EQ (face
, Qscroll_bar
))
4234 /* Changing the colors of `scroll-bar' sets frame parameters
4235 `scroll-bar-foreground' and `scroll-bar-background'. */
4236 if (EQ (attr
, QCforeground
))
4237 param
= Qscroll_bar_foreground
;
4238 else if (EQ (attr
, QCbackground
))
4239 param
= Qscroll_bar_background
;
4241 #endif /* not WINDOWSNT */
4242 else if (EQ (face
, Qborder
))
4244 /* Changing background color of `border' sets frame parameter
4246 if (EQ (attr
, QCbackground
))
4247 param
= Qborder_color
;
4249 else if (EQ (face
, Qcursor
))
4251 /* Changing background color of `cursor' sets frame parameter
4253 if (EQ (attr
, QCbackground
))
4254 param
= Qcursor_color
;
4256 else if (EQ (face
, Qmouse
))
4258 /* Changing background color of `mouse' sets frame parameter
4260 if (EQ (attr
, QCbackground
))
4261 param
= Qmouse_color
;
4263 #endif /* HAVE_WINDOW_SYSTEM */
4264 else if (EQ (face
, Qmenu
))
4266 /* Indicate that we have to update the menu bar when
4267 realizing faces on FRAME. FRAME t change the
4268 default for new frames. We do this by setting
4269 setting the flag in new face caches */
4272 struct frame
*f
= XFRAME (frame
);
4273 if (FRAME_FACE_CACHE (f
) == NULL
)
4274 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4275 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4278 menu_face_changed_default
= 1;
4284 /* Update `default-frame-alist', which is used for new frames. */
4286 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4289 /* Update the current frame's parameters. */
4292 cons
= XCAR (Vparam_value_alist
);
4293 XSETCAR (cons
, param
);
4294 XSETCDR (cons
, value
);
4295 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4304 #ifdef HAVE_WINDOW_SYSTEM
4306 /* Set the `font' frame parameter of FRAME determined from `default'
4307 face attributes LFACE. If a face or fontset name is explicitely
4308 specfied in LFACE, use it as is. Otherwise, determine a font name
4309 from the other font-related atrributes of LFACE. In that case, if
4310 there's no matching font, signals an error. */
4313 set_font_frame_param (frame
, lface
)
4314 Lisp_Object frame
, lface
;
4316 struct frame
*f
= XFRAME (frame
);
4318 if (FRAME_WINDOW_P (f
))
4320 Lisp_Object font_name
;
4323 if (STRINGP (LFACE_FONT (lface
)))
4324 font_name
= LFACE_FONT (lface
);
4327 /* Choose a font name that reflects LFACE's attributes and has
4328 the registry and encoding pattern specified in the default
4329 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4330 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
);
4332 error ("No font matches the specified attribute");
4333 font_name
= build_string (font
);
4337 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4342 /* Update the corresponding face when frame parameter PARAM on frame F
4343 has been assigned the value NEW_VALUE. */
4346 update_face_from_frame_parameter (f
, param
, new_value
)
4348 Lisp_Object param
, new_value
;
4352 /* If there are no faces yet, give up. This is the case when called
4353 from Fx_create_frame, and we do the necessary things later in
4354 face-set-after-frame-defaults. */
4355 if (NILP (f
->face_alist
))
4358 /* Changing a named face means that all realized faces depending on
4359 that face are invalid. Since we cannot tell which realized faces
4360 depend on the face, make sure they are all removed. This is done
4361 by incrementing face_change_count. The next call to
4362 init_iterator will then free realized faces. */
4363 ++face_change_count
;
4364 ++windows_or_buffers_changed
;
4366 if (EQ (param
, Qforeground_color
))
4368 lface
= lface_from_face_name (f
, Qdefault
, 1);
4369 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4370 ? new_value
: Qunspecified
);
4371 realize_basic_faces (f
);
4373 else if (EQ (param
, Qbackground_color
))
4377 /* Changing the background color might change the background
4378 mode, so that we have to load new defface specs. Call
4379 frame-update-face-colors to do that. */
4380 XSETFRAME (frame
, f
);
4381 call1 (Qframe_update_face_colors
, frame
);
4383 lface
= lface_from_face_name (f
, Qdefault
, 1);
4384 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4385 ? new_value
: Qunspecified
);
4386 realize_basic_faces (f
);
4388 if (EQ (param
, Qborder_color
))
4390 lface
= lface_from_face_name (f
, Qborder
, 1);
4391 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4392 ? new_value
: Qunspecified
);
4394 else if (EQ (param
, Qcursor_color
))
4396 lface
= lface_from_face_name (f
, Qcursor
, 1);
4397 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4398 ? new_value
: Qunspecified
);
4400 else if (EQ (param
, Qmouse_color
))
4402 lface
= lface_from_face_name (f
, Qmouse
, 1);
4403 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4404 ? new_value
: Qunspecified
);
4409 /* Get the value of X resource RESOURCE, class CLASS for the display
4410 of frame FRAME. This is here because ordinary `x-get-resource'
4411 doesn't take a frame argument. */
4413 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4414 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4415 (resource
, class, frame
)
4416 Lisp_Object resource
, class, frame
;
4418 Lisp_Object value
= Qnil
;
4421 CHECK_STRING (resource
);
4422 CHECK_STRING (class);
4423 CHECK_LIVE_FRAME (frame
);
4425 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4426 resource
, class, Qnil
, Qnil
);
4428 #endif /* not macintosh */
4429 #endif /* not WINDOWSNT */
4434 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4435 If VALUE is "on" or "true", return t. If VALUE is "off" or
4436 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4437 error; if SIGNAL_P is zero, return 0. */
4440 face_boolean_x_resource_value (value
, signal_p
)
4444 Lisp_Object result
= make_number (0);
4446 xassert (STRINGP (value
));
4448 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4449 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4451 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4452 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4454 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4455 result
= Qunspecified
;
4457 signal_error ("Invalid face attribute value from X resource", value
);
4463 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4464 Finternal_set_lisp_face_attribute_from_resource
,
4465 Sinternal_set_lisp_face_attribute_from_resource
,
4466 3, 4, 0, doc
: /* */)
4467 (face
, attr
, value
, frame
)
4468 Lisp_Object face
, attr
, value
, frame
;
4470 CHECK_SYMBOL (face
);
4471 CHECK_SYMBOL (attr
);
4472 CHECK_STRING (value
);
4474 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4475 value
= Qunspecified
;
4476 else if (EQ (attr
, QCheight
))
4478 value
= Fstring_to_number (value
, make_number (10));
4479 if (XINT (value
) <= 0)
4480 signal_error ("Invalid face height from X resource", value
);
4482 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4483 value
= face_boolean_x_resource_value (value
, 1);
4484 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4485 value
= intern (XSTRING (value
)->data
);
4486 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4487 value
= face_boolean_x_resource_value (value
, 1);
4488 else if (EQ (attr
, QCunderline
)
4489 || EQ (attr
, QCoverline
)
4490 || EQ (attr
, QCstrike_through
))
4492 Lisp_Object boolean_value
;
4494 /* If the result of face_boolean_x_resource_value is t or nil,
4495 VALUE does NOT specify a color. */
4496 boolean_value
= face_boolean_x_resource_value (value
, 0);
4497 if (SYMBOLP (boolean_value
))
4498 value
= boolean_value
;
4500 else if (EQ (attr
, QCbox
))
4501 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4503 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4506 #endif /* HAVE_WINDOW_SYSTEM */
4509 /***********************************************************************
4511 ***********************************************************************/
4513 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4515 /* Make menus on frame F appear as specified by the `menu' face. */
4518 x_update_menu_appearance (f
)
4521 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4525 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4529 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4530 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4531 char *myname
= XSTRING (Vx_resource_name
)->data
;
4534 const char *popup_path
= "popup_menu";
4536 const char *popup_path
= "menu.popup";
4539 if (STRINGP (LFACE_FOREGROUND (lface
)))
4541 sprintf (line
, "%s.%s*foreground: %s",
4543 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4544 XrmPutLineResource (&rdb
, line
);
4545 sprintf (line
, "%s.pane.menubar*foreground: %s",
4546 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4547 XrmPutLineResource (&rdb
, line
);
4551 if (STRINGP (LFACE_BACKGROUND (lface
)))
4553 sprintf (line
, "%s.%s*background: %s",
4555 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4556 XrmPutLineResource (&rdb
, line
);
4557 sprintf (line
, "%s.pane.menubar*background: %s",
4558 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4559 XrmPutLineResource (&rdb
, line
);
4564 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4565 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4566 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4567 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4568 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4569 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4572 const char *suffix
= "List";
4574 const char *suffix
= "";
4576 sprintf (line
, "%s.pane.menubar*font%s: %s",
4577 myname
, suffix
, face
->font_name
);
4578 XrmPutLineResource (&rdb
, line
);
4579 sprintf (line
, "%s.%s*font%s: %s",
4580 myname
, popup_path
, suffix
, face
->font_name
);
4581 XrmPutLineResource (&rdb
, line
);
4585 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4586 free_frame_menubar (f
);
4590 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4593 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4594 Sface_attribute_relative_p
,
4596 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4598 Lisp_Object attribute
, value
;
4600 if (EQ (value
, Qunspecified
))
4602 else if (EQ (attribute
, QCheight
))
4603 return INTEGERP (value
) ? Qnil
: Qt
;
4608 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4610 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4611 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4612 the result will be absolute, otherwise it will be relative. */)
4613 (attribute
, value1
, value2
)
4614 Lisp_Object attribute
, value1
, value2
;
4616 if (EQ (value1
, Qunspecified
))
4618 else if (EQ (attribute
, QCheight
))
4619 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4625 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4626 Sinternal_get_lisp_face_attribute
,
4628 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4629 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4630 face attribute name, signal an error.
4631 If the optional argument FRAME is given, report on face FACE in that
4632 frame. If FRAME is t, report on the defaults for face FACE (for new
4633 frames). If FRAME is omitted or nil, use the selected frame. */)
4634 (symbol
, keyword
, frame
)
4635 Lisp_Object symbol
, keyword
, frame
;
4637 Lisp_Object lface
, value
= Qnil
;
4639 CHECK_SYMBOL (symbol
);
4640 CHECK_SYMBOL (keyword
);
4643 lface
= lface_from_face_name (NULL
, symbol
, 1);
4647 frame
= selected_frame
;
4648 CHECK_LIVE_FRAME (frame
);
4649 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4652 if (EQ (keyword
, QCfamily
))
4653 value
= LFACE_FAMILY (lface
);
4654 else if (EQ (keyword
, QCheight
))
4655 value
= LFACE_HEIGHT (lface
);
4656 else if (EQ (keyword
, QCweight
))
4657 value
= LFACE_WEIGHT (lface
);
4658 else if (EQ (keyword
, QCslant
))
4659 value
= LFACE_SLANT (lface
);
4660 else if (EQ (keyword
, QCunderline
))
4661 value
= LFACE_UNDERLINE (lface
);
4662 else if (EQ (keyword
, QCoverline
))
4663 value
= LFACE_OVERLINE (lface
);
4664 else if (EQ (keyword
, QCstrike_through
))
4665 value
= LFACE_STRIKE_THROUGH (lface
);
4666 else if (EQ (keyword
, QCbox
))
4667 value
= LFACE_BOX (lface
);
4668 else if (EQ (keyword
, QCinverse_video
)
4669 || EQ (keyword
, QCreverse_video
))
4670 value
= LFACE_INVERSE (lface
);
4671 else if (EQ (keyword
, QCforeground
))
4672 value
= LFACE_FOREGROUND (lface
);
4673 else if (EQ (keyword
, QCbackground
))
4674 value
= LFACE_BACKGROUND (lface
);
4675 else if (EQ (keyword
, QCstipple
))
4676 value
= LFACE_STIPPLE (lface
);
4677 else if (EQ (keyword
, QCwidth
))
4678 value
= LFACE_SWIDTH (lface
);
4679 else if (EQ (keyword
, QCinherit
))
4680 value
= LFACE_INHERIT (lface
);
4681 else if (EQ (keyword
, QCfont
))
4682 value
= LFACE_FONT (lface
);
4684 signal_error ("Invalid face attribute name", keyword
);
4690 DEFUN ("internal-lisp-face-attribute-values",
4691 Finternal_lisp_face_attribute_values
,
4692 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4693 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4694 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4698 Lisp_Object result
= Qnil
;
4700 CHECK_SYMBOL (attr
);
4702 if (EQ (attr
, QCweight
)
4703 || EQ (attr
, QCslant
)
4704 || EQ (attr
, QCwidth
))
4706 /* Extract permissible symbols from tables. */
4707 struct table_entry
*table
;
4710 if (EQ (attr
, QCweight
))
4711 table
= weight_table
, dim
= DIM (weight_table
);
4712 else if (EQ (attr
, QCslant
))
4713 table
= slant_table
, dim
= DIM (slant_table
);
4715 table
= swidth_table
, dim
= DIM (swidth_table
);
4717 for (i
= 0; i
< dim
; ++i
)
4719 Lisp_Object symbol
= *table
[i
].symbol
;
4720 Lisp_Object tail
= result
;
4723 && !EQ (XCAR (tail
), symbol
))
4727 result
= Fcons (symbol
, result
);
4730 else if (EQ (attr
, QCunderline
))
4731 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4732 else if (EQ (attr
, QCoverline
))
4733 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4734 else if (EQ (attr
, QCstrike_through
))
4735 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4736 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4737 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4743 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4744 Sinternal_merge_in_global_face
, 2, 2, 0,
4745 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4746 Default face attributes override any local face attributes. */)
4748 Lisp_Object face
, frame
;
4751 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4753 CHECK_LIVE_FRAME (frame
);
4754 global_lface
= lface_from_face_name (NULL
, face
, 1);
4755 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4756 if (NILP (local_lface
))
4757 local_lface
= Finternal_make_lisp_face (face
, frame
);
4759 /* Make every specified global attribute override the local one.
4760 BEWARE!! This is only used from `face-set-after-frame-default' where
4761 the local frame is defined from default specs in `face-defface-spec'
4762 and those should be overridden by global settings. Hence the strange
4763 "global before local" priority. */
4764 lvec
= XVECTOR (local_lface
)->contents
;
4765 gvec
= XVECTOR (global_lface
)->contents
;
4766 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4767 if (! UNSPECIFIEDP (gvec
[i
]))
4774 /* The following function is implemented for compatibility with 20.2.
4775 The function is used in x-resolve-fonts when it is asked to
4776 return fonts with the same size as the font of a face. This is
4777 done in fontset.el. */
4779 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4780 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4781 If the optional argument FRAME is given, report on face FACE in that frame.
4782 If FRAME is t, report on the defaults for face FACE (for new frames).
4783 The font default for a face is either nil, or a list
4784 of the form (bold), (italic) or (bold italic).
4785 If FRAME is omitted or nil, use the selected frame. */)
4787 Lisp_Object face
, frame
;
4791 Lisp_Object result
= Qnil
;
4792 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4794 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4795 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4796 result
= Fcons (Qbold
, result
);
4798 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4799 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4800 result
= Fcons (Qitalic
, result
);
4806 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4807 int face_id
= lookup_named_face (f
, face
);
4808 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4809 return face
? build_string (face
->font_name
) : Qnil
;
4814 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4815 all attributes are `equal'. Tries to be fast because this function
4816 is called quite often. */
4819 lface_equal_p (v1
, v2
)
4820 Lisp_Object
*v1
, *v2
;
4824 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4826 Lisp_Object a
= v1
[i
];
4827 Lisp_Object b
= v2
[i
];
4829 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4830 and the other is specified. */
4831 equal_p
= XTYPE (a
) == XTYPE (b
);
4840 equal_p
= ((STRING_BYTES (XSTRING (a
))
4841 == STRING_BYTES (XSTRING (b
)))
4842 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4843 STRING_BYTES (XSTRING (a
))) == 0);
4852 equal_p
= !NILP (Fequal (a
, b
));
4862 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4863 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4864 doc
: /* True if FACE1 and FACE2 are equal.
4865 If the optional argument FRAME is given, report on face FACE in that frame.
4866 If FRAME is t, report on the defaults for face FACE (for new frames).
4867 If FRAME is omitted or nil, use the selected frame. */)
4868 (face1
, face2
, frame
)
4869 Lisp_Object face1
, face2
, frame
;
4873 Lisp_Object lface1
, lface2
;
4878 /* Don't use check_x_frame here because this function is called
4879 before X frames exist. At that time, if FRAME is nil,
4880 selected_frame will be used which is the frame dumped with
4881 Emacs. That frame is not an X frame. */
4882 f
= frame_or_selected_frame (frame
, 2);
4884 lface1
= lface_from_face_name (NULL
, face1
, 1);
4885 lface2
= lface_from_face_name (NULL
, face2
, 1);
4886 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4887 XVECTOR (lface2
)->contents
);
4888 return equal_p
? Qt
: Qnil
;
4892 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4893 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4894 doc
: /* True if FACE has no attribute specified.
4895 If the optional argument FRAME is given, report on face FACE in that frame.
4896 If FRAME is t, report on the defaults for face FACE (for new frames).
4897 If FRAME is omitted or nil, use the selected frame. */)
4899 Lisp_Object face
, frame
;
4906 frame
= selected_frame
;
4907 CHECK_LIVE_FRAME (frame
);
4911 lface
= lface_from_face_name (NULL
, face
, 1);
4913 lface
= lface_from_face_name (f
, face
, 1);
4915 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4916 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4919 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4923 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4925 doc
: /* Return an alist of frame-local faces defined on FRAME.
4926 For internal use only. */)
4930 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4931 return f
->face_alist
;
4935 /* Return a hash code for Lisp string STRING with case ignored. Used
4936 below in computing a hash value for a Lisp face. */
4938 static INLINE
unsigned
4939 hash_string_case_insensitive (string
)
4944 xassert (STRINGP (string
));
4945 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4946 hash
= (hash
<< 1) ^ tolower (*s
);
4951 /* Return a hash code for face attribute vector V. */
4953 static INLINE
unsigned
4957 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4958 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4959 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4960 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4961 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4962 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4963 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4967 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4968 considering charsets/registries). They do if they specify the same
4969 family, point size, weight, width, slant, and fontset. Both LFACE1
4970 and LFACE2 must be fully-specified. */
4973 lface_same_font_attributes_p (lface1
, lface2
)
4974 Lisp_Object
*lface1
, *lface2
;
4976 xassert (lface_fully_specified_p (lface1
)
4977 && lface_fully_specified_p (lface2
));
4978 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4979 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4980 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4981 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4982 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4983 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4984 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4985 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4986 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4987 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4988 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4989 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4994 /***********************************************************************
4996 ***********************************************************************/
4998 /* Allocate and return a new realized face for Lisp face attribute
5001 static struct face
*
5002 make_realized_face (attr
)
5005 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5006 bzero (face
, sizeof *face
);
5007 face
->ascii_face
= face
;
5008 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5013 /* Free realized face FACE, including its X resources. FACE may
5017 free_realized_face (f
, face
)
5023 #ifdef HAVE_WINDOW_SYSTEM
5024 if (FRAME_WINDOW_P (f
))
5026 /* Free fontset of FACE if it is ASCII face. */
5027 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5028 free_face_fontset (f
, face
);
5031 x_free_gc (f
, face
->gc
);
5035 free_face_colors (f
, face
);
5036 x_destroy_bitmap (f
, face
->stipple
);
5038 #endif /* HAVE_WINDOW_SYSTEM */
5045 /* Prepare face FACE for subsequent display on frame F. This
5046 allocated GCs if they haven't been allocated yet or have been freed
5047 by clearing the face cache. */
5050 prepare_face_for_display (f
, face
)
5054 #ifdef HAVE_WINDOW_SYSTEM
5055 xassert (FRAME_WINDOW_P (f
));
5060 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5062 xgcv
.foreground
= face
->foreground
;
5063 xgcv
.background
= face
->background
;
5064 #ifdef HAVE_X_WINDOWS
5065 xgcv
.graphics_exposures
= False
;
5067 /* The font of FACE may be null if we couldn't load it. */
5070 #ifdef HAVE_X_WINDOWS
5071 xgcv
.font
= face
->font
->fid
;
5074 xgcv
.font
= face
->font
;
5077 xgcv
.font
= face
->font
;
5083 #ifdef HAVE_X_WINDOWS
5086 xgcv
.fill_style
= FillOpaqueStippled
;
5087 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5088 mask
|= GCFillStyle
| GCStipple
;
5091 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5094 #endif /* HAVE_WINDOW_SYSTEM */
5098 /***********************************************************************
5100 ***********************************************************************/
5102 /* Return a new face cache for frame F. */
5104 static struct face_cache
*
5108 struct face_cache
*c
;
5111 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5112 bzero (c
, sizeof *c
);
5113 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5114 c
->buckets
= (struct face
**) xmalloc (size
);
5115 bzero (c
->buckets
, size
);
5117 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5119 c
->menu_face_changed_p
= menu_face_changed_default
;
5124 /* Clear out all graphics contexts for all realized faces, except for
5125 the basic faces. This should be done from time to time just to avoid
5126 keeping too many graphics contexts that are no longer needed. */
5130 struct face_cache
*c
;
5132 if (c
&& FRAME_WINDOW_P (c
->f
))
5134 #ifdef HAVE_WINDOW_SYSTEM
5136 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5138 struct face
*face
= c
->faces_by_id
[i
];
5139 if (face
&& face
->gc
)
5141 x_free_gc (c
->f
, face
->gc
);
5145 #endif /* HAVE_WINDOW_SYSTEM */
5150 /* Free all realized faces in face cache C, including basic faces. C
5151 may be null. If faces are freed, make sure the frame's current
5152 matrix is marked invalid, so that a display caused by an expose
5153 event doesn't try to use faces we destroyed. */
5156 free_realized_faces (c
)
5157 struct face_cache
*c
;
5162 struct frame
*f
= c
->f
;
5164 /* We must block input here because we can't process X events
5165 safely while only some faces are freed, or when the frame's
5166 current matrix still references freed faces. */
5169 for (i
= 0; i
< c
->used
; ++i
)
5171 free_realized_face (f
, c
->faces_by_id
[i
]);
5172 c
->faces_by_id
[i
] = NULL
;
5176 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5177 bzero (c
->buckets
, size
);
5179 /* Must do a thorough redisplay the next time. Mark current
5180 matrices as invalid because they will reference faces freed
5181 above. This function is also called when a frame is
5182 destroyed. In this case, the root window of F is nil. */
5183 if (WINDOWP (f
->root_window
))
5185 clear_current_matrices (f
);
5186 ++windows_or_buffers_changed
;
5194 /* Free all realized faces that are using FONTSET on frame F. */
5197 free_realized_faces_for_fontset (f
, fontset
)
5201 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5205 /* We must block input here because we can't process X events safely
5206 while only some faces are freed, or when the frame's current
5207 matrix still references freed faces. */
5210 for (i
= 0; i
< cache
->used
; i
++)
5212 face
= cache
->faces_by_id
[i
];
5214 && face
->fontset
== fontset
)
5216 uncache_face (cache
, face
);
5217 free_realized_face (f
, face
);
5221 /* Must do a thorough redisplay the next time. Mark current
5222 matrices as invalid because they will reference faces freed
5223 above. This function is also called when a frame is destroyed.
5224 In this case, the root window of F is nil. */
5225 if (WINDOWP (f
->root_window
))
5227 clear_current_matrices (f
);
5228 ++windows_or_buffers_changed
;
5235 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5236 This is done after attributes of a named face have been changed,
5237 because we can't tell which realized faces depend on that face. */
5240 free_all_realized_faces (frame
)
5246 FOR_EACH_FRAME (rest
, frame
)
5247 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5250 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5254 /* Free face cache C and faces in it, including their X resources. */
5258 struct face_cache
*c
;
5262 free_realized_faces (c
);
5264 xfree (c
->faces_by_id
);
5270 /* Cache realized face FACE in face cache C. HASH is the hash value
5271 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5272 FACE), insert the new face to the beginning of the collision list
5273 of the face hash table of C. Otherwise, add the new face to the
5274 end of the collision list. This way, lookup_face can quickly find
5275 that a requested face is not cached. */
5278 cache_face (c
, face
, hash
)
5279 struct face_cache
*c
;
5283 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5287 if (face
->ascii_face
!= face
)
5289 struct face
*last
= c
->buckets
[i
];
5300 c
->buckets
[i
] = face
;
5301 face
->prev
= face
->next
= NULL
;
5307 face
->next
= c
->buckets
[i
];
5309 face
->next
->prev
= face
;
5310 c
->buckets
[i
] = face
;
5313 /* Find a free slot in C->faces_by_id and use the index of the free
5314 slot as FACE->id. */
5315 for (i
= 0; i
< c
->used
; ++i
)
5316 if (c
->faces_by_id
[i
] == NULL
)
5320 /* Maybe enlarge C->faces_by_id. */
5321 if (i
== c
->used
&& c
->used
== c
->size
)
5323 int new_size
= 2 * c
->size
;
5324 int sz
= new_size
* sizeof *c
->faces_by_id
;
5325 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5330 /* Check that FACE got a unique id. */
5335 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5336 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5342 #endif /* GLYPH_DEBUG */
5344 c
->faces_by_id
[i
] = face
;
5350 /* Remove face FACE from cache C. */
5353 uncache_face (c
, face
)
5354 struct face_cache
*c
;
5357 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5360 face
->prev
->next
= face
->next
;
5362 c
->buckets
[i
] = face
->next
;
5365 face
->next
->prev
= face
->prev
;
5367 c
->faces_by_id
[face
->id
] = NULL
;
5368 if (face
->id
== c
->used
)
5373 /* Look up a realized face with face attributes ATTR in the face cache
5374 of frame F. The face will be used to display ASCII characters.
5375 Value is the ID of the face found. If no suitable face is found,
5376 realize a new one. */
5379 lookup_face (f
, attr
)
5383 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5388 xassert (cache
!= NULL
);
5389 check_lface_attrs (attr
);
5391 /* Look up ATTR in the face cache. */
5392 hash
= lface_hash (attr
);
5393 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5395 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5397 if (face
->ascii_face
!= face
)
5399 /* There's no more ASCII face. */
5403 if (face
->hash
== hash
5404 && lface_equal_p (face
->lface
, attr
))
5408 /* If not found, realize a new face. */
5410 face
= realize_face (cache
, attr
, -1);
5413 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5414 #endif /* GLYPH_DEBUG */
5420 /* Look up a realized face that has the same attributes as BASE_FACE
5421 except for the font in the face cache of frame F. If FONT_ID is
5422 not negative, it is an ID number of an already opened font that is
5423 used by the face. If FONT_ID is negative, the face has no font.
5424 Value is the ID of the face found. If no suitable face is found,
5425 realize a new one. */
5428 lookup_non_ascii_face (f
, font_id
, base_face
)
5431 struct face
*base_face
;
5433 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5438 xassert (cache
!= NULL
);
5439 base_face
= base_face
->ascii_face
;
5440 hash
= lface_hash (base_face
->lface
);
5441 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5443 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5445 if (face
->ascii_face
== face
)
5447 if (face
->ascii_face
== base_face
5448 && face
->font_info_id
== font_id
)
5452 /* If not found, realize a new face. */
5454 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5457 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5458 #endif /* GLYPH_DEBUG */
5464 /* Return the face id of the realized face for named face SYMBOL on
5465 frame F suitable for displaying ASCII characters. Value is -1 if
5466 the face couldn't be determined, which might happen if the default
5467 face isn't realized and cannot be realized. */
5470 lookup_named_face (f
, symbol
)
5474 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5475 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5476 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5478 if (default_face
== NULL
)
5480 if (!realize_basic_faces (f
))
5482 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5485 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5486 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5487 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5488 return lookup_face (f
, attrs
);
5492 /* Return the ID of the realized ASCII face of Lisp face with ID
5493 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5496 ascii_face_of_lisp_face (f
, lface_id
)
5502 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5504 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5505 face_id
= lookup_named_face (f
, face_name
);
5514 /* Return a face for charset ASCII that is like the face with id
5515 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5516 STEPS < 0 means larger. Value is the id of the face. */
5519 smaller_face (f
, face_id
, steps
)
5523 #ifdef HAVE_WINDOW_SYSTEM
5525 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5526 int pt
, last_pt
, last_height
;
5529 struct face
*new_face
;
5531 /* If not called for an X frame, just return the original face. */
5532 if (FRAME_TERMCAP_P (f
))
5535 /* Try in increments of 1/2 pt. */
5536 delta
= steps
< 0 ? 5 : -5;
5537 steps
= abs (steps
);
5539 face
= FACE_FROM_ID (f
, face_id
);
5540 bcopy (face
->lface
, attrs
, sizeof attrs
);
5541 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5542 new_face_id
= face_id
;
5543 last_height
= FONT_HEIGHT (face
->font
);
5547 /* Give up if we cannot find a font within 10pt. */
5548 && abs (last_pt
- pt
) < 100)
5550 /* Look up a face for a slightly smaller/larger font. */
5552 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5553 new_face_id
= lookup_face (f
, attrs
);
5554 new_face
= FACE_FROM_ID (f
, new_face_id
);
5556 /* If height changes, count that as one step. */
5557 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5558 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5561 last_height
= FONT_HEIGHT (new_face
->font
);
5568 #else /* not HAVE_WINDOW_SYSTEM */
5572 #endif /* not HAVE_WINDOW_SYSTEM */
5576 /* Return a face for charset ASCII that is like the face with id
5577 FACE_ID on frame F, but has height HEIGHT. */
5580 face_with_height (f
, face_id
, height
)
5585 #ifdef HAVE_WINDOW_SYSTEM
5587 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5589 if (FRAME_TERMCAP_P (f
)
5593 face
= FACE_FROM_ID (f
, face_id
);
5594 bcopy (face
->lface
, attrs
, sizeof attrs
);
5595 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5596 face_id
= lookup_face (f
, attrs
);
5597 #endif /* HAVE_WINDOW_SYSTEM */
5603 /* Return the face id of the realized face for named face SYMBOL on
5604 frame F suitable for displaying ASCII characters, and use
5605 attributes of the face FACE_ID for attributes that aren't
5606 completely specified by SYMBOL. This is like lookup_named_face,
5607 except that the default attributes come from FACE_ID, not from the
5608 default face. FACE_ID is assumed to be already realized. */
5611 lookup_derived_face (f
, symbol
, face_id
)
5616 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5617 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5618 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5623 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5624 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5625 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5626 return lookup_face (f
, attrs
);
5629 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5630 Sface_attributes_as_vector
, 1, 1, 0,
5631 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5636 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5638 merge_face_vector_with_property (XFRAME (selected_frame
),
5639 XVECTOR (lface
)->contents
,
5646 /***********************************************************************
5648 ***********************************************************************/
5650 DEFUN ("internal-set-font-selection-order",
5651 Finternal_set_font_selection_order
,
5652 Sinternal_set_font_selection_order
, 1, 1, 0,
5653 doc
: /* Set font selection order for face font selection to ORDER.
5654 ORDER must be a list of length 4 containing the symbols `:width',
5655 `:height', `:weight', and `:slant'. Face attributes appearing
5656 first in ORDER are matched first, e.g. if `:height' appears before
5657 `:weight' in ORDER, font selection first tries to find a font with
5658 a suitable height, and then tries to match the font weight.
5665 int indices
[DIM (font_sort_order
)];
5668 bzero (indices
, sizeof indices
);
5672 CONSP (list
) && i
< DIM (indices
);
5673 list
= XCDR (list
), ++i
)
5675 Lisp_Object attr
= XCAR (list
);
5678 if (EQ (attr
, QCwidth
))
5680 else if (EQ (attr
, QCheight
))
5681 xlfd
= XLFD_POINT_SIZE
;
5682 else if (EQ (attr
, QCweight
))
5684 else if (EQ (attr
, QCslant
))
5689 if (indices
[i
] != 0)
5694 if (!NILP (list
) || i
!= DIM (indices
))
5695 signal_error ("Invalid font sort order", order
);
5696 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5697 if (indices
[i
] == 0)
5698 signal_error ("Invalid font sort order", order
);
5700 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5702 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5703 free_all_realized_faces (Qnil
);
5710 DEFUN ("internal-set-alternative-font-family-alist",
5711 Finternal_set_alternative_font_family_alist
,
5712 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5713 doc
: /* Define alternative font families to try in face font selection.
5714 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5715 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5716 be found. Value is ALIST. */)
5721 Vface_alternative_font_family_alist
= alist
;
5722 free_all_realized_faces (Qnil
);
5727 DEFUN ("internal-set-alternative-font-registry-alist",
5728 Finternal_set_alternative_font_registry_alist
,
5729 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5730 doc
: /* Define alternative font registries to try in face font selection.
5731 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5732 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5733 be found. Value is ALIST. */)
5738 Vface_alternative_font_registry_alist
= alist
;
5739 free_all_realized_faces (Qnil
);
5744 #ifdef HAVE_WINDOW_SYSTEM
5746 /* Value is non-zero if FONT is the name of a scalable font. The
5747 X11R6 XLFD spec says that point size, pixel size, and average width
5748 are zero for scalable fonts. Intlfonts contain at least one
5749 scalable font ("*-muleindian-1") for which this isn't true, so we
5750 just test average width. */
5753 font_scalable_p (font
)
5754 struct font_name
*font
;
5756 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5757 return (*s
== '0' && *(s
+ 1) == '\0')
5759 /* Windows implementation of XLFD is slightly broken for backward
5760 compatibility with previous broken versions, so test for
5761 wildcards as well as 0. */
5768 /* Ignore the difference of font point size less than this value. */
5770 #define FONT_POINT_SIZE_QUANTUM 5
5772 /* Value is non-zero if FONT1 is a better match for font attributes
5773 VALUES than FONT2. VALUES is an array of face attribute values in
5774 font sort order. COMPARE_PT_P zero means don't compare point
5775 sizes. AVGWIDTH, if not zero, is a specified font average width
5779 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5781 struct font_name
*font1
, *font2
;
5782 int compare_pt_p
, avgwidth
;
5786 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5788 int xlfd_idx
= font_sort_order
[i
];
5790 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5792 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5793 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5795 if (xlfd_idx
== XLFD_POINT_SIZE
5796 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5798 if (delta1
> delta2
)
5800 else if (delta1
< delta2
)
5804 /* The difference may be equal because, e.g., the face
5805 specifies `italic' but we have only `regular' and
5806 `oblique'. Prefer `oblique' in this case. */
5807 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5808 && font1
->numeric
[xlfd_idx
] > values
[i
]
5809 && font2
->numeric
[xlfd_idx
] < values
[i
])
5817 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5818 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5819 if (delta1
> delta2
)
5821 else if (delta1
< delta2
)
5825 return font1
->registry_priority
< font2
->registry_priority
;
5829 /* Value is non-zero if FONT is an exact match for face attributes in
5830 SPECIFIED. SPECIFIED is an array of face attribute values in font
5831 sort order. AVGWIDTH, if non-zero, is an average width to compare
5835 exact_face_match_p (specified
, font
, avgwidth
)
5837 struct font_name
*font
;
5842 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5843 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5846 return (i
== DIM (font_sort_order
)
5848 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5852 /* Value is the name of a scaled font, generated from scalable font
5853 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5854 Value is allocated from heap. */
5857 build_scalable_font_name (f
, font
, specified_pt
)
5859 struct font_name
*font
;
5862 char point_size
[20], pixel_size
[20];
5864 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5867 /* If scalable font is for a specific resolution, compute
5868 the point size we must specify from the resolution of
5869 the display and the specified resolution of the font. */
5870 if (font
->numeric
[XLFD_RESY
] != 0)
5872 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5873 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5878 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5881 /* Set point size of the font. */
5882 sprintf (point_size
, "%d", (int) pt
);
5883 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5884 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5886 /* Set pixel size. */
5887 sprintf (pixel_size
, "%d", pixel_value
);
5888 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5889 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5891 /* If font doesn't specify its resolution, use the
5892 resolution of the display. */
5893 if (font
->numeric
[XLFD_RESY
] == 0)
5896 sprintf (buffer
, "%d", (int) resy
);
5897 font
->fields
[XLFD_RESY
] = buffer
;
5898 font
->numeric
[XLFD_RESY
] = resy
;
5901 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5904 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5905 sprintf (buffer
, "%d", resx
);
5906 font
->fields
[XLFD_RESX
] = buffer
;
5907 font
->numeric
[XLFD_RESX
] = resx
;
5910 return build_font_name (font
);
5914 /* Value is non-zero if we are allowed to use scalable font FONT. We
5915 can't run a Lisp function here since this function may be called
5916 with input blocked. */
5919 may_use_scalable_font_p (font
)
5922 if (EQ (Vscalable_fonts_allowed
, Qt
))
5924 else if (CONSP (Vscalable_fonts_allowed
))
5926 Lisp_Object tail
, regexp
;
5928 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5930 regexp
= XCAR (tail
);
5931 if (STRINGP (regexp
)
5932 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5942 /* Return the name of the best matching font for face attributes ATTRS
5943 in the array of font_name structures FONTS which contains NFONTS
5944 elements. WIDTH_RATIO is a factor with which to multiply average
5945 widths if ATTRS specifies such a width.
5947 Value is a font name which is allocated from the heap. FONTS is
5948 freed by this function. */
5951 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5954 struct font_name
*fonts
;
5959 struct font_name
*best
;
5962 int exact_p
, avgwidth
;
5967 /* Make specified font attributes available in `specified',
5968 indexed by sort order. */
5969 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5971 int xlfd_idx
= font_sort_order
[i
];
5973 if (xlfd_idx
== XLFD_SWIDTH
)
5974 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5975 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5976 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5977 else if (xlfd_idx
== XLFD_WEIGHT
)
5978 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5979 else if (xlfd_idx
== XLFD_SLANT
)
5980 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5985 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5987 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5991 /* Start with the first non-scalable font in the list. */
5992 for (i
= 0; i
< nfonts
; ++i
)
5993 if (!font_scalable_p (fonts
+ i
))
5996 /* Find the best match among the non-scalable fonts. */
6001 for (i
= 1; i
< nfonts
; ++i
)
6002 if (!font_scalable_p (fonts
+ i
)
6003 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6007 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6016 /* Unless we found an exact match among non-scalable fonts, see if
6017 we can find a better match among scalable fonts. */
6020 /* A scalable font is better if
6022 1. its weight, slant, swidth attributes are better, or.
6024 2. the best non-scalable font doesn't have the required
6025 point size, and the scalable fonts weight, slant, swidth
6028 int non_scalable_has_exact_height_p
;
6030 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6031 non_scalable_has_exact_height_p
= 1;
6033 non_scalable_has_exact_height_p
= 0;
6035 for (i
= 0; i
< nfonts
; ++i
)
6036 if (font_scalable_p (fonts
+ i
))
6039 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6040 || (!non_scalable_has_exact_height_p
6041 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6046 if (font_scalable_p (best
))
6047 font_name
= build_scalable_font_name (f
, best
, pt
);
6049 font_name
= build_font_name (best
);
6051 /* Free font_name structures. */
6052 free_font_names (fonts
, nfonts
);
6058 /* Get a list of matching fonts on frame F, considering FAMILY
6059 and alternative font families from Vface_alternative_font_registry_alist.
6061 FAMILY is the font family whose alternatives are considered.
6063 REGISTRY, if a string, specifies a font registry and encoding to
6064 match. A value of nil means include fonts of any registry and
6067 Return in *FONTS a pointer to a vector of font_name structures for
6068 the fonts matched. Value is the number of fonts found. */
6071 try_alternative_families (f
, family
, registry
, fonts
)
6073 Lisp_Object family
, registry
;
6074 struct font_name
**fonts
;
6079 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6082 /* Try alternative font families. */
6083 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6086 for (alter
= XCDR (alter
);
6087 CONSP (alter
) && nfonts
== 0;
6088 alter
= XCDR (alter
))
6090 if (STRINGP (XCAR (alter
)))
6091 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6095 /* Try scalable fonts before giving up. */
6096 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
6098 int count
= BINDING_STACK_SIZE ();
6099 specbind (Qscalable_fonts_allowed
, Qt
);
6100 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6101 unbind_to (count
, Qnil
);
6108 /* Get a list of matching fonts on frame F.
6110 PATTERN, if a string, specifies a font name pattern to match while
6111 ignoring FAMILY and REGISTRY.
6113 FAMILY, if a list, specifies a list of font families to try.
6115 REGISTRY, if a list, specifies a list of font registries and
6118 Return in *FONTS a pointer to a vector of font_name structures for
6119 the fonts matched. Value is the number of fonts found. */
6122 try_font_list (f
, pattern
, family
, registry
, fonts
)
6124 Lisp_Object pattern
, family
, registry
;
6125 struct font_name
**fonts
;
6129 if (STRINGP (pattern
))
6130 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6136 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6138 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6139 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6141 /* Try font family of the default face or "fixed". */
6142 if (nfonts
== 0 && !NILP (family
))
6144 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6146 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6148 family
= build_string ("fixed");
6149 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6152 /* Try any family with the given registry. */
6153 if (nfonts
== 0 && !NILP (family
))
6154 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6161 /* Return the fontset id of the base fontset name or alias name given
6162 by the fontset attribute of ATTRS. Value is -1 if the fontset
6163 attribute of ATTRS doesn't name a fontset. */
6166 face_fontset (attrs
)
6171 name
= attrs
[LFACE_FONT_INDEX
];
6172 if (!STRINGP (name
))
6174 return fs_query_fontset (name
, 0);
6178 /* Choose a name of font to use on frame F to display characters with
6179 Lisp face attributes specified by ATTRS. The font name is
6180 determined by the font-related attributes in ATTRS and FONT-SPEC
6183 When we are choosing a font for ASCII characters, FONT-SPEC is
6184 always nil. Otherwise FONT-SPEC is a list
6185 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6186 or a string specifying a font name pattern.
6188 Value is the font name which is allocated from the heap and must be
6189 freed by the caller. */
6192 choose_face_font (f
, attrs
, font_spec
)
6195 Lisp_Object font_spec
;
6197 Lisp_Object pattern
, family
, adstyle
, registry
;
6198 char *font_name
= NULL
;
6199 struct font_name
*fonts
;
6202 /* If we are choosing an ASCII font and a font name is explicitly
6203 specified in ATTRS, return it. */
6205 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6206 return xstrdup (XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6209 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6212 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6214 if (VECTORP (font_spec
))
6217 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6218 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6219 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6220 registry
= AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
);
6222 else if (STRINGP (font_spec
))
6224 pattern
= font_spec
;
6233 registry
= build_string ("iso8859-1");
6236 /* Get a list of fonts matching that pattern and choose the
6237 best match for the specified face attributes from it. */
6238 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6239 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
));
6243 #endif /* HAVE_WINDOW_SYSTEM */
6247 /***********************************************************************
6249 ***********************************************************************/
6251 /* Realize basic faces on frame F. Value is zero if frame parameters
6252 of F don't contain enough information needed to realize the default
6256 realize_basic_faces (f
)
6260 int count
= BINDING_STACK_SIZE ();
6262 /* Block input here so that we won't be surprised by an X expose
6263 event, for instance, without having the faces set up. */
6265 specbind (Qscalable_fonts_allowed
, Qt
);
6267 if (realize_default_face (f
))
6269 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6270 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6271 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6272 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6273 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6274 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6275 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6276 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6277 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6278 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6280 /* Reflect changes in the `menu' face in menu bars. */
6281 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6283 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6284 #ifdef USE_X_TOOLKIT
6285 x_update_menu_appearance (f
);
6292 unbind_to (count
, Qnil
);
6298 /* Realize the default face on frame F. If the face is not fully
6299 specified, make it fully-specified. Attributes of the default face
6300 that are not explicitly specified are taken from frame parameters. */
6303 realize_default_face (f
)
6306 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6308 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6309 Lisp_Object frame_font
;
6312 /* If the `default' face is not yet known, create it. */
6313 lface
= lface_from_face_name (f
, Qdefault
, 0);
6317 XSETFRAME (frame
, f
);
6318 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6321 #ifdef HAVE_WINDOW_SYSTEM
6322 if (FRAME_WINDOW_P (f
))
6324 /* Set frame_font to the value of the `font' frame parameter. */
6325 frame_font
= Fassq (Qfont
, f
->param_alist
);
6326 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6327 frame_font
= XCDR (frame_font
);
6328 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6330 #endif /* HAVE_WINDOW_SYSTEM */
6332 if (!FRAME_WINDOW_P (f
))
6334 LFACE_FAMILY (lface
) = build_string ("default");
6335 LFACE_SWIDTH (lface
) = Qnormal
;
6336 LFACE_HEIGHT (lface
) = make_number (1);
6337 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6338 LFACE_WEIGHT (lface
) = Qnormal
;
6339 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6340 LFACE_SLANT (lface
) = Qnormal
;
6341 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6344 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6345 LFACE_UNDERLINE (lface
) = Qnil
;
6347 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6348 LFACE_OVERLINE (lface
) = Qnil
;
6350 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6351 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6353 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6354 LFACE_BOX (lface
) = Qnil
;
6356 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6357 LFACE_INVERSE (lface
) = Qnil
;
6359 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6361 /* This function is called so early that colors are not yet
6362 set in the frame parameter list. */
6363 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6365 if (CONSP (color
) && STRINGP (XCDR (color
)))
6366 LFACE_FOREGROUND (lface
) = XCDR (color
);
6367 else if (FRAME_WINDOW_P (f
))
6369 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6370 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6375 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6377 /* This function is called so early that colors are not yet
6378 set in the frame parameter list. */
6379 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6380 if (CONSP (color
) && STRINGP (XCDR (color
)))
6381 LFACE_BACKGROUND (lface
) = XCDR (color
);
6382 else if (FRAME_WINDOW_P (f
))
6384 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6385 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6390 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6391 LFACE_STIPPLE (lface
) = Qnil
;
6393 /* Realize the face; it must be fully-specified now. */
6394 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6395 check_lface (lface
);
6396 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6397 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6402 /* Realize basic faces other than the default face in face cache C.
6403 SYMBOL is the face name, ID is the face id the realized face must
6404 have. The default face must have been realized already. */
6407 realize_named_face (f
, symbol
, id
)
6412 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6413 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6414 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6415 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6416 struct face
*new_face
;
6418 /* The default face must exist and be fully specified. */
6419 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6420 check_lface_attrs (attrs
);
6421 xassert (lface_fully_specified_p (attrs
));
6423 /* If SYMBOL isn't know as a face, create it. */
6427 XSETFRAME (frame
, f
);
6428 lface
= Finternal_make_lisp_face (symbol
, frame
);
6431 /* Merge SYMBOL's face with the default face. */
6432 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6433 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6435 /* Realize the face. */
6436 new_face
= realize_face (c
, attrs
, id
);
6440 /* Realize the fully-specified face with attributes ATTRS in face
6441 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6442 non-negative, it is an ID of face to remove before caching the new
6443 face. Value is a pointer to the newly created realized face. */
6445 static struct face
*
6446 realize_face (cache
, attrs
, former_face_id
)
6447 struct face_cache
*cache
;
6453 /* LFACE must be fully specified. */
6454 xassert (cache
!= NULL
);
6455 check_lface_attrs (attrs
);
6457 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6459 /* Remove the former face. */
6460 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6461 uncache_face (cache
, former_face
);
6462 free_realized_face (cache
->f
, former_face
);
6465 if (FRAME_WINDOW_P (cache
->f
))
6466 face
= realize_x_face (cache
, attrs
);
6467 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6468 face
= realize_tty_face (cache
, attrs
);
6472 /* Insert the new face. */
6473 cache_face (cache
, face
, lface_hash (attrs
));
6478 /* Realize the fully-specified face that has the same attributes as
6479 BASE_FACE except for the font on frame F. If FONT_ID is not
6480 negative, it is an ID number of an already opened font that should
6481 be used by the face. If FONT_ID is negative, the face has no font,
6482 i.e., characters are displayed by empty boxes. */
6484 static struct face
*
6485 realize_non_ascii_face (f
, font_id
, base_face
)
6488 struct face
*base_face
;
6490 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6492 struct font_info
*font_info
;
6494 face
= (struct face
*) xmalloc (sizeof *face
);
6498 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6499 face
->colors_copied_bitwise_p
= 1;
6501 face
->font_info_id
= font_id
;
6504 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6505 face
->font
= font_info
->font
;
6506 face
->font_name
= font_info
->full_name
;
6511 face
->font_name
= NULL
;
6516 cache_face (cache
, face
, face
->hash
);
6522 /* Realize the fully-specified face with attributes ATTRS in face
6523 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6524 the new face doesn't share font with the default face, a fontname
6525 is allocated from the heap and set in `font_name' of the new face,
6526 but it is not yet loaded here. Value is a pointer to the newly
6527 created realized face. */
6529 static struct face
*
6530 realize_x_face (cache
, attrs
)
6531 struct face_cache
*cache
;
6534 #ifdef HAVE_WINDOW_SYSTEM
6535 struct face
*face
, *default_face
;
6537 Lisp_Object stipple
, overline
, strike_through
, box
;
6539 xassert (FRAME_WINDOW_P (cache
->f
));
6541 /* Allocate a new realized face. */
6542 face
= make_realized_face (attrs
);
6543 face
->ascii_face
= face
;
6547 /* Determine the font to use. Most of the time, the font will be
6548 the same as the font of the default face, so try that first. */
6549 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6551 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6553 face
->font
= default_face
->font
;
6554 face
->font_info_id
= default_face
->font_info_id
;
6555 face
->font_name
= default_face
->font_name
;
6557 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6561 /* If the face attribute ATTRS specifies a fontset, use it as
6562 the base of a new realized fontset. Otherwise, use the same
6563 base fontset as of the default face. The base determines
6564 registry and encoding of a font. It may also determine
6565 foundry and family. The other fields of font name pattern
6566 are constructed from ATTRS. */
6567 int fontset
= face_fontset (attrs
);
6569 /* If we are realizing the default face, ATTRS should specify a
6570 fontset. In other words, if FONTSET is -1, we are not
6571 realizing the default face, thus the default face should have
6572 already been realized. */
6574 fontset
= default_face
->fontset
;
6577 face
->font
= NULL
; /* to force realize_face to load font */
6580 /* Load the font if it is specified in ATTRS. This fixes
6581 changing frame font on the Mac. */
6582 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6584 struct font_info
*font_info
=
6585 FS_LOAD_FONT (f
, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6587 face
->font
= font_info
->font
;
6591 load_face_font (f
, face
);
6592 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6595 /* Load colors, and set remaining attributes. */
6597 load_face_colors (f
, face
, attrs
);
6600 box
= attrs
[LFACE_BOX_INDEX
];
6603 /* A simple box of line width 1 drawn in color given by
6605 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6607 face
->box
= FACE_SIMPLE_BOX
;
6608 face
->box_line_width
= 1;
6610 else if (INTEGERP (box
))
6612 /* Simple box of specified line width in foreground color of the
6614 xassert (XINT (box
) != 0);
6615 face
->box
= FACE_SIMPLE_BOX
;
6616 face
->box_line_width
= XINT (box
);
6617 face
->box_color
= face
->foreground
;
6618 face
->box_color_defaulted_p
= 1;
6620 else if (CONSP (box
))
6622 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6623 being one of `raised' or `sunken'. */
6624 face
->box
= FACE_SIMPLE_BOX
;
6625 face
->box_color
= face
->foreground
;
6626 face
->box_color_defaulted_p
= 1;
6627 face
->box_line_width
= 1;
6631 Lisp_Object keyword
, value
;
6633 keyword
= XCAR (box
);
6641 if (EQ (keyword
, QCline_width
))
6643 if (INTEGERP (value
) && XINT (value
) != 0)
6644 face
->box_line_width
= XINT (value
);
6646 else if (EQ (keyword
, QCcolor
))
6648 if (STRINGP (value
))
6650 face
->box_color
= load_color (f
, face
, value
,
6652 face
->use_box_color_for_shadows_p
= 1;
6655 else if (EQ (keyword
, QCstyle
))
6657 if (EQ (value
, Qreleased_button
))
6658 face
->box
= FACE_RAISED_BOX
;
6659 else if (EQ (value
, Qpressed_button
))
6660 face
->box
= FACE_SUNKEN_BOX
;
6665 /* Text underline, overline, strike-through. */
6667 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6669 /* Use default color (same as foreground color). */
6670 face
->underline_p
= 1;
6671 face
->underline_defaulted_p
= 1;
6672 face
->underline_color
= 0;
6674 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6676 /* Use specified color. */
6677 face
->underline_p
= 1;
6678 face
->underline_defaulted_p
= 0;
6679 face
->underline_color
6680 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6681 LFACE_UNDERLINE_INDEX
);
6683 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6685 face
->underline_p
= 0;
6686 face
->underline_defaulted_p
= 0;
6687 face
->underline_color
= 0;
6690 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6691 if (STRINGP (overline
))
6693 face
->overline_color
6694 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6695 LFACE_OVERLINE_INDEX
);
6696 face
->overline_p
= 1;
6698 else if (EQ (overline
, Qt
))
6700 face
->overline_color
= face
->foreground
;
6701 face
->overline_color_defaulted_p
= 1;
6702 face
->overline_p
= 1;
6705 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6706 if (STRINGP (strike_through
))
6708 face
->strike_through_color
6709 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6710 LFACE_STRIKE_THROUGH_INDEX
);
6711 face
->strike_through_p
= 1;
6713 else if (EQ (strike_through
, Qt
))
6715 face
->strike_through_color
= face
->foreground
;
6716 face
->strike_through_color_defaulted_p
= 1;
6717 face
->strike_through_p
= 1;
6720 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6721 if (!NILP (stipple
))
6722 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6724 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6726 #endif /* HAVE_WINDOW_SYSTEM */
6730 /* Map a specified color of face FACE on frame F to a tty color index.
6731 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6732 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6733 default foreground/background colors. */
6736 map_tty_color (f
, face
, idx
, defaulted
)
6739 enum lface_attribute_index idx
;
6742 Lisp_Object frame
, color
, def
;
6743 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6744 unsigned long default_pixel
, default_other_pixel
, pixel
;
6746 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6750 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6751 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6755 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6756 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6759 XSETFRAME (frame
, f
);
6760 color
= face
->lface
[idx
];
6763 && XSTRING (color
)->size
6764 && CONSP (Vtty_defined_color_alist
)
6765 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6768 /* Associations in tty-defined-color-alist are of the form
6769 (NAME INDEX R G B). We need the INDEX part. */
6770 pixel
= XINT (XCAR (XCDR (def
)));
6773 if (pixel
== default_pixel
&& STRINGP (color
))
6775 pixel
= load_color (f
, face
, color
, idx
);
6777 #if defined (MSDOS) || defined (WINDOWSNT)
6778 /* If the foreground of the default face is the default color,
6779 use the foreground color defined by the frame. */
6781 if (FRAME_MSDOS_P (f
))
6784 if (pixel
== default_pixel
6785 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6788 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6790 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6791 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6794 else if (pixel
== default_other_pixel
)
6797 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6799 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6800 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6806 #endif /* MSDOS or WINDOWSNT */
6810 face
->foreground
= pixel
;
6812 face
->background
= pixel
;
6816 /* Realize the fully-specified face with attributes ATTRS in face
6817 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6818 Value is a pointer to the newly created realized face. */
6820 static struct face
*
6821 realize_tty_face (cache
, attrs
)
6822 struct face_cache
*cache
;
6827 int face_colors_defaulted
= 0;
6828 struct frame
*f
= cache
->f
;
6830 /* Frame must be a termcap frame. */
6831 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6833 /* Allocate a new realized face. */
6834 face
= make_realized_face (attrs
);
6835 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6837 /* Map face attributes to TTY appearances. We map slant to
6838 dimmed text because we want italic text to appear differently
6839 and because dimmed text is probably used infrequently. */
6840 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6841 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6843 if (weight
> XLFD_WEIGHT_MEDIUM
)
6844 face
->tty_bold_p
= 1;
6845 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6846 face
->tty_dim_p
= 1;
6847 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6848 face
->tty_underline_p
= 1;
6849 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6850 face
->tty_reverse_p
= 1;
6852 /* Map color names to color indices. */
6853 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6854 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6856 /* Swap colors if face is inverse-video. If the colors are taken
6857 from the frame colors, they are already inverted, since the
6858 frame-creation function calls x-handle-reverse-video. */
6859 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6861 unsigned long tem
= face
->foreground
;
6862 face
->foreground
= face
->background
;
6863 face
->background
= tem
;
6866 if (tty_suppress_bold_inverse_default_colors_p
6868 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6869 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6870 face
->tty_bold_p
= 0;
6876 DEFUN ("tty-suppress-bold-inverse-default-colors",
6877 Ftty_suppress_bold_inverse_default_colors
,
6878 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6879 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6880 SUPPRESS non-nil means suppress it.
6881 This affects bold faces on TTYs whose foreground is the default background
6882 color of the display and whose background is the default foreground color.
6883 For such faces, the bold face attribute is ignored if this variable
6886 Lisp_Object suppress
;
6888 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6889 ++face_change_count
;
6895 /***********************************************************************
6897 ***********************************************************************/
6899 /* Return the ID of the face to use to display character CH with face
6900 property PROP on frame F in current_buffer. */
6903 compute_char_face (f
, ch
, prop
)
6910 if (NILP (current_buffer
->enable_multibyte_characters
))
6915 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6916 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6920 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6921 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6922 bcopy (face
->lface
, attrs
, sizeof attrs
);
6923 merge_face_vector_with_property (f
, attrs
, prop
);
6924 face_id
= lookup_face (f
, attrs
);
6925 if (! ASCII_CHAR_P (ch
))
6927 face
= FACE_FROM_ID (f
, face_id
);
6928 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6935 /* Return the face ID associated with buffer position POS for
6936 displaying ASCII characters. Return in *ENDPTR the position at
6937 which a different face is needed, as far as text properties and
6938 overlays are concerned. W is a window displaying current_buffer.
6940 REGION_BEG, REGION_END delimit the region, so it can be
6943 LIMIT is a position not to scan beyond. That is to limit the time
6944 this function can take.
6946 If MOUSE is non-zero, use the character's mouse-face, not its face.
6948 The face returned is suitable for displaying ASCII characters. */
6951 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6952 endptr
, limit
, mouse
)
6955 int region_beg
, region_end
;
6960 struct frame
*f
= XFRAME (w
->frame
);
6961 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6962 Lisp_Object prop
, position
;
6964 Lisp_Object
*overlay_vec
;
6967 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6968 Lisp_Object limit1
, end
;
6969 struct face
*default_face
;
6971 /* W must display the current buffer. We could write this function
6972 to use the frame and buffer of W, but right now it doesn't. */
6973 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6975 XSETFRAME (frame
, f
);
6976 XSETFASTINT (position
, pos
);
6979 if (pos
< region_beg
&& region_beg
< endpos
)
6980 endpos
= region_beg
;
6982 /* Get the `face' or `mouse_face' text property at POS, and
6983 determine the next position at which the property changes. */
6984 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6985 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6986 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6988 endpos
= XINT (end
);
6990 /* Look at properties from overlays. */
6995 /* First try with room for 40 overlays. */
6997 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6998 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6999 &next_overlay
, NULL
, 0);
7001 /* If there are more than 40, make enough space for all, and try
7003 if (noverlays
> len
)
7006 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7007 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7008 &next_overlay
, NULL
, 0);
7011 if (next_overlay
< endpos
)
7012 endpos
= next_overlay
;
7017 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7019 /* Optimize common cases where we can use the default face. */
7022 && !(pos
>= region_beg
&& pos
< region_end
))
7023 return DEFAULT_FACE_ID
;
7025 /* Begin with attributes from the default face. */
7026 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7028 /* Merge in attributes specified via text properties. */
7030 merge_face_vector_with_property (f
, attrs
, prop
);
7032 /* Now merge the overlay data. */
7033 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7034 for (i
= 0; i
< noverlays
; i
++)
7039 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7041 merge_face_vector_with_property (f
, attrs
, prop
);
7043 oend
= OVERLAY_END (overlay_vec
[i
]);
7044 oendpos
= OVERLAY_POSITION (oend
);
7045 if (oendpos
< endpos
)
7049 /* If in the region, merge in the region face. */
7050 if (pos
>= region_beg
&& pos
< region_end
)
7052 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7053 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7055 if (region_end
< endpos
)
7056 endpos
= region_end
;
7061 /* Look up a realized face with the given face attributes,
7062 or realize a new one for ASCII characters. */
7063 return lookup_face (f
, attrs
);
7067 /* Compute the face at character position POS in Lisp string STRING on
7068 window W, for ASCII characters.
7070 If STRING is an overlay string, it comes from position BUFPOS in
7071 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7072 not an overlay string. W must display the current buffer.
7073 REGION_BEG and REGION_END give the start and end positions of the
7074 region; both are -1 if no region is visible.
7076 BASE_FACE_ID is the id of a face to merge with. For strings coming
7077 from overlays or the `display' property it is the face at BUFPOS.
7079 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7081 Set *ENDPTR to the next position where to check for faces in
7082 STRING; -1 if the face is constant from POS to the end of the
7085 Value is the id of the face to use. The face returned is suitable
7086 for displaying ASCII characters. */
7089 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7090 region_end
, endptr
, base_face_id
, mouse_p
)
7094 int region_beg
, region_end
;
7096 enum face_id base_face_id
;
7099 Lisp_Object prop
, position
, end
, limit
;
7100 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7101 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7102 struct face
*base_face
;
7103 int multibyte_p
= STRING_MULTIBYTE (string
);
7104 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7106 /* Get the value of the face property at the current position within
7107 STRING. Value is nil if there is no face property. */
7108 XSETFASTINT (position
, pos
);
7109 prop
= Fget_text_property (position
, prop_name
, string
);
7111 /* Get the next position at which to check for faces. Value of end
7112 is nil if face is constant all the way to the end of the string.
7113 Otherwise it is a string position where to check faces next.
7114 Limit is the maximum position up to which to check for property
7115 changes in Fnext_single_property_change. Strings are usually
7116 short, so set the limit to the end of the string. */
7117 XSETFASTINT (limit
, XSTRING (string
)->size
);
7118 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7120 *endptr
= XFASTINT (end
);
7124 base_face
= FACE_FROM_ID (f
, base_face_id
);
7125 xassert (base_face
);
7127 /* Optimize the default case that there is no face property and we
7128 are not in the region. */
7130 && (base_face_id
!= DEFAULT_FACE_ID
7131 /* BUFPOS <= 0 means STRING is not an overlay string, so
7132 that the region doesn't have to be taken into account. */
7134 || bufpos
< region_beg
7135 || bufpos
>= region_end
)
7137 /* We can't realize faces for different charsets differently
7138 if we don't have fonts, so we can stop here if not working
7139 on a window-system frame. */
7140 || !FRAME_WINDOW_P (f
)
7141 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7142 return base_face
->id
;
7144 /* Begin with attributes from the base face. */
7145 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7147 /* Merge in attributes specified via text properties. */
7149 merge_face_vector_with_property (f
, attrs
, prop
);
7151 /* If in the region, merge in the region face. */
7153 && bufpos
>= region_beg
7154 && bufpos
< region_end
)
7156 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7157 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7160 /* Look up a realized face with the given face attributes,
7161 or realize a new one for ASCII characters. */
7162 return lookup_face (f
, attrs
);
7167 /***********************************************************************
7169 ***********************************************************************/
7173 /* Print the contents of the realized face FACE to stderr. */
7176 dump_realized_face (face
)
7179 fprintf (stderr
, "ID: %d\n", face
->id
);
7180 #ifdef HAVE_X_WINDOWS
7181 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7183 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7185 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7186 fprintf (stderr
, "background: 0x%lx (%s)\n",
7188 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7189 fprintf (stderr
, "font_name: %s (%s)\n",
7191 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7192 #ifdef HAVE_X_WINDOWS
7193 fprintf (stderr
, "font = %p\n", face
->font
);
7195 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7196 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7197 fprintf (stderr
, "underline: %d (%s)\n",
7199 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7200 fprintf (stderr
, "hash: %d\n", face
->hash
);
7204 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7212 fprintf (stderr
, "font selection order: ");
7213 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7214 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7215 fprintf (stderr
, "\n");
7217 fprintf (stderr
, "alternative fonts: ");
7218 debug_print (Vface_alternative_font_family_alist
);
7219 fprintf (stderr
, "\n");
7221 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7222 Fdump_face (make_number (i
));
7228 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7230 error ("Not a valid face");
7231 dump_realized_face (face
);
7238 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7239 0, 0, 0, doc
: /* */)
7242 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7243 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7244 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7248 #endif /* GLYPH_DEBUG != 0 */
7252 /***********************************************************************
7254 ***********************************************************************/
7259 Qface
= intern ("face");
7261 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7262 staticpro (&Qbitmap_spec_p
);
7263 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7264 staticpro (&Qframe_update_face_colors
);
7266 /* Lisp face attribute keywords. */
7267 QCfamily
= intern (":family");
7268 staticpro (&QCfamily
);
7269 QCheight
= intern (":height");
7270 staticpro (&QCheight
);
7271 QCweight
= intern (":weight");
7272 staticpro (&QCweight
);
7273 QCslant
= intern (":slant");
7274 staticpro (&QCslant
);
7275 QCunderline
= intern (":underline");
7276 staticpro (&QCunderline
);
7277 QCinverse_video
= intern (":inverse-video");
7278 staticpro (&QCinverse_video
);
7279 QCreverse_video
= intern (":reverse-video");
7280 staticpro (&QCreverse_video
);
7281 QCforeground
= intern (":foreground");
7282 staticpro (&QCforeground
);
7283 QCbackground
= intern (":background");
7284 staticpro (&QCbackground
);
7285 QCstipple
= intern (":stipple");;
7286 staticpro (&QCstipple
);
7287 QCwidth
= intern (":width");
7288 staticpro (&QCwidth
);
7289 QCfont
= intern (":font");
7290 staticpro (&QCfont
);
7291 QCbold
= intern (":bold");
7292 staticpro (&QCbold
);
7293 QCitalic
= intern (":italic");
7294 staticpro (&QCitalic
);
7295 QCoverline
= intern (":overline");
7296 staticpro (&QCoverline
);
7297 QCstrike_through
= intern (":strike-through");
7298 staticpro (&QCstrike_through
);
7299 QCbox
= intern (":box");
7301 QCinherit
= intern (":inherit");
7302 staticpro (&QCinherit
);
7304 /* Symbols used for Lisp face attribute values. */
7305 QCcolor
= intern (":color");
7306 staticpro (&QCcolor
);
7307 QCline_width
= intern (":line-width");
7308 staticpro (&QCline_width
);
7309 QCstyle
= intern (":style");
7310 staticpro (&QCstyle
);
7311 Qreleased_button
= intern ("released-button");
7312 staticpro (&Qreleased_button
);
7313 Qpressed_button
= intern ("pressed-button");
7314 staticpro (&Qpressed_button
);
7315 Qnormal
= intern ("normal");
7316 staticpro (&Qnormal
);
7317 Qultra_light
= intern ("ultra-light");
7318 staticpro (&Qultra_light
);
7319 Qextra_light
= intern ("extra-light");
7320 staticpro (&Qextra_light
);
7321 Qlight
= intern ("light");
7322 staticpro (&Qlight
);
7323 Qsemi_light
= intern ("semi-light");
7324 staticpro (&Qsemi_light
);
7325 Qsemi_bold
= intern ("semi-bold");
7326 staticpro (&Qsemi_bold
);
7327 Qbold
= intern ("bold");
7329 Qextra_bold
= intern ("extra-bold");
7330 staticpro (&Qextra_bold
);
7331 Qultra_bold
= intern ("ultra-bold");
7332 staticpro (&Qultra_bold
);
7333 Qoblique
= intern ("oblique");
7334 staticpro (&Qoblique
);
7335 Qitalic
= intern ("italic");
7336 staticpro (&Qitalic
);
7337 Qreverse_oblique
= intern ("reverse-oblique");
7338 staticpro (&Qreverse_oblique
);
7339 Qreverse_italic
= intern ("reverse-italic");
7340 staticpro (&Qreverse_italic
);
7341 Qultra_condensed
= intern ("ultra-condensed");
7342 staticpro (&Qultra_condensed
);
7343 Qextra_condensed
= intern ("extra-condensed");
7344 staticpro (&Qextra_condensed
);
7345 Qcondensed
= intern ("condensed");
7346 staticpro (&Qcondensed
);
7347 Qsemi_condensed
= intern ("semi-condensed");
7348 staticpro (&Qsemi_condensed
);
7349 Qsemi_expanded
= intern ("semi-expanded");
7350 staticpro (&Qsemi_expanded
);
7351 Qexpanded
= intern ("expanded");
7352 staticpro (&Qexpanded
);
7353 Qextra_expanded
= intern ("extra-expanded");
7354 staticpro (&Qextra_expanded
);
7355 Qultra_expanded
= intern ("ultra-expanded");
7356 staticpro (&Qultra_expanded
);
7357 Qbackground_color
= intern ("background-color");
7358 staticpro (&Qbackground_color
);
7359 Qforeground_color
= intern ("foreground-color");
7360 staticpro (&Qforeground_color
);
7361 Qunspecified
= intern ("unspecified");
7362 staticpro (&Qunspecified
);
7364 Qface_alias
= intern ("face-alias");
7365 staticpro (&Qface_alias
);
7366 Qdefault
= intern ("default");
7367 staticpro (&Qdefault
);
7368 Qtool_bar
= intern ("tool-bar");
7369 staticpro (&Qtool_bar
);
7370 Qregion
= intern ("region");
7371 staticpro (&Qregion
);
7372 Qfringe
= intern ("fringe");
7373 staticpro (&Qfringe
);
7374 Qheader_line
= intern ("header-line");
7375 staticpro (&Qheader_line
);
7376 Qscroll_bar
= intern ("scroll-bar");
7377 staticpro (&Qscroll_bar
);
7378 Qmenu
= intern ("menu");
7380 Qcursor
= intern ("cursor");
7381 staticpro (&Qcursor
);
7382 Qborder
= intern ("border");
7383 staticpro (&Qborder
);
7384 Qmouse
= intern ("mouse");
7385 staticpro (&Qmouse
);
7386 Qmode_line_inactive
= intern ("mode-line-inactive");
7387 staticpro (&Qmode_line_inactive
);
7388 Qtty_color_desc
= intern ("tty-color-desc");
7389 staticpro (&Qtty_color_desc
);
7390 Qtty_color_by_index
= intern ("tty-color-by-index");
7391 staticpro (&Qtty_color_by_index
);
7392 Qtty_color_alist
= intern ("tty-color-alist");
7393 staticpro (&Qtty_color_alist
);
7394 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7395 staticpro (&Qscalable_fonts_allowed
);
7397 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7398 staticpro (&Vparam_value_alist
);
7399 Vface_alternative_font_family_alist
= Qnil
;
7400 staticpro (&Vface_alternative_font_family_alist
);
7401 Vface_alternative_font_registry_alist
= Qnil
;
7402 staticpro (&Vface_alternative_font_registry_alist
);
7404 defsubr (&Sinternal_make_lisp_face
);
7405 defsubr (&Sinternal_lisp_face_p
);
7406 defsubr (&Sinternal_set_lisp_face_attribute
);
7407 #ifdef HAVE_WINDOW_SYSTEM
7408 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7410 defsubr (&Scolor_gray_p
);
7411 defsubr (&Scolor_supported_p
);
7412 defsubr (&Sface_attribute_relative_p
);
7413 defsubr (&Smerge_face_attribute
);
7414 defsubr (&Sinternal_get_lisp_face_attribute
);
7415 defsubr (&Sinternal_lisp_face_attribute_values
);
7416 defsubr (&Sinternal_lisp_face_equal_p
);
7417 defsubr (&Sinternal_lisp_face_empty_p
);
7418 defsubr (&Sinternal_copy_lisp_face
);
7419 defsubr (&Sinternal_merge_in_global_face
);
7420 defsubr (&Sface_font
);
7421 defsubr (&Sframe_face_alist
);
7422 defsubr (&Sinternal_set_font_selection_order
);
7423 defsubr (&Sinternal_set_alternative_font_family_alist
);
7424 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7425 defsubr (&Sface_attributes_as_vector
);
7427 defsubr (&Sdump_face
);
7428 defsubr (&Sshow_face_resources
);
7429 #endif /* GLYPH_DEBUG */
7430 defsubr (&Sclear_face_cache
);
7431 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7433 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7434 defsubr (&Sdump_colors
);
7437 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7438 doc
: /* *Limit for font matching.
7439 If an integer > 0, font matching functions won't load more than
7440 that number of fonts when searching for a matching font. */);
7441 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7443 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7444 doc
: /* List of global face definitions (for internal use only.) */);
7445 Vface_new_frame_defaults
= Qnil
;
7447 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7448 doc
: /* *Default stipple pattern used on monochrome displays.
7449 This stipple pattern is used on monochrome displays
7450 instead of shades of gray for a face background color.
7451 See `set-face-stipple' for possible values for this variable. */);
7452 Vface_default_stipple
= build_string ("gray3");
7454 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7455 doc
: /* An alist of defined terminal colors and their RGB values. */);
7456 Vtty_defined_color_alist
= Qnil
;
7458 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7459 doc
: /* Allowed scalable fonts.
7460 A value of nil means don't allow any scalable fonts.
7461 A value of t means allow any scalable font.
7462 Otherwise, value must be a list of regular expressions. A font may be
7463 scaled if its name matches a regular expression in the list.
7464 Note that if value is nil, a scalable font might still be used, if no
7465 other font of the appropriate family and registry is available. */);
7466 Vscalable_fonts_allowed
= Qnil
;
7468 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7469 doc
: /* List of ignored fonts.
7470 Each element is a regular expression that matches names of fonts to
7472 Vface_ignored_fonts
= Qnil
;
7474 #ifdef HAVE_WINDOW_SYSTEM
7475 defsubr (&Sbitmap_spec_p
);
7476 defsubr (&Sx_list_fonts
);
7477 defsubr (&Sinternal_face_x_get_resource
);
7478 defsubr (&Sx_family_fonts
);
7479 defsubr (&Sx_font_family_list
);
7480 #endif /* HAVE_WINDOW_SYSTEM */