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 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.
77 Faces are frame-local by nature because Emacs allows to define the
78 same named face (face names are symbols) differently for different
79 frames. Each frame has an alist of face definitions for all named
80 faces. The value of a named face in such an alist is a Lisp vector
81 with the symbol `face' in slot 0, and a slot for each of the face
82 attributes mentioned above.
84 There is also a global face alist `Vface_new_frame_defaults'. Face
85 definitions from this list are used to initialize faces of newly
88 A face doesn't have to specify all attributes. Those not specified
89 have a value of `unspecified'. Faces specifying all attributes but
90 the 14th are called `fully-specified'.
95 The display style of a given character in the text is determined by
96 combining several faces. This process is called `face merging'.
97 Any aspect of the display style that isn't specified by overlays or
98 text properties is taken from the `default' face. Since it is made
99 sure that the default face is always fully-specified, face merging
100 always results in a fully-specified face.
105 After all face attributes for a character have been determined by
106 merging faces of that character, that face is `realized'. The
107 realization process maps face attributes to what is physically
108 available on the system where Emacs runs. The result is a
109 `realized face' in form of a struct face which is stored in the
110 face cache of the frame on which it was realized.
112 Face realization is done in the context of the character to display
113 because different fonts may be used for different characters. In
114 other words, for characters that have different font
115 specifications, different realized faces are needed to display
118 Font specification is done by fontsets. See the comment in
119 fontset.c for the details. In the current implementation, all ASCII
120 characters share the same font in a fontset.
122 Faces are at first realized for ASCII characters, and, at that
123 time, assigned a specific realized fontset. Hereafter, we call
124 such a face as `ASCII face'. When a face for a multibyte character
125 is realized, it inherits (thus shares) a fontset of an ASCII face
126 that has the same attributes other than font-related ones.
128 Thus, all realized faces have a realized fontset.
133 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
134 font as ASCII characters. That is because it is expected that
135 unibyte text users specify a font that is suitable both for ASCII
136 and raw 8-bit characters.
141 Font selection tries to find the best available matching font for a
142 given (character, face) combination.
144 If the face specifies a fontset name, that fontset determines a
145 pattern for fonts of the given character. If the face specifies a
146 font name or the other font-related attributes, a fontset is
147 realized from the default fontset. In that case, that
148 specification determines a pattern for ASCII characters and the
149 default fontset determines a pattern for multibyte characters.
151 Available fonts on the system on which Emacs runs are then matched
152 against the font pattern. The result of font selection is the best
153 match for the given face attributes in this font list.
155 Font selection can be influenced by the user.
157 1. The user can specify the relative importance he gives the face
158 attributes width, height, weight, and slant by setting
159 face-font-selection-order (faces.el) to a list of face attribute
160 names. The default is '(:width :height :weight :slant), and means
161 that font selection first tries to find a good match for the font
162 width specified by a face, then---within fonts with that
163 width---tries to find a best match for the specified font height,
166 2. Setting face-font-family-alternatives allows the user to
167 specify alternative font families to try if a family specified by a
170 3. Setting face-font-registry-alternatives allows the user to
171 specify all alternative font registries to try for a face
172 specifying a registry.
174 4. Setting face-ignored-fonts allows the user to ignore specific
178 Character composition.
180 Usually, the realization process is already finished when Emacs
181 actually reflects the desired glyph matrix on the screen. However,
182 on displaying a composition (sequence of characters to be composed
183 on the screen), a suitable font for the components of the
184 composition is selected and realized while drawing them on the
185 screen, i.e. the realization process is delayed but in principle
189 Initialization of basic faces.
191 The faces `default', `modeline' are considered `basic faces'.
192 When redisplay happens the first time for a newly created frame,
193 basic faces are realized for CHARSET_ASCII. Frame parameters are
194 used to fill in unspecified attributes of the default face. */
197 #include <sys/types.h>
198 #include <sys/stat.h>
201 #include "character.h"
203 #include "keyboard.h"
206 #ifdef HAVE_WINDOW_SYSTEM
208 #endif /* HAVE_WINDOW_SYSTEM */
210 #ifdef HAVE_X_WINDOWS
214 #include <Xm/XmStrDefs.h>
215 #endif /* USE_MOTIF */
216 #endif /* HAVE_X_WINDOWS */
225 /* Redefine X specifics to W32 equivalents to avoid cluttering the
226 code with #ifdef blocks. */
227 #undef FRAME_X_DISPLAY_INFO
228 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
229 #define x_display_info w32_display_info
230 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
231 #define check_x check_w32
232 #define x_list_fonts w32_list_fonts
233 #define GCGraphicsExposures 0
234 /* For historic reasons, FONT_WIDTH refers to average width on W32,
235 not maximum as on X. Redefine here. */
237 #define FONT_WIDTH FONT_MAX_WIDTH
238 #endif /* WINDOWSNT */
242 #define x_display_info mac_display_info
243 #define check_x check_mac
245 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
248 x_create_gc (f
, mask
, xgcv
)
254 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
263 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
268 #include "dispextern.h"
269 #include "blockinput.h"
271 #include "intervals.h"
273 #ifdef HAVE_X_WINDOWS
275 /* Compensate for a bug in Xos.h on some systems, on which it requires
276 time.h. On some such systems, Xos.h tries to redefine struct
277 timeval and struct timezone if USG is #defined while it is
280 #ifdef XOS_NEEDS_TIME_H
286 #else /* not XOS_NEEDS_TIME_H */
288 #endif /* not XOS_NEEDS_TIME_H */
290 #endif /* HAVE_X_WINDOWS */
295 #define abs(X) ((X) < 0 ? -(X) : (X))
297 /* Number of pt per inch (from the TeXbook). */
299 #define PT_PER_INCH 72.27
301 /* Non-zero if face attribute ATTR is unspecified. */
303 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
305 /* Value is the number of elements of VECTOR. */
307 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
309 /* Make a copy of string S on the stack using alloca. Value is a pointer
312 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
314 /* Make a copy of the contents of Lisp string S on the stack using
315 alloca. Value is a pointer to the copy. */
317 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
319 /* Size of hash table of realized faces in face caches (should be a
322 #define FACE_CACHE_BUCKETS_SIZE 1001
324 /* A definition of XColor for non-X frames. */
326 #ifndef HAVE_X_WINDOWS
331 unsigned short red
, green
, blue
;
337 #endif /* not HAVE_X_WINDOWS */
339 /* Keyword symbols used for face attribute names. */
341 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
342 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
343 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
344 Lisp_Object QCreverse_video
;
345 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
346 Lisp_Object QCfontset
;
348 /* Symbols used for attribute values. */
350 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
351 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
352 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
353 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
354 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
355 Lisp_Object Qultra_expanded
;
356 Lisp_Object Qreleased_button
, Qpressed_button
;
357 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
358 Lisp_Object Qunspecified
;
360 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
362 /* The name of the function to call when the background of the frame
363 has changed, frame_update_face_colors. */
365 Lisp_Object Qframe_update_face_colors
;
367 /* Names of basic faces. */
369 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
370 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
371 Lisp_Object Qmode_line_inactive
;
372 extern Lisp_Object Qmode_line
;
374 /* The symbol `face-alias'. A symbols having that property is an
375 alias for another face. Value of the property is the name of
378 Lisp_Object Qface_alias
;
380 /* Names of frame parameters related to faces. */
382 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
383 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
385 /* Default stipple pattern used on monochrome displays. This stipple
386 pattern is used on monochrome displays instead of shades of gray
387 for a face background color. See `set-face-stipple' for possible
388 values for this variable. */
390 Lisp_Object Vface_default_stipple
;
392 /* Alist of alternative font families. Each element is of the form
393 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
394 try FAMILY1, then FAMILY2, ... */
396 Lisp_Object Vface_alternative_font_family_alist
;
398 /* Alist of alternative font registries. Each element is of the form
399 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
400 loaded, try REGISTRY1, then REGISTRY2, ... */
402 Lisp_Object Vface_alternative_font_registry_alist
;
404 /* Allowed scalable fonts. A value of nil means don't allow any
405 scalable fonts. A value of t means allow the use of any scalable
406 font. Otherwise, value must be a list of regular expressions. A
407 font may be scaled if its name matches a regular expression in the
410 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
412 /* List of regular expressions that matches names of fonts to ignore. */
414 Lisp_Object Vface_ignored_fonts
;
416 /* Maximum number of fonts to consider in font_list. If not an
417 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
419 Lisp_Object Vfont_list_limit
;
420 #define DEFAULT_FONT_LIST_LIMIT 100
422 /* The symbols `foreground-color' and `background-color' which can be
423 used as part of a `face' property. This is for compatibility with
426 Lisp_Object Qforeground_color
, Qbackground_color
;
428 /* The symbols `face' and `mouse-face' used as text properties. */
431 extern Lisp_Object Qmouse_face
;
433 /* Error symbol for wrong_type_argument in load_pixmap. */
435 Lisp_Object Qbitmap_spec_p
;
437 /* Alist of global face definitions. Each element is of the form
438 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
439 is a Lisp vector of face attributes. These faces are used
440 to initialize faces for new frames. */
442 Lisp_Object Vface_new_frame_defaults
;
444 /* The next ID to assign to Lisp faces. */
446 static int next_lface_id
;
448 /* A vector mapping Lisp face Id's to face names. */
450 static Lisp_Object
*lface_id_to_name
;
451 static int lface_id_to_name_size
;
453 /* TTY color-related functions (defined in tty-colors.el). */
455 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
457 /* The name of the function used to compute colors on TTYs. */
459 Lisp_Object Qtty_color_alist
;
461 /* An alist of defined terminal colors and their RGB values. */
463 Lisp_Object Vtty_defined_color_alist
;
465 /* Counter for calls to clear_face_cache. If this counter reaches
466 CLEAR_FONT_TABLE_COUNT, and a frame has more than
467 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
469 static int clear_font_table_count
;
470 #define CLEAR_FONT_TABLE_COUNT 100
471 #define CLEAR_FONT_TABLE_NFONTS 10
473 /* Non-zero means face attributes have been changed since the last
474 redisplay. Used in redisplay_internal. */
476 int face_change_count
;
478 /* Non-zero means don't display bold text if a face's foreground
479 and background colors are the inverse of the default colors of the
480 display. This is a kluge to suppress `bold black' foreground text
481 which is hard to read on an LCD monitor. */
483 int tty_suppress_bold_inverse_default_colors_p
;
485 /* A list of the form `((x . y))' used to avoid consing in
486 Finternal_set_lisp_face_attribute. */
488 static Lisp_Object Vparam_value_alist
;
490 /* The total number of colors currently allocated. */
493 static int ncolors_allocated
;
494 static int npixmaps_allocated
;
498 /* Non-zero means the definition of the `menu' face for new frames has
501 int menu_face_changed_default
;
504 /* Function prototypes. */
509 static void map_tty_color
P_ ((struct frame
*, struct face
*,
510 enum lface_attribute_index
, int *));
511 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
512 static int may_use_scalable_font_p
P_ ((char *));
513 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
514 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
516 static int x_face_list_fonts
P_ ((struct frame
*, char *,
517 struct font_name
*, int, int));
518 static int font_scalable_p
P_ ((struct font_name
*));
519 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
520 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
521 static unsigned char *xstrlwr
P_ ((unsigned char *));
522 static void signal_error
P_ ((char *, Lisp_Object
));
523 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
524 static void load_face_font
P_ ((struct frame
*, struct face
*));
525 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
526 static void free_face_colors
P_ ((struct frame
*, struct face
*));
527 static int face_color_gray_p
P_ ((struct frame
*, char *));
528 static char *build_font_name
P_ ((struct font_name
*));
529 static void free_font_names
P_ ((struct font_name
*, int));
530 static int sorted_font_list
P_ ((struct frame
*, char *,
531 int (*cmpfn
) P_ ((const void *, const void *)),
532 struct font_name
**));
533 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
534 Lisp_Object
, struct font_name
**));
535 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
536 Lisp_Object
, struct font_name
**));
537 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
538 Lisp_Object
, Lisp_Object
, struct font_name
**));
539 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
540 Lisp_Object
, struct font_name
**));
541 static int cmp_font_names
P_ ((const void *, const void *));
542 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
544 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
547 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
548 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
549 static int realize_basic_faces
P_ ((struct frame
*));
550 static int realize_default_face
P_ ((struct frame
*));
551 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
552 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
553 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
554 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
555 static unsigned lface_hash
P_ ((Lisp_Object
*));
556 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
557 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
558 static void clear_face_gcs
P_ ((struct face_cache
*));
559 static void free_face_cache
P_ ((struct face_cache
*));
560 static int face_numeric_weight
P_ ((Lisp_Object
));
561 static int face_numeric_slant
P_ ((Lisp_Object
));
562 static int face_numeric_swidth
P_ ((Lisp_Object
));
563 static int face_fontset
P_ ((Lisp_Object
*));
564 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
565 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
566 Lisp_Object
*, Lisp_Object
));
567 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
569 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
570 Lisp_Object
, int, int));
571 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
572 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
573 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
574 struct font_name
*, int, int));
575 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
576 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
577 static int xlfd_numeric_slant
P_ ((struct font_name
*));
578 static int xlfd_numeric_weight
P_ ((struct font_name
*));
579 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
580 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
581 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
582 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
583 static int xlfd_fixed_p
P_ ((struct font_name
*));
584 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
586 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
587 struct font_name
*, int,
589 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
590 struct font_name
*, int));
592 #ifdef HAVE_WINDOW_SYSTEM
594 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
595 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
596 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
597 int (*cmpfn
) P_ ((const void *, const void *))));
598 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
599 static void x_free_gc
P_ ((struct frame
*, GC
));
600 static void clear_font_table
P_ ((struct x_display_info
*));
603 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
604 #endif /* WINDOWSNT */
607 static void x_update_menu_appearance
P_ ((struct frame
*));
609 extern void free_frame_menubar
P_ ((struct frame
*));
610 #endif /* USE_X_TOOLKIT */
612 #endif /* HAVE_WINDOW_SYSTEM */
615 /***********************************************************************
617 ***********************************************************************/
619 #ifdef HAVE_X_WINDOWS
621 #ifdef DEBUG_X_COLORS
623 /* The following is a poor mans infrastructure for debugging X color
624 allocation problems on displays with PseudoColor-8. Some X servers
625 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
626 color reference counts completely so that they don't signal an
627 error when a color is freed whose reference count is already 0.
628 Other X servers do. To help me debug this, the following code
629 implements a simple reference counting schema of its own, for a
630 single display/screen. --gerd. */
632 /* Reference counts for pixel colors. */
634 int color_count
[256];
636 /* Register color PIXEL as allocated. */
639 register_color (pixel
)
642 xassert (pixel
< 256);
643 ++color_count
[pixel
];
647 /* Register color PIXEL as deallocated. */
650 unregister_color (pixel
)
653 xassert (pixel
< 256);
654 if (color_count
[pixel
] > 0)
655 --color_count
[pixel
];
661 /* Register N colors from PIXELS as deallocated. */
664 unregister_colors (pixels
, n
)
665 unsigned long *pixels
;
669 for (i
= 0; i
< n
; ++i
)
670 unregister_color (pixels
[i
]);
674 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
675 doc
: /* Dump currently allocated colors to stderr. */)
680 fputc ('\n', stderr
);
682 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
685 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
688 fputc ('\n', stderr
);
690 fputc ('\t', stderr
);
694 fputc ('\n', stderr
);
698 #endif /* DEBUG_X_COLORS */
701 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
702 color values. Interrupt input must be blocked when this function
706 x_free_colors (f
, pixels
, npixels
)
708 unsigned long *pixels
;
711 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
713 /* If display has an immutable color map, freeing colors is not
714 necessary and some servers don't allow it. So don't do it. */
715 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
717 #ifdef DEBUG_X_COLORS
718 unregister_colors (pixels
, npixels
);
720 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
726 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
727 color values. Interrupt input must be blocked when this function
731 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
735 unsigned long *pixels
;
738 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
739 int class = dpyinfo
->visual
->class;
741 /* If display has an immutable color map, freeing colors is not
742 necessary and some servers don't allow it. So don't do it. */
743 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
745 #ifdef DEBUG_X_COLORS
746 unregister_colors (pixels
, npixels
);
748 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
753 /* Create and return a GC for use on frame F. GC values and mask
754 are given by XGCV and MASK. */
757 x_create_gc (f
, mask
, xgcv
)
764 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
771 /* Free GC which was used on frame F. */
779 xassert (--ngcs
>= 0);
780 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
784 #endif /* HAVE_X_WINDOWS */
787 /* W32 emulation of GCs */
790 x_create_gc (f
, mask
, xgcv
)
797 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
804 /* Free GC which was used on frame F. */
812 xassert (--ngcs
>= 0);
817 #endif /* WINDOWSNT */
819 /* Like stricmp. Used to compare parts of font names which are in
824 unsigned char *s1
, *s2
;
828 unsigned char c1
= tolower (*s1
);
829 unsigned char c2
= tolower (*s2
);
831 return c1
< c2
? -1 : 1;
836 return *s2
== 0 ? 0 : -1;
841 /* Like strlwr, which might not always be available. */
843 static unsigned char *
847 unsigned char *p
= s
;
856 /* Signal `error' with message S, and additional argument ARG. */
859 signal_error (s
, arg
)
863 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
867 /* If FRAME is nil, return a pointer to the selected frame.
868 Otherwise, check that FRAME is a live frame, and return a pointer
869 to it. NPARAM is the parameter number of FRAME, for
870 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
871 Lisp function definitions. */
873 static INLINE
struct frame
*
874 frame_or_selected_frame (frame
, nparam
)
879 frame
= selected_frame
;
881 CHECK_LIVE_FRAME (frame
);
882 return XFRAME (frame
);
886 /***********************************************************************
888 ***********************************************************************/
890 /* Initialize face cache and basic faces for frame F. */
896 /* Make a face cache, if F doesn't have one. */
897 if (FRAME_FACE_CACHE (f
) == NULL
)
898 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
900 #ifdef HAVE_WINDOW_SYSTEM
901 /* Make the image cache. */
902 if (FRAME_WINDOW_P (f
))
904 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
905 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
906 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
908 #endif /* HAVE_WINDOW_SYSTEM */
910 /* Realize basic faces. Must have enough information in frame
911 parameters to realize basic faces at this point. */
912 #ifdef HAVE_X_WINDOWS
913 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
916 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
918 if (!realize_basic_faces (f
))
923 /* Free face cache of frame F. Called from Fdelete_frame. */
929 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
933 free_face_cache (face_cache
);
934 FRAME_FACE_CACHE (f
) = NULL
;
937 #ifdef HAVE_WINDOW_SYSTEM
938 if (FRAME_WINDOW_P (f
))
940 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
943 --image_cache
->refcount
;
944 if (image_cache
->refcount
== 0)
945 free_image_cache (f
);
948 #endif /* HAVE_WINDOW_SYSTEM */
952 /* Clear face caches, and recompute basic faces for frame F. Call
953 this after changing frame parameters on which those faces depend,
954 or when realized faces have been freed due to changing attributes
958 recompute_basic_faces (f
)
961 if (FRAME_FACE_CACHE (f
))
963 clear_face_cache (0);
964 if (!realize_basic_faces (f
))
970 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
971 try to free unused fonts, too. */
974 clear_face_cache (clear_fonts_p
)
977 #ifdef HAVE_WINDOW_SYSTEM
978 Lisp_Object tail
, frame
;
982 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
984 struct x_display_info
*dpyinfo
;
986 /* Fonts are common for frames on one display, i.e. on
988 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
989 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
990 clear_font_table (dpyinfo
);
992 /* From time to time see if we can unload some fonts. This also
993 frees all realized faces on all frames. Fonts needed by
994 faces will be loaded again when faces are realized again. */
995 clear_font_table_count
= 0;
997 FOR_EACH_FRAME (tail
, frame
)
999 struct frame
*f
= XFRAME (frame
);
1000 if (FRAME_WINDOW_P (f
)
1001 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1002 free_all_realized_faces (frame
);
1007 /* Clear GCs of realized faces. */
1008 FOR_EACH_FRAME (tail
, frame
)
1011 if (FRAME_WINDOW_P (f
))
1013 clear_face_gcs (FRAME_FACE_CACHE (f
));
1014 clear_image_cache (f
, 0);
1018 #endif /* HAVE_WINDOW_SYSTEM */
1022 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1023 doc
: /* Clear face caches on all frames.
1024 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1026 Lisp_Object thoroughly
;
1028 clear_face_cache (!NILP (thoroughly
));
1029 ++face_change_count
;
1030 ++windows_or_buffers_changed
;
1036 #ifdef HAVE_WINDOW_SYSTEM
1039 /* Remove fonts from the font table of DPYINFO except for the default
1040 ASCII fonts of frames on that display. Called from clear_face_cache
1041 from time to time. */
1044 clear_font_table (dpyinfo
)
1045 struct x_display_info
*dpyinfo
;
1049 /* Free those fonts that are not used by frames on DPYINFO. */
1050 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1052 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1053 Lisp_Object tail
, frame
;
1055 /* Check if slot is already free. */
1056 if (font_info
->name
== NULL
)
1059 /* Don't free a default font of some frame on this display. */
1060 FOR_EACH_FRAME (tail
, frame
)
1062 struct frame
*f
= XFRAME (frame
);
1063 if (FRAME_WINDOW_P (f
)
1064 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1065 && font_info
->font
== FRAME_FONT (f
))
1073 if (font_info
->full_name
!= font_info
->name
)
1074 xfree (font_info
->full_name
);
1075 xfree (font_info
->name
);
1077 /* Free the font. */
1079 #ifdef HAVE_X_WINDOWS
1080 XFreeFont (dpyinfo
->display
, font_info
->font
);
1083 w32_unload_font (dpyinfo
, font_info
->font
);
1087 /* Mark font table slot free. */
1088 font_info
->font
= NULL
;
1089 font_info
->name
= font_info
->full_name
= NULL
;
1093 #endif /* HAVE_WINDOW_SYSTEM */
1097 /***********************************************************************
1099 ***********************************************************************/
1101 #ifdef HAVE_WINDOW_SYSTEM
1103 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1104 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1105 A bitmap specification is either a string, a file name, or a list
1106 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1107 HEIGHT is its height, and DATA is a string containing the bits of
1108 the pixmap. Bits are stored row by row, each row occupies
1109 \(WIDTH + 7)/8 bytes. */)
1115 if (STRINGP (object
))
1116 /* If OBJECT is a string, it's a file name. */
1118 else if (CONSP (object
))
1120 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1121 HEIGHT must be integers > 0, and DATA must be string large
1122 enough to hold a bitmap of the specified size. */
1123 Lisp_Object width
, height
, data
;
1125 height
= width
= data
= Qnil
;
1129 width
= XCAR (object
);
1130 object
= XCDR (object
);
1133 height
= XCAR (object
);
1134 object
= XCDR (object
);
1136 data
= XCAR (object
);
1140 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1142 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1144 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1149 return pixmap_p
? Qt
: Qnil
;
1153 /* Load a bitmap according to NAME (which is either a file name or a
1154 pixmap spec) for use on frame F. Value is the bitmap_id (see
1155 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1156 bitmap cannot be loaded, display a message saying so, and return
1157 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1158 if these pointers are not null. */
1161 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1164 unsigned int *w_ptr
, *h_ptr
;
1172 tem
= Fbitmap_spec_p (name
);
1174 wrong_type_argument (Qbitmap_spec_p
, name
);
1179 /* Decode a bitmap spec into a bitmap. */
1184 w
= XINT (Fcar (name
));
1185 h
= XINT (Fcar (Fcdr (name
)));
1186 bits
= Fcar (Fcdr (Fcdr (name
)));
1188 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1193 /* It must be a string -- a file name. */
1194 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1200 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1211 ++npixmaps_allocated
;
1214 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1217 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1223 #endif /* HAVE_WINDOW_SYSTEM */
1227 /***********************************************************************
1229 ***********************************************************************/
1231 #ifdef HAVE_WINDOW_SYSTEM
1233 /* Update the line_height of frame F. Return non-zero if line height
1237 frame_update_line_height (f
)
1240 int line_height
, changed_p
;
1242 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1243 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1244 FRAME_LINE_HEIGHT (f
) = line_height
;
1248 #endif /* HAVE_WINDOW_SYSTEM */
1251 /***********************************************************************
1253 ***********************************************************************/
1255 #ifdef HAVE_WINDOW_SYSTEM
1257 /* Load font of face FACE which is used on frame F to display ASCII
1258 characters. The name of the font to load is determined by lface. */
1261 load_face_font (f
, face
)
1265 struct font_info
*font_info
= NULL
;
1268 face
->font_info_id
= -1;
1270 face
->font_name
= NULL
;
1272 font_name
= choose_face_font (f
, face
->lface
, Qnil
);
1278 font_info
= FS_LOAD_FONT (f
, font_name
);
1283 face
->font_info_id
= font_info
->font_idx
;
1284 face
->font
= font_info
->font
;
1285 face
->font_name
= font_info
->full_name
;
1288 x_free_gc (f
, face
->gc
);
1293 add_to_log ("Unable to load font %s",
1294 build_string (font_name
), Qnil
);
1298 #endif /* HAVE_WINDOW_SYSTEM */
1302 /***********************************************************************
1304 ***********************************************************************/
1306 /* A version of defined_color for non-X frames. */
1309 tty_defined_color (f
, color_name
, color_def
, alloc
)
1315 Lisp_Object color_desc
;
1316 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1317 unsigned long red
= 0, green
= 0, blue
= 0;
1320 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1324 XSETFRAME (frame
, f
);
1326 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1327 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1329 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1330 if (CONSP (XCDR (XCDR (color_desc
))))
1332 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1333 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1334 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1338 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1339 /* We were called early during startup, and the colors are not
1340 yet set up in tty-defined-color-alist. Don't return a failure
1341 indication, since this produces the annoying "Unable to
1342 load color" messages in the *Messages* buffer. */
1345 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1347 if (strcmp (color_name
, "unspecified-fg") == 0)
1348 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1349 else if (strcmp (color_name
, "unspecified-bg") == 0)
1350 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1353 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1356 color_def
->pixel
= color_idx
;
1357 color_def
->red
= red
;
1358 color_def
->green
= green
;
1359 color_def
->blue
= blue
;
1365 /* Decide if color named COLOR_NAME is valid for the display
1366 associated with the frame F; if so, return the rgb values in
1367 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1369 This does the right thing for any type of frame. */
1372 defined_color (f
, color_name
, color_def
, alloc
)
1378 if (!FRAME_WINDOW_P (f
))
1379 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1380 #ifdef HAVE_X_WINDOWS
1381 else if (FRAME_X_P (f
))
1382 return x_defined_color (f
, color_name
, color_def
, alloc
);
1385 else if (FRAME_W32_P (f
))
1386 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1389 else if (FRAME_MAC_P (f
))
1390 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1397 /* Given the index IDX of a tty color on frame F, return its name, a
1401 tty_color_name (f
, idx
)
1405 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1408 Lisp_Object coldesc
;
1410 XSETFRAME (frame
, f
);
1411 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1413 if (!NILP (coldesc
))
1414 return XCAR (coldesc
);
1417 /* We can have an MSDOG frame under -nw for a short window of
1418 opportunity before internal_terminal_init is called. DTRT. */
1419 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1420 return msdos_stdcolor_name (idx
);
1423 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1424 return build_string (unspecified_fg
);
1425 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1426 return build_string (unspecified_bg
);
1429 return vga_stdcolor_name (idx
);
1432 return Qunspecified
;
1436 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1437 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1440 face_color_gray_p (f
, color_name
)
1447 if (defined_color (f
, color_name
, &color
, 0))
1448 gray_p
= ((abs (color
.red
- color
.green
)
1449 < max (color
.red
, color
.green
) / 20)
1450 && (abs (color
.green
- color
.blue
)
1451 < max (color
.green
, color
.blue
) / 20)
1452 && (abs (color
.blue
- color
.red
)
1453 < max (color
.blue
, color
.red
) / 20));
1461 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1462 BACKGROUND_P non-zero means the color will be used as background
1466 face_color_supported_p (f
, color_name
, background_p
)
1474 XSETFRAME (frame
, f
);
1475 return (FRAME_WINDOW_P (f
)
1476 ? (!NILP (Fxw_display_color_p (frame
))
1477 || xstricmp (color_name
, "black") == 0
1478 || xstricmp (color_name
, "white") == 0
1480 && face_color_gray_p (f
, color_name
))
1481 || (!NILP (Fx_display_grayscale_p (frame
))
1482 && face_color_gray_p (f
, color_name
)))
1483 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1487 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1488 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1489 FRAME specifies the frame and thus the display for interpreting COLOR.
1490 If FRAME is nil or omitted, use the selected frame. */)
1492 Lisp_Object color
, frame
;
1496 CHECK_FRAME (frame
);
1497 CHECK_STRING (color
);
1499 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1503 DEFUN ("color-supported-p", Fcolor_supported_p
,
1504 Scolor_supported_p
, 2, 3, 0,
1505 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1506 BACKGROUND-P non-nil means COLOR is used as a background.
1507 If FRAME is nil or omitted, use the selected frame.
1508 COLOR must be a valid color name. */)
1509 (color
, frame
, background_p
)
1510 Lisp_Object frame
, color
, background_p
;
1514 CHECK_FRAME (frame
);
1515 CHECK_STRING (color
);
1517 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1523 /* Load color with name NAME for use by face FACE on frame F.
1524 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1525 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1526 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1527 pixel color. If color cannot be loaded, display a message, and
1528 return the foreground, background or underline color of F, but
1529 record that fact in flags of the face so that we don't try to free
1533 load_color (f
, face
, name
, target_index
)
1537 enum lface_attribute_index target_index
;
1541 xassert (STRINGP (name
));
1542 xassert (target_index
== LFACE_FOREGROUND_INDEX
1543 || target_index
== LFACE_BACKGROUND_INDEX
1544 || target_index
== LFACE_UNDERLINE_INDEX
1545 || target_index
== LFACE_OVERLINE_INDEX
1546 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1547 || target_index
== LFACE_BOX_INDEX
);
1549 /* if the color map is full, defined_color will return a best match
1550 to the values in an existing cell. */
1551 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1553 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1555 switch (target_index
)
1557 case LFACE_FOREGROUND_INDEX
:
1558 face
->foreground_defaulted_p
= 1;
1559 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1562 case LFACE_BACKGROUND_INDEX
:
1563 face
->background_defaulted_p
= 1;
1564 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1567 case LFACE_UNDERLINE_INDEX
:
1568 face
->underline_defaulted_p
= 1;
1569 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1572 case LFACE_OVERLINE_INDEX
:
1573 face
->overline_color_defaulted_p
= 1;
1574 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1577 case LFACE_STRIKE_THROUGH_INDEX
:
1578 face
->strike_through_color_defaulted_p
= 1;
1579 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1582 case LFACE_BOX_INDEX
:
1583 face
->box_color_defaulted_p
= 1;
1584 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1593 ++ncolors_allocated
;
1600 #ifdef HAVE_WINDOW_SYSTEM
1602 /* Load colors for face FACE which is used on frame F. Colors are
1603 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1604 of ATTRS. If the background color specified is not supported on F,
1605 try to emulate gray colors with a stipple from Vface_default_stipple. */
1608 load_face_colors (f
, face
, attrs
)
1615 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1616 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1618 /* Swap colors if face is inverse-video. */
1619 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1627 /* Check for support for foreground, not for background because
1628 face_color_supported_p is smart enough to know that grays are
1629 "supported" as background because we are supposed to use stipple
1631 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1632 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1634 x_destroy_bitmap (f
, face
->stipple
);
1635 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1636 &face
->pixmap_w
, &face
->pixmap_h
);
1639 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1640 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1644 /* Free color PIXEL on frame F. */
1647 unload_color (f
, pixel
)
1649 unsigned long pixel
;
1651 #ifdef HAVE_X_WINDOWS
1655 x_free_colors (f
, &pixel
, 1);
1662 /* Free colors allocated for FACE. */
1665 free_face_colors (f
, face
)
1669 #ifdef HAVE_X_WINDOWS
1670 if (face
->colors_copied_bitwise_p
)
1675 if (!face
->foreground_defaulted_p
)
1677 x_free_colors (f
, &face
->foreground
, 1);
1678 IF_DEBUG (--ncolors_allocated
);
1681 if (!face
->background_defaulted_p
)
1683 x_free_colors (f
, &face
->background
, 1);
1684 IF_DEBUG (--ncolors_allocated
);
1687 if (face
->underline_p
1688 && !face
->underline_defaulted_p
)
1690 x_free_colors (f
, &face
->underline_color
, 1);
1691 IF_DEBUG (--ncolors_allocated
);
1694 if (face
->overline_p
1695 && !face
->overline_color_defaulted_p
)
1697 x_free_colors (f
, &face
->overline_color
, 1);
1698 IF_DEBUG (--ncolors_allocated
);
1701 if (face
->strike_through_p
1702 && !face
->strike_through_color_defaulted_p
)
1704 x_free_colors (f
, &face
->strike_through_color
, 1);
1705 IF_DEBUG (--ncolors_allocated
);
1708 if (face
->box
!= FACE_NO_BOX
1709 && !face
->box_color_defaulted_p
)
1711 x_free_colors (f
, &face
->box_color
, 1);
1712 IF_DEBUG (--ncolors_allocated
);
1716 #endif /* HAVE_X_WINDOWS */
1719 #endif /* HAVE_WINDOW_SYSTEM */
1723 /***********************************************************************
1725 ***********************************************************************/
1727 /* An enumerator for each field of an XLFD font name. */
1748 /* An enumerator for each possible slant value of a font. Taken from
1749 the XLFD specification. */
1757 XLFD_SLANT_REVERSE_ITALIC
,
1758 XLFD_SLANT_REVERSE_OBLIQUE
,
1762 /* Relative font weight according to XLFD documentation. */
1766 XLFD_WEIGHT_UNKNOWN
,
1767 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1768 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1769 XLFD_WEIGHT_LIGHT
, /* 30 */
1770 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1771 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1772 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1773 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1774 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1775 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1778 /* Relative proportionate width. */
1782 XLFD_SWIDTH_UNKNOWN
,
1783 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1784 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1785 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1786 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1787 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1788 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1789 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1790 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1791 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1794 /* Structure used for tables mapping XLFD weight, slant, and width
1795 names to numeric and symbolic values. */
1801 Lisp_Object
*symbol
;
1804 /* Table of XLFD slant names and their numeric and symbolic
1805 representations. This table must be sorted by slant names in
1808 static struct table_entry slant_table
[] =
1810 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1811 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1812 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1813 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1814 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1815 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1818 /* Table of XLFD weight names. This table must be sorted by weight
1819 names in ascending order. */
1821 static struct table_entry weight_table
[] =
1823 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1824 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1825 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1826 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1827 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1828 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1829 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1830 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1831 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1832 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1833 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1834 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1835 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1836 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1837 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1838 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1841 /* Table of XLFD width names. This table must be sorted by width
1842 names in ascending order. */
1844 static struct table_entry swidth_table
[] =
1846 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1847 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1848 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1849 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1850 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1851 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1852 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1853 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1854 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1855 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1856 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1857 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1858 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1859 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1860 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1863 /* Structure used to hold the result of splitting font names in XLFD
1864 format into their fields. */
1868 /* The original name which is modified destructively by
1869 split_font_name. The pointer is kept here to be able to free it
1870 if it was allocated from the heap. */
1873 /* Font name fields. Each vector element points into `name' above.
1874 Fields are NUL-terminated. */
1875 char *fields
[XLFD_LAST
];
1877 /* Numeric values for those fields that interest us. See
1878 split_font_name for which these are. */
1879 int numeric
[XLFD_LAST
];
1881 /* Lower value mean higher priority. */
1882 int registry_priority
;
1885 /* The frame in effect when sorting font names. Set temporarily in
1886 sort_fonts so that it is available in font comparison functions. */
1888 static struct frame
*font_frame
;
1890 /* Order by which font selection chooses fonts. The default values
1891 mean `first, find a best match for the font width, then for the
1892 font height, then for weight, then for slant.' This variable can be
1893 set via set-face-font-sort-order. */
1896 static int font_sort_order
[4] = {
1897 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1900 static int font_sort_order
[4];
1903 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1904 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1905 is a pointer to the matching table entry or null if no table entry
1908 static struct table_entry
*
1909 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1910 struct table_entry
*table
;
1912 struct font_name
*font
;
1915 /* Function split_font_name converts fields to lower-case, so there
1916 is no need to use xstrlwr or xstricmp here. */
1917 char *s
= font
->fields
[field_index
];
1918 int low
, mid
, high
, cmp
;
1925 mid
= (low
+ high
) / 2;
1926 cmp
= strcmp (table
[mid
].name
, s
);
1940 /* Return a numeric representation for font name field
1941 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1942 has DIM entries. Value is the numeric value found or DFLT if no
1943 table entry matches. This function is used to translate weight,
1944 slant, and swidth names of XLFD font names to numeric values. */
1947 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1948 struct table_entry
*table
;
1950 struct font_name
*font
;
1954 struct table_entry
*p
;
1955 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1956 return p
? p
->numeric
: dflt
;
1960 /* Return a symbolic representation for font name field
1961 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1962 has DIM entries. Value is the symbolic value found or DFLT if no
1963 table entry matches. This function is used to translate weight,
1964 slant, and swidth names of XLFD font names to symbols. */
1966 static INLINE Lisp_Object
1967 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1968 struct table_entry
*table
;
1970 struct font_name
*font
;
1974 struct table_entry
*p
;
1975 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1976 return p
? *p
->symbol
: dflt
;
1980 /* Return a numeric value for the slant of the font given by FONT. */
1983 xlfd_numeric_slant (font
)
1984 struct font_name
*font
;
1986 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1987 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1991 /* Return a symbol representing the weight of the font given by FONT. */
1993 static INLINE Lisp_Object
1994 xlfd_symbolic_slant (font
)
1995 struct font_name
*font
;
1997 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1998 font
, XLFD_SLANT
, Qnormal
);
2002 /* Return a numeric value for the weight of the font given by FONT. */
2005 xlfd_numeric_weight (font
)
2006 struct font_name
*font
;
2008 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2009 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2013 /* Return a symbol representing the slant of the font given by FONT. */
2015 static INLINE Lisp_Object
2016 xlfd_symbolic_weight (font
)
2017 struct font_name
*font
;
2019 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2020 font
, XLFD_WEIGHT
, Qnormal
);
2024 /* Return a numeric value for the swidth of the font whose XLFD font
2025 name fields are found in FONT. */
2028 xlfd_numeric_swidth (font
)
2029 struct font_name
*font
;
2031 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2032 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2036 /* Return a symbolic value for the swidth of FONT. */
2038 static INLINE Lisp_Object
2039 xlfd_symbolic_swidth (font
)
2040 struct font_name
*font
;
2042 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2043 font
, XLFD_SWIDTH
, Qnormal
);
2047 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2048 entries. Value is a pointer to the matching table entry or null if
2049 no element of TABLE contains SYMBOL. */
2051 static struct table_entry
*
2052 face_value (table
, dim
, symbol
)
2053 struct table_entry
*table
;
2059 xassert (SYMBOLP (symbol
));
2061 for (i
= 0; i
< dim
; ++i
)
2062 if (EQ (*table
[i
].symbol
, symbol
))
2065 return i
< dim
? table
+ i
: NULL
;
2069 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2070 entries. Value is -1 if SYMBOL is not found in TABLE. */
2073 face_numeric_value (table
, dim
, symbol
)
2074 struct table_entry
*table
;
2078 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2079 return p
? p
->numeric
: -1;
2083 /* Return a numeric value representing the weight specified by Lisp
2084 symbol WEIGHT. Value is one of the enumerators of enum
2088 face_numeric_weight (weight
)
2091 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2095 /* Return a numeric value representing the slant specified by Lisp
2096 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2099 face_numeric_slant (slant
)
2102 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2106 /* Return a numeric value representing the swidth specified by Lisp
2107 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2110 face_numeric_swidth (width
)
2113 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2117 /* Return an ASCII font name generated from fontset name NAME and
2118 ASCII font specification ASCII_SPEC. NAME is a string conforming
2119 to XLFD. ASCII_SPEC is a vector:
2120 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
2123 generate_ascii_font_name (name
, ascii_spec
)
2124 Lisp_Object name
, ascii_spec
;
2126 struct font_name font
;
2129 font
.name
= LSTRDUPA (name
);
2130 if (! split_font_name (NULL
, &font
, 0))
2133 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
)))
2135 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
));
2136 font
.fields
[XLFD_FOUNDRY
] = p
;
2137 while (*p
!= '-') p
++;
2141 font
.fields
[XLFD_FAMILY
] = p
;
2145 font
.fields
[XLFD_FAMILY
] = font
.fields
[XLFD_FOUNDRY
];
2146 font
.fields
[XLFD_FOUNDRY
] = "*";
2149 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
)))
2150 font
.fields
[XLFD_WEIGHT
]
2151 = XSTRING (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
))->data
;
2152 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
)))
2153 font
.fields
[XLFD_SLANT
]
2154 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
))->data
;
2155 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
)))
2156 font
.fields
[XLFD_SWIDTH
]
2157 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
))->data
;
2158 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
)))
2159 font
.fields
[XLFD_ADSTYLE
]
2160 = XSTRING (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
))->data
;
2161 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
2162 font
.fields
[XLFD_REGISTRY
] = p
;
2163 while (*p
!= '-') p
++;
2168 font
.fields
[XLFD_ENCODING
] = p
;
2170 p
= build_font_name (&font
);
2171 name
= build_string (p
);
2178 font_name_registry (fontname
)
2179 Lisp_Object fontname
;
2181 struct font_name font
;
2183 font
.name
= LSTRDUPA (fontname
);
2184 if (! split_font_name (NULL
, &font
, 0))
2186 font
.fields
[XLFD_ENCODING
][-1] = '-';
2187 return build_string (font
.fields
[XLFD_REGISTRY
]);
2190 #ifdef HAVE_WINDOW_SYSTEM
2192 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2196 struct font_name
*font
;
2198 /* Function split_font_name converts fields to lower-case, so there
2199 is no need to use tolower here. */
2200 return *font
->fields
[XLFD_SPACING
] != 'p';
2204 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2206 The actual height of the font when displayed on F depends on the
2207 resolution of both the font and frame. For example, a 10pt font
2208 designed for a 100dpi display will display larger than 10pt on a
2209 75dpi display. (It's not unusual to use fonts not designed for the
2210 display one is using. For example, some intlfonts are available in
2211 72dpi versions, only.)
2213 Value is the real point size of FONT on frame F, or 0 if it cannot
2217 xlfd_point_size (f
, font
)
2219 struct font_name
*font
;
2221 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2222 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2226 if (*pixel_field
== '[')
2228 /* The pixel size field is `[A B C D]' which specifies
2229 a transformation matrix.
2235 by which all glyphs of the font are transformed. The spec
2236 says that s scalar value N for the pixel size is equivalent
2237 to A = N * resx/resy, B = C = 0, D = N. */
2238 char *start
= pixel_field
+ 1, *end
;
2242 for (i
= 0; i
< 4; ++i
)
2244 matrix
[i
] = strtod (start
, &end
);
2251 pixel
= atoi (pixel_field
);
2256 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2262 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2263 of frame F. This function is used to guess a point size of font
2264 when only the pixel height of the font is available. */
2267 pixel_point_size (f
, pixel
)
2271 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2275 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2276 point size of one dot. */
2277 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2278 int_pt
= real_pt
+ 0.5;
2284 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2285 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2286 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2287 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2288 zero if the font name doesn't have the format we expect. The
2289 expected format is a font name that starts with a `-' and has
2290 XLFD_LAST fields separated by `-'. */
2293 split_font_name (f
, font
, numeric_p
)
2295 struct font_name
*font
;
2301 if (*font
->name
== '-')
2303 char *p
= xstrlwr (font
->name
) + 1;
2305 while (i
< XLFD_LAST
)
2307 font
->fields
[i
] = p
;
2310 /* Pixel and point size may be of the form `[....]'. For
2311 BNF, see XLFD spec, chapter 4. Negative values are
2312 indicated by tilde characters which we replace with
2313 `-' characters, here. */
2315 && (i
- 1 == XLFD_PIXEL_SIZE
2316 || i
- 1 == XLFD_POINT_SIZE
))
2321 for (++p
; *p
&& *p
!= ']'; ++p
)
2325 /* Check that the matrix contains 4 floating point
2327 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2330 if (strtod (start
, &end
) == 0 && start
== end
)
2337 while (*p
&& *p
!= '-')
2347 success_p
= i
== XLFD_LAST
;
2349 /* If requested, and font name was in the expected format,
2350 compute numeric values for some fields. */
2351 if (numeric_p
&& success_p
)
2353 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2354 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2355 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2356 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2357 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2358 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2361 /* Initialize it to zero. It will be overridden by font_list while
2362 trying alternate registries. */
2363 font
->registry_priority
= 0;
2369 /* Build an XLFD font name from font name fields in FONT. Value is a
2370 pointer to the font name, which is allocated via xmalloc. */
2373 build_font_name (font
)
2374 struct font_name
*font
;
2378 char *font_name
= (char *) xmalloc (size
);
2379 int total_length
= 0;
2381 for (i
= 0; i
< XLFD_LAST
; ++i
)
2383 /* Add 1 because of the leading `-'. */
2384 int len
= strlen (font
->fields
[i
]) + 1;
2386 /* Reallocate font_name if necessary. Add 1 for the final
2388 if (total_length
+ len
+ 1 >= size
)
2390 int new_size
= max (2 * size
, size
+ len
+ 1);
2391 int sz
= new_size
* sizeof *font_name
;
2392 font_name
= (char *) xrealloc (font_name
, sz
);
2396 font_name
[total_length
] = '-';
2397 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2398 total_length
+= len
;
2401 font_name
[total_length
] = 0;
2406 /* Free an array FONTS of N font_name structures. This frees FONTS
2407 itself and all `name' fields in its elements. */
2410 free_font_names (fonts
, n
)
2411 struct font_name
*fonts
;
2415 xfree (fonts
[--n
].name
);
2420 /* Sort vector FONTS of font_name structures which contains NFONTS
2421 elements using qsort and comparison function CMPFN. F is the frame
2422 on which the fonts will be used. The global variable font_frame
2423 is temporarily set to F to make it available in CMPFN. */
2426 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2428 struct font_name
*fonts
;
2430 int (*cmpfn
) P_ ((const void *, const void *));
2433 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2438 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2439 display in x_display_list. FONTS is a pointer to a vector of
2440 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2441 alternative patterns from Valternate_fontname_alist if no fonts are
2442 found matching PATTERN.
2444 For all fonts found, set FONTS[i].name to the name of the font,
2445 allocated via xmalloc, and split font names into fields. Ignore
2446 fonts that we can't parse. Value is the number of fonts found. */
2449 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2452 struct font_name
*fonts
;
2453 int nfonts
, try_alternatives_p
;
2457 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2458 better to do it the other way around. */
2460 Lisp_Object lpattern
, tem
;
2462 lpattern
= build_string (pattern
);
2464 /* Get the list of fonts matching PATTERN. */
2467 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2470 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2473 /* Make a copy of the font names we got from X, and
2474 split them into fields. */
2476 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2478 Lisp_Object elt
, tail
;
2479 char *name
= XSTRING (XCAR (tem
))->data
;
2481 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2482 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2486 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2495 /* Make a copy of the font name. */
2496 fonts
[n
].name
= xstrdup (name
);
2498 if (split_font_name (f
, fonts
+ n
, 1))
2500 if (font_scalable_p (fonts
+ n
)
2501 && !may_use_scalable_font_p (name
))
2504 xfree (fonts
[n
].name
);
2510 xfree (fonts
[n
].name
);
2513 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2514 if (n
== 0 && try_alternatives_p
)
2516 Lisp_Object list
= Valternate_fontname_alist
;
2518 while (CONSP (list
))
2520 Lisp_Object entry
= XCAR (list
);
2522 && STRINGP (XCAR (entry
))
2523 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2530 Lisp_Object patterns
= XCAR (list
);
2533 while (CONSP (patterns
)
2534 /* If list is screwed up, give up. */
2535 && (name
= XCAR (patterns
),
2537 /* Ignore patterns equal to PATTERN because we tried that
2538 already with no success. */
2539 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2540 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2543 patterns
= XCDR (patterns
);
2551 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2552 using comparison function CMPFN. Value is the number of fonts
2553 found. If value is non-zero, *FONTS is set to a vector of
2554 font_name structures allocated from the heap containing matching
2555 fonts. Each element of *FONTS contains a name member that is also
2556 allocated from the heap. Font names in these structures are split
2557 into fields. Use free_font_names to free such an array. */
2560 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2563 int (*cmpfn
) P_ ((const void *, const void *));
2564 struct font_name
**fonts
;
2568 /* Get the list of fonts matching pattern. 100 should suffice. */
2569 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2570 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2571 nfonts
= XFASTINT (Vfont_list_limit
);
2573 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2574 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2576 /* Sort the resulting array and return it in *FONTS. If no
2577 fonts were found, make sure to set *FONTS to null. */
2579 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2590 /* Compare two font_name structures *A and *B. Value is analogous to
2591 strcmp. Sort order is given by the global variable
2592 font_sort_order. Font names are sorted so that, everything else
2593 being equal, fonts with a resolution closer to that of the frame on
2594 which they are used are listed first. The global variable
2595 font_frame is the frame on which we operate. */
2598 cmp_font_names (a
, b
)
2601 struct font_name
*x
= (struct font_name
*) a
;
2602 struct font_name
*y
= (struct font_name
*) b
;
2605 /* All strings have been converted to lower-case by split_font_name,
2606 so we can use strcmp here. */
2607 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2612 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2614 int j
= font_sort_order
[i
];
2615 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2620 /* Everything else being equal, we prefer fonts with an
2621 y-resolution closer to that of the frame. */
2622 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2623 int x_resy
= x
->numeric
[XLFD_RESY
];
2624 int y_resy
= y
->numeric
[XLFD_RESY
];
2625 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2633 /* Get a sorted list of fonts matching PATTERN. If PATTERN is nil,
2634 list fonts matching FAMILY and REGISTRY. FAMILY is a family name
2635 string or nil. REGISTRY is a registry name string. Set *FONTS to
2636 a vector of font_name structures allocated from the heap containing
2637 the fonts found. Value is the number of fonts found. */
2640 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2642 Lisp_Object pattern
, family
, registry
;
2643 struct font_name
**fonts
;
2645 char *pattern_str
, *family_str
, *registry_str
;
2649 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2650 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2652 pattern_str
= (char *) alloca (strlen (family_str
)
2653 + strlen (registry_str
)
2655 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2656 strcat (pattern_str
, family_str
);
2657 strcat (pattern_str
, "-*-");
2658 strcat (pattern_str
, registry_str
);
2659 if (!index (registry_str
, '-'))
2661 if (registry_str
[strlen (registry_str
) - 1] == '*')
2662 strcat (pattern_str
, "-*");
2664 strcat (pattern_str
, "*-*");
2668 pattern_str
= (char *) XSTRING (pattern
)->data
;
2670 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2674 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2675 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2676 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2679 static struct font_name
*
2680 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2681 struct font_name
*fonts1
, *fonts2
;
2682 int nfonts1
, nfonts2
;
2684 int new_nfonts
= nfonts1
+ nfonts2
;
2685 struct font_name
*new_fonts
;
2687 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2688 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2689 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2696 /* Get a sorted list of fonts of family FAMILY on frame F.
2698 If PATTERN is non-nil, list fonts matching that pattern.
2700 If REGISTRY is non-nil, return fonts with that registry and the
2701 alternative registries from Vface_alternative_font_registry_alist.
2703 If REGISTRY is nil return fonts of any registry.
2705 Set *FONTS to a vector of font_name structures allocated from the
2706 heap containing the fonts found. Value is the number of fonts
2710 font_list (f
, pattern
, family
, registry
, fonts
)
2712 Lisp_Object pattern
, family
, registry
;
2713 struct font_name
**fonts
;
2715 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2717 if (!NILP (registry
)
2718 && CONSP (Vface_alternative_font_registry_alist
))
2722 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2727 for (alter
= XCDR (alter
), reg_prio
= 1;
2729 alter
= XCDR (alter
), reg_prio
++)
2730 if (STRINGP (XCAR (alter
)))
2733 struct font_name
*fonts2
;
2735 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2737 for (i
= 0; i
< nfonts2
; i
++)
2738 fonts2
[i
].registry_priority
= reg_prio
;
2739 *fonts
= (nfonts
> 0
2740 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2751 /* Remove elements from LIST whose cars are `equal'. Called from
2752 x-family-fonts and x-font-family-list to remove duplicate font
2756 remove_duplicates (list
)
2759 Lisp_Object tail
= list
;
2761 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2763 Lisp_Object next
= XCDR (tail
);
2764 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2765 XSETCDR (tail
, XCDR (next
));
2772 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2773 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2774 If FAMILY is omitted or nil, list all families.
2775 Otherwise, FAMILY must be a string, possibly containing wildcards
2777 If FRAME is omitted or nil, use the selected frame.
2778 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2779 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2780 FAMILY is the font family name. POINT-SIZE is the size of the
2781 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2782 width, weight and slant of the font. These symbols are the same as for
2783 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2784 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2785 giving the registry and encoding of the font.
2786 The result list is sorted according to the current setting of
2787 the face font sort order. */)
2789 Lisp_Object family
, frame
;
2791 struct frame
*f
= check_x_frame (frame
);
2792 struct font_name
*fonts
;
2795 struct gcpro gcpro1
;
2798 CHECK_STRING (family
);
2802 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2803 for (i
= nfonts
- 1; i
>= 0; --i
)
2805 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2808 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2809 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2810 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2811 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2812 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2813 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2814 tem
= build_font_name (fonts
+ i
);
2815 ASET (v
, 6, build_string (tem
));
2816 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2817 fonts
[i
].fields
[XLFD_ENCODING
]);
2818 ASET (v
, 7, build_string (tem
));
2821 result
= Fcons (v
, result
);
2824 remove_duplicates (result
);
2825 free_font_names (fonts
, nfonts
);
2831 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2833 doc
: /* Return a list of available font families on FRAME.
2834 If FRAME is omitted or nil, use the selected frame.
2835 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2836 is a font family, and FIXED-P is non-nil if fonts of that family
2837 are fixed-pitch. */)
2841 struct frame
*f
= check_x_frame (frame
);
2843 struct font_name
*fonts
;
2845 struct gcpro gcpro1
;
2846 int count
= specpdl_ptr
- specpdl
;
2849 /* Let's consider all fonts. Increase the limit for matching
2850 fonts until we have them all. */
2853 specbind (intern ("font-list-limit"), make_number (limit
));
2854 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2856 if (nfonts
== limit
)
2858 free_font_names (fonts
, nfonts
);
2867 for (i
= nfonts
- 1; i
>= 0; --i
)
2868 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2869 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2872 remove_duplicates (result
);
2873 free_font_names (fonts
, nfonts
);
2875 return unbind_to (count
, result
);
2879 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2880 doc
: /* Return a list of the names of available fonts matching PATTERN.
2881 If optional arguments FACE and FRAME are specified, return only fonts
2882 the same size as FACE on FRAME.
2883 PATTERN is a string, perhaps with wildcard characters;
2884 the * character matches any substring, and
2885 the ? character matches any single character.
2886 PATTERN is case-insensitive.
2887 FACE is a face name--a symbol.
2889 The return value is a list of strings, suitable as arguments to
2892 Fonts Emacs can't use may or may not be excluded
2893 even if they match PATTERN and FACE.
2894 The optional fourth argument MAXIMUM sets a limit on how many
2895 fonts to match. The first MAXIMUM fonts are reported.
2896 The optional fifth argument WIDTH, if specified, is a number of columns
2897 occupied by a character of a font. In that case, return only fonts
2898 the WIDTH times as wide as FACE on FRAME. */)
2899 (pattern
, face
, frame
, maximum
, width
)
2900 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2907 CHECK_STRING (pattern
);
2913 CHECK_NATNUM (maximum
);
2914 maxnames
= XINT (maximum
);
2918 CHECK_NUMBER (width
);
2920 /* We can't simply call check_x_frame because this function may be
2921 called before any frame is created. */
2922 f
= frame_or_selected_frame (frame
, 2);
2923 if (!FRAME_WINDOW_P (f
))
2925 /* Perhaps we have not yet created any frame. */
2930 /* Determine the width standard for comparison with the fonts we find. */
2936 /* This is of limited utility since it works with character
2937 widths. Keep it for compatibility. --gerd. */
2938 int face_id
= lookup_named_face (f
, face
);
2939 struct face
*face
= (face_id
< 0
2941 : FACE_FROM_ID (f
, face_id
));
2943 if (face
&& face
->font
)
2944 size
= FONT_WIDTH (face
->font
);
2946 size
= FONT_WIDTH (FRAME_FONT (f
));
2949 size
*= XINT (width
);
2953 Lisp_Object args
[2];
2955 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2957 /* We don't have to check fontsets. */
2959 args
[1] = list_fontsets (f
, pattern
, size
);
2960 return Fnconc (2, args
);
2964 #endif /* HAVE_WINDOW_SYSTEM */
2968 /***********************************************************************
2970 ***********************************************************************/
2972 /* Access face attributes of face LFACE, a Lisp vector. */
2974 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2975 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2976 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2977 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2978 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2979 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2980 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2981 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2982 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2983 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2984 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2985 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2986 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2987 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2988 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2989 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2990 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
2992 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2993 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2995 #define LFACEP(LFACE) \
2997 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2998 && EQ (AREF (LFACE, 0), Qface))
3003 /* Check consistency of Lisp face attribute vector ATTRS. */
3006 check_lface_attrs (attrs
)
3009 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3010 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3011 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3012 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3013 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3014 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3015 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3016 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3017 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3018 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3019 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3020 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3021 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3022 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3023 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3024 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3025 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3026 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3027 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3028 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3029 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3030 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3031 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3032 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3033 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3034 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3035 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3036 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3037 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3038 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3039 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3040 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3041 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3042 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3043 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3044 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3045 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3046 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3047 #ifdef HAVE_WINDOW_SYSTEM
3048 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3049 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3050 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3051 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3052 || NILP (attrs
[LFACE_FONT_INDEX
])
3053 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3054 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3055 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3060 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3068 xassert (LFACEP (lface
));
3069 check_lface_attrs (XVECTOR (lface
)->contents
);
3073 #else /* GLYPH_DEBUG == 0 */
3075 #define check_lface_attrs(attrs) (void) 0
3076 #define check_lface(lface) (void) 0
3078 #endif /* GLYPH_DEBUG == 0 */
3081 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3082 to make it a symvol. If FACE_NAME is an alias for another face,
3083 return that face's name. */
3086 resolve_face_name (face_name
)
3087 Lisp_Object face_name
;
3089 Lisp_Object aliased
;
3091 if (STRINGP (face_name
))
3092 face_name
= intern (XSTRING (face_name
)->data
);
3094 while (SYMBOLP (face_name
))
3096 aliased
= Fget (face_name
, Qface_alias
);
3100 face_name
= aliased
;
3107 /* Return the face definition of FACE_NAME on frame F. F null means
3108 return the definition for new frames. FACE_NAME may be a string or
3109 a symbol (apparently Emacs 20.2 allowed strings as face names in
3110 face text properties; Ediff uses that). If FACE_NAME is an alias
3111 for another face, return that face's definition. If SIGNAL_P is
3112 non-zero, signal an error if FACE_NAME is not a valid face name.
3113 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3116 static INLINE Lisp_Object
3117 lface_from_face_name (f
, face_name
, signal_p
)
3119 Lisp_Object face_name
;
3124 face_name
= resolve_face_name (face_name
);
3127 lface
= assq_no_quit (face_name
, f
->face_alist
);
3129 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3132 lface
= XCDR (lface
);
3134 signal_error ("Invalid face", face_name
);
3136 check_lface (lface
);
3141 /* Get face attributes of face FACE_NAME from frame-local faces on
3142 frame F. Store the resulting attributes in ATTRS which must point
3143 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3144 is non-zero, signal an error if FACE_NAME does not name a face.
3145 Otherwise, value is zero if FACE_NAME is not a face. */
3148 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3150 Lisp_Object face_name
;
3157 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3160 bcopy (XVECTOR (lface
)->contents
, attrs
,
3161 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3171 /* Non-zero if all attributes in face attribute vector ATTRS are
3172 specified, i.e. are non-nil. */
3175 lface_fully_specified_p (attrs
)
3180 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3181 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3182 && i
!= LFACE_AVGWIDTH_INDEX
)
3183 if (UNSPECIFIEDP (attrs
[i
]))
3186 return i
== LFACE_VECTOR_SIZE
;
3189 #ifdef HAVE_WINDOW_SYSTEM
3191 /* Set font-related attributes of Lisp face LFACE from the fullname of
3192 the font opened by FONTNAME. If FORCE_P is zero, set only
3193 unspecified attributes of LFACE. The exception is `font'
3194 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3196 If FONTNAME is not available on frame F,
3197 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3198 If the fullname is not in a valid XLFD format,
3199 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3200 in LFACE and return 1.
3201 Otherwise, return 1.
3203 Currently this function is always called with both FORCE_P and
3204 MAIL_FAIL_P non-zero. */
3207 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3210 Lisp_Object fontname
;
3211 int force_p
, may_fail_p
;
3213 struct font_name font
;
3218 char *font_name
= XSTRING (fontname
)->data
;
3219 struct font_info
*font_info
;
3221 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3222 fontset
= fs_query_fontset (fontname
, 0);
3224 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3225 else if (fontset
== 0)
3232 /* Check if FONT_NAME is surely available on the system. Usually
3233 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3234 returns quickly. But, even if FONT_NAME is not yet cached,
3235 caching it now is not futail because we anyway load the font
3238 font_info
= FS_LOAD_FONT (f
, font_name
);
3248 font
.name
= STRDUPA (font_info
->full_name
);
3249 have_xlfd_p
= split_font_name (f
, &font
, 1);
3251 /* Set attributes only if unspecified, otherwise face defaults for
3252 new frames would never take effect. If we couldn't get a font
3253 name conforming to XLFD, set normal values. */
3255 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3260 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3261 + strlen (font
.fields
[XLFD_FOUNDRY
])
3263 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3264 font
.fields
[XLFD_FAMILY
]);
3265 val
= build_string (buffer
);
3268 val
= build_string ("*");
3269 LFACE_FAMILY (lface
) = val
;
3272 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3275 pt
= xlfd_point_size (f
, &font
);
3277 pt
= pixel_point_size (f
, font_info
->height
* 10);
3279 LFACE_HEIGHT (lface
) = make_number (pt
);
3282 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3283 LFACE_SWIDTH (lface
)
3284 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3286 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3287 LFACE_AVGWIDTH (lface
)
3289 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3292 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3293 LFACE_WEIGHT (lface
)
3294 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3296 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3298 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3302 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3303 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3306 LFACE_FONT (lface
) = fontname
;
3310 #endif /* HAVE_WINDOW_SYSTEM */
3313 /* Merges the face height FROM with the face height TO, and returns the
3314 merged height. If FROM is an invalid height, then INVALID is
3315 returned instead. FROM and TO may be either absolute face heights or
3316 `relative' heights; the returned value is always an absolute height
3317 unless both FROM and TO are relative. GCPRO is a lisp value that
3318 will be protected from garbage-collection if this function makes a
3322 merge_face_heights (from
, to
, invalid
, gcpro
)
3323 Lisp_Object from
, to
, invalid
, gcpro
;
3325 Lisp_Object result
= invalid
;
3327 if (INTEGERP (from
))
3328 /* FROM is absolute, just use it as is. */
3330 else if (FLOATP (from
))
3331 /* FROM is a scale, use it to adjust TO. */
3334 /* relative X absolute => absolute */
3335 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3336 else if (FLOATP (to
))
3337 /* relative X relative => relative */
3338 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3340 else if (FUNCTIONP (from
))
3341 /* FROM is a function, which use to adjust TO. */
3343 /* Call function with current height as argument.
3344 From is the new height. */
3345 Lisp_Object args
[2];
3346 struct gcpro gcpro1
;
3352 result
= safe_call (2, args
);
3356 /* Ensure that if TO was absolute, so is the result. */
3357 if (INTEGERP (to
) && !INTEGERP (result
))
3365 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3366 store the resulting attributes in TO, which must be already be
3367 completely specified and contain only absolute attributes. Every
3368 specified attribute of FROM overrides the corresponding attribute of
3369 TO; relative attributes in FROM are merged with the absolute value in
3370 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3371 face inheritance; it should be Qnil when called from other places. */
3374 merge_face_vectors (f
, from
, to
, cycle_check
)
3376 Lisp_Object
*from
, *to
;
3377 Lisp_Object cycle_check
;
3381 /* If FROM inherits from some other faces, merge their attributes into
3382 TO before merging FROM's direct attributes. Note that an :inherit
3383 attribute of `unspecified' is the same as one of nil; we never
3384 merge :inherit attributes, so nil is more correct, but lots of
3385 other code uses `unspecified' as a generic value for face attributes. */
3386 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3387 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3388 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3390 /* If TO specifies a :font attribute, and FROM specifies some
3391 font-related attribute, we need to clear TO's :font attribute
3392 (because it will be inconsistent with whatever FROM specifies, and
3393 FROM takes precedence). */
3394 if (!NILP (to
[LFACE_FONT_INDEX
])
3395 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3396 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3397 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3398 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3399 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3400 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3401 to
[LFACE_FONT_INDEX
] = Qnil
;
3403 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3404 if (!UNSPECIFIEDP (from
[i
]))
3406 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3407 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3412 /* TO is always an absolute face, which should inherit from nothing.
3413 We blindly copy the :inherit attribute above and fix it up here. */
3414 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3418 /* Checks the `cycle check' variable CHECK to see if it indicates that
3419 EL is part of a cycle; CHECK must be either Qnil or a value returned
3420 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3421 elements after which a cycle might be suspected; after that many
3422 elements, this macro begins consing in order to keep more precise
3425 Returns nil if a cycle was detected, otherwise a new value for CHECK
3428 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3429 the caller should make sure that's ok. */
3431 #define CYCLE_CHECK(check, el, suspicious) \
3434 : (INTEGERP (check) \
3435 ? (XFASTINT (check) < (suspicious) \
3436 ? make_number (XFASTINT (check) + 1) \
3437 : Fcons (el, Qnil)) \
3438 : (!NILP (Fmemq ((el), (check))) \
3440 : Fcons ((el), (check)))))
3443 /* Merge face attributes from the face on frame F whose name is
3444 INHERITS, into the vector of face attributes TO; INHERITS may also be
3445 a list of face names, in which case they are applied in order.
3446 CYCLE_CHECK is used to detect loops in face inheritance.
3447 Returns true if any of the inherited attributes are `font-related'. */
3450 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3452 Lisp_Object inherit
;
3454 Lisp_Object cycle_check
;
3456 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3457 /* Inherit from the named face INHERIT. */
3461 /* Make sure we're not in an inheritance loop. */
3462 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3463 if (NILP (cycle_check
))
3464 /* Cycle detected, ignore any further inheritance. */
3467 lface
= lface_from_face_name (f
, inherit
, 0);
3469 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3471 else if (CONSP (inherit
))
3472 /* Handle a list of inherited faces by calling ourselves recursively
3473 on each element. Note that we only do so for symbol elements, so
3474 it's not possible to infinitely recurse. */
3476 while (CONSP (inherit
))
3478 if (SYMBOLP (XCAR (inherit
)))
3479 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3481 /* Check for a circular inheritance list. */
3482 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3483 if (NILP (cycle_check
))
3484 /* Cycle detected. */
3487 inherit
= XCDR (inherit
);
3493 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3494 is a face property, determine the resulting face attributes on
3495 frame F, and store them in TO. PROP may be a single face
3496 specification or a list of such specifications. Each face
3497 specification can be
3499 1. A symbol or string naming a Lisp face.
3501 2. A property list of the form (KEYWORD VALUE ...) where each
3502 KEYWORD is a face attribute name, and value is an appropriate value
3505 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3506 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3507 for compatibility with 20.2.
3509 Face specifications earlier in lists take precedence over later
3513 merge_face_vector_with_property (f
, to
, prop
)
3520 Lisp_Object first
= XCAR (prop
);
3522 if (EQ (first
, Qforeground_color
)
3523 || EQ (first
, Qbackground_color
))
3525 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3526 . COLOR). COLOR must be a string. */
3527 Lisp_Object color_name
= XCDR (prop
);
3528 Lisp_Object color
= first
;
3530 if (STRINGP (color_name
))
3532 if (EQ (color
, Qforeground_color
))
3533 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3535 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3538 add_to_log ("Invalid face color", color_name
, Qnil
);
3540 else if (SYMBOLP (first
)
3541 && *XSYMBOL (first
)->name
->data
== ':')
3543 /* Assume this is the property list form. */
3544 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3546 Lisp_Object keyword
= XCAR (prop
);
3547 Lisp_Object value
= XCAR (XCDR (prop
));
3549 if (EQ (keyword
, QCfamily
))
3551 if (STRINGP (value
))
3552 to
[LFACE_FAMILY_INDEX
] = value
;
3554 add_to_log ("Invalid face font family", value
, Qnil
);
3556 else if (EQ (keyword
, QCheight
))
3558 Lisp_Object new_height
=
3559 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3562 if (NILP (new_height
))
3563 add_to_log ("Invalid face font height", value
, Qnil
);
3565 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3567 else if (EQ (keyword
, QCweight
))
3570 && face_numeric_weight (value
) >= 0)
3571 to
[LFACE_WEIGHT_INDEX
] = value
;
3573 add_to_log ("Invalid face weight", value
, Qnil
);
3575 else if (EQ (keyword
, QCslant
))
3578 && face_numeric_slant (value
) >= 0)
3579 to
[LFACE_SLANT_INDEX
] = value
;
3581 add_to_log ("Invalid face slant", value
, Qnil
);
3583 else if (EQ (keyword
, QCunderline
))
3588 to
[LFACE_UNDERLINE_INDEX
] = value
;
3590 add_to_log ("Invalid face underline", value
, Qnil
);
3592 else if (EQ (keyword
, QCoverline
))
3597 to
[LFACE_OVERLINE_INDEX
] = value
;
3599 add_to_log ("Invalid face overline", value
, Qnil
);
3601 else if (EQ (keyword
, QCstrike_through
))
3606 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3608 add_to_log ("Invalid face strike-through", value
, Qnil
);
3610 else if (EQ (keyword
, QCbox
))
3613 value
= make_number (1);
3614 if (INTEGERP (value
)
3618 to
[LFACE_BOX_INDEX
] = value
;
3620 add_to_log ("Invalid face box", value
, Qnil
);
3622 else if (EQ (keyword
, QCinverse_video
)
3623 || EQ (keyword
, QCreverse_video
))
3625 if (EQ (value
, Qt
) || NILP (value
))
3626 to
[LFACE_INVERSE_INDEX
] = value
;
3628 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3630 else if (EQ (keyword
, QCforeground
))
3632 if (STRINGP (value
))
3633 to
[LFACE_FOREGROUND_INDEX
] = value
;
3635 add_to_log ("Invalid face foreground", value
, Qnil
);
3637 else if (EQ (keyword
, QCbackground
))
3639 if (STRINGP (value
))
3640 to
[LFACE_BACKGROUND_INDEX
] = value
;
3642 add_to_log ("Invalid face background", value
, Qnil
);
3644 else if (EQ (keyword
, QCstipple
))
3646 #ifdef HAVE_X_WINDOWS
3647 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3648 if (!NILP (pixmap_p
))
3649 to
[LFACE_STIPPLE_INDEX
] = value
;
3651 add_to_log ("Invalid face stipple", value
, Qnil
);
3654 else if (EQ (keyword
, QCwidth
))
3657 && face_numeric_swidth (value
) >= 0)
3658 to
[LFACE_SWIDTH_INDEX
] = value
;
3660 add_to_log ("Invalid face width", value
, Qnil
);
3662 else if (EQ (keyword
, QCinherit
))
3664 if (SYMBOLP (value
))
3665 to
[LFACE_INHERIT_INDEX
] = value
;
3669 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3670 if (!SYMBOLP (XCAR (tail
)))
3673 to
[LFACE_INHERIT_INDEX
] = value
;
3675 add_to_log ("Invalid face inherit", value
, Qnil
);
3679 add_to_log ("Invalid attribute %s in face property",
3682 prop
= XCDR (XCDR (prop
));
3687 /* This is a list of face specs. Specifications at the
3688 beginning of the list take precedence over later
3689 specifications, so we have to merge starting with the
3690 last specification. */
3691 Lisp_Object next
= XCDR (prop
);
3693 merge_face_vector_with_property (f
, to
, next
);
3694 merge_face_vector_with_property (f
, to
, first
);
3699 /* PROP ought to be a face name. */
3700 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3702 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3704 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3709 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3710 Sinternal_make_lisp_face
, 1, 2, 0,
3711 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3712 If FACE was not known as a face before, create a new one.
3713 If optional argument FRAME is specified, make a frame-local face
3714 for that frame. Otherwise operate on the global face definition.
3715 Value is a vector of face attributes. */)
3717 Lisp_Object face
, frame
;
3719 Lisp_Object global_lface
, lface
;
3723 CHECK_SYMBOL (face
);
3724 global_lface
= lface_from_face_name (NULL
, face
, 0);
3728 CHECK_LIVE_FRAME (frame
);
3730 lface
= lface_from_face_name (f
, face
, 0);
3733 f
= NULL
, lface
= Qnil
;
3735 /* Add a global definition if there is none. */
3736 if (NILP (global_lface
))
3738 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3740 AREF (global_lface
, 0) = Qface
;
3741 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3742 Vface_new_frame_defaults
);
3744 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3745 face id to Lisp face is given by the vector lface_id_to_name.
3746 The mapping from Lisp face to Lisp face id is given by the
3747 property `face' of the Lisp face name. */
3748 if (next_lface_id
== lface_id_to_name_size
)
3750 int new_size
= max (50, 2 * lface_id_to_name_size
);
3751 int sz
= new_size
* sizeof *lface_id_to_name
;
3752 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3753 lface_id_to_name_size
= new_size
;
3756 lface_id_to_name
[next_lface_id
] = face
;
3757 Fput (face
, Qface
, make_number (next_lface_id
));
3761 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3762 AREF (global_lface
, i
) = Qunspecified
;
3764 /* Add a frame-local definition. */
3769 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3771 AREF (lface
, 0) = Qface
;
3772 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3775 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3776 AREF (lface
, i
) = Qunspecified
;
3779 lface
= global_lface
;
3781 /* Changing a named face means that all realized faces depending on
3782 that face are invalid. Since we cannot tell which realized faces
3783 depend on the face, make sure they are all removed. This is done
3784 by incrementing face_change_count. The next call to
3785 init_iterator will then free realized faces. */
3786 ++face_change_count
;
3787 ++windows_or_buffers_changed
;
3789 xassert (LFACEP (lface
));
3790 check_lface (lface
);
3795 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3796 Sinternal_lisp_face_p
, 1, 2, 0,
3797 doc
: /* Return non-nil if FACE names a face.
3798 If optional second parameter FRAME is non-nil, check for the
3799 existence of a frame-local face with name FACE on that frame.
3800 Otherwise check for the existence of a global face. */)
3802 Lisp_Object face
, frame
;
3808 CHECK_LIVE_FRAME (frame
);
3809 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3812 lface
= lface_from_face_name (NULL
, face
, 0);
3818 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3819 Sinternal_copy_lisp_face
, 4, 4, 0,
3820 doc
: /* Copy face FROM to TO.
3821 If FRAME it t, copy the global face definition of FROM to the
3822 global face definition of TO. Otherwise, copy the frame-local
3823 definition of FROM on FRAME to the frame-local definition of TO
3824 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3827 (from
, to
, frame
, new_frame
)
3828 Lisp_Object from
, to
, frame
, new_frame
;
3830 Lisp_Object lface
, copy
;
3832 CHECK_SYMBOL (from
);
3834 if (NILP (new_frame
))
3839 /* Copy global definition of FROM. We don't make copies of
3840 strings etc. because 20.2 didn't do it either. */
3841 lface
= lface_from_face_name (NULL
, from
, 1);
3842 copy
= Finternal_make_lisp_face (to
, Qnil
);
3846 /* Copy frame-local definition of FROM. */
3847 CHECK_LIVE_FRAME (frame
);
3848 CHECK_LIVE_FRAME (new_frame
);
3849 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3850 copy
= Finternal_make_lisp_face (to
, new_frame
);
3853 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3854 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3856 /* Changing a named face means that all realized faces depending on
3857 that face are invalid. Since we cannot tell which realized faces
3858 depend on the face, make sure they are all removed. This is done
3859 by incrementing face_change_count. The next call to
3860 init_iterator will then free realized faces. */
3861 ++face_change_count
;
3862 ++windows_or_buffers_changed
;
3868 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3869 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3870 doc
: /* Set attribute ATTR of FACE to VALUE.
3871 FRAME being a frame means change the face on that frame.
3872 FRAME nil means change the face of the selected frame.
3873 FRAME t means change the default for new frames.
3874 FRAME 0 means change the face on all frames, and change the default
3876 (face
, attr
, value
, frame
)
3877 Lisp_Object face
, attr
, value
, frame
;
3880 Lisp_Object old_value
= Qnil
;
3881 /* Set 1 if ATTR is QCfont. */
3882 int font_attr_p
= 0;
3883 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3884 int font_related_attr_p
= 0;
3886 CHECK_SYMBOL (face
);
3887 CHECK_SYMBOL (attr
);
3889 face
= resolve_face_name (face
);
3891 /* If FRAME is 0, change face on all frames, and change the
3892 default for new frames. */
3893 if (INTEGERP (frame
) && XINT (frame
) == 0)
3896 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3897 FOR_EACH_FRAME (tail
, frame
)
3898 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3902 /* Set lface to the Lisp attribute vector of FACE. */
3904 lface
= lface_from_face_name (NULL
, face
, 1);
3908 frame
= selected_frame
;
3910 CHECK_LIVE_FRAME (frame
);
3911 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3913 /* If a frame-local face doesn't exist yet, create one. */
3915 lface
= Finternal_make_lisp_face (face
, frame
);
3918 if (EQ (attr
, QCfamily
))
3920 if (!UNSPECIFIEDP (value
))
3922 CHECK_STRING (value
);
3923 if (XSTRING (value
)->size
== 0)
3924 signal_error ("Invalid face family", value
);
3926 old_value
= LFACE_FAMILY (lface
);
3927 LFACE_FAMILY (lface
) = value
;
3928 font_related_attr_p
= 1;
3930 else if (EQ (attr
, QCheight
))
3932 if (!UNSPECIFIEDP (value
))
3936 test
= (EQ (face
, Qdefault
)
3938 /* The default face must have an absolute size,
3939 otherwise, we do a test merge with a random
3940 height to see if VALUE's ok. */
3941 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3943 if (!INTEGERP (test
) || XINT (test
) <= 0)
3944 signal_error ("Invalid face height", value
);
3947 old_value
= LFACE_HEIGHT (lface
);
3948 LFACE_HEIGHT (lface
) = value
;
3949 font_related_attr_p
= 1;
3951 else if (EQ (attr
, QCweight
))
3953 if (!UNSPECIFIEDP (value
))
3955 CHECK_SYMBOL (value
);
3956 if (face_numeric_weight (value
) < 0)
3957 signal_error ("Invalid face weight", value
);
3959 old_value
= LFACE_WEIGHT (lface
);
3960 LFACE_WEIGHT (lface
) = value
;
3961 font_related_attr_p
= 1;
3963 else if (EQ (attr
, QCslant
))
3965 if (!UNSPECIFIEDP (value
))
3967 CHECK_SYMBOL (value
);
3968 if (face_numeric_slant (value
) < 0)
3969 signal_error ("Invalid face slant", value
);
3971 old_value
= LFACE_SLANT (lface
);
3972 LFACE_SLANT (lface
) = value
;
3973 font_related_attr_p
= 1;
3975 else if (EQ (attr
, QCunderline
))
3977 if (!UNSPECIFIEDP (value
))
3978 if ((SYMBOLP (value
)
3980 && !EQ (value
, Qnil
))
3981 /* Underline color. */
3983 && XSTRING (value
)->size
== 0))
3984 signal_error ("Invalid face underline", value
);
3986 old_value
= LFACE_UNDERLINE (lface
);
3987 LFACE_UNDERLINE (lface
) = value
;
3989 else if (EQ (attr
, QCoverline
))
3991 if (!UNSPECIFIEDP (value
))
3992 if ((SYMBOLP (value
)
3994 && !EQ (value
, Qnil
))
3995 /* Overline color. */
3997 && XSTRING (value
)->size
== 0))
3998 signal_error ("Invalid face overline", value
);
4000 old_value
= LFACE_OVERLINE (lface
);
4001 LFACE_OVERLINE (lface
) = value
;
4003 else if (EQ (attr
, QCstrike_through
))
4005 if (!UNSPECIFIEDP (value
))
4006 if ((SYMBOLP (value
)
4008 && !EQ (value
, Qnil
))
4009 /* Strike-through color. */
4011 && XSTRING (value
)->size
== 0))
4012 signal_error ("Invalid face strike-through", value
);
4014 old_value
= LFACE_STRIKE_THROUGH (lface
);
4015 LFACE_STRIKE_THROUGH (lface
) = value
;
4017 else if (EQ (attr
, QCbox
))
4021 /* Allow t meaning a simple box of width 1 in foreground color
4024 value
= make_number (1);
4026 if (UNSPECIFIEDP (value
))
4028 else if (NILP (value
))
4030 else if (INTEGERP (value
))
4031 valid_p
= XINT (value
) != 0;
4032 else if (STRINGP (value
))
4033 valid_p
= XSTRING (value
)->size
> 0;
4034 else if (CONSP (value
))
4050 if (EQ (k
, QCline_width
))
4052 if (!INTEGERP (v
) || XINT (v
) == 0)
4055 else if (EQ (k
, QCcolor
))
4057 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
4060 else if (EQ (k
, QCstyle
))
4062 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4069 valid_p
= NILP (tem
);
4075 signal_error ("Invalid face box", value
);
4077 old_value
= LFACE_BOX (lface
);
4078 LFACE_BOX (lface
) = value
;
4080 else if (EQ (attr
, QCinverse_video
)
4081 || EQ (attr
, QCreverse_video
))
4083 if (!UNSPECIFIEDP (value
))
4085 CHECK_SYMBOL (value
);
4086 if (!EQ (value
, Qt
) && !NILP (value
))
4087 signal_error ("Invalid inverse-video face attribute value", value
);
4089 old_value
= LFACE_INVERSE (lface
);
4090 LFACE_INVERSE (lface
) = value
;
4092 else if (EQ (attr
, QCforeground
))
4094 if (!UNSPECIFIEDP (value
))
4096 /* Don't check for valid color names here because it depends
4097 on the frame (display) whether the color will be valid
4098 when the face is realized. */
4099 CHECK_STRING (value
);
4100 if (XSTRING (value
)->size
== 0)
4101 signal_error ("Empty foreground color value", value
);
4103 old_value
= LFACE_FOREGROUND (lface
);
4104 LFACE_FOREGROUND (lface
) = value
;
4106 else if (EQ (attr
, QCbackground
))
4108 if (!UNSPECIFIEDP (value
))
4110 /* Don't check for valid color names here because it depends
4111 on the frame (display) whether the color will be valid
4112 when the face is realized. */
4113 CHECK_STRING (value
);
4114 if (XSTRING (value
)->size
== 0)
4115 signal_error ("Empty background color value", value
);
4117 old_value
= LFACE_BACKGROUND (lface
);
4118 LFACE_BACKGROUND (lface
) = value
;
4120 else if (EQ (attr
, QCstipple
))
4122 #ifdef HAVE_X_WINDOWS
4123 if (!UNSPECIFIEDP (value
)
4125 && NILP (Fbitmap_spec_p (value
)))
4126 signal_error ("Invalid stipple attribute", value
);
4127 old_value
= LFACE_STIPPLE (lface
);
4128 LFACE_STIPPLE (lface
) = value
;
4129 #endif /* HAVE_X_WINDOWS */
4131 else if (EQ (attr
, QCwidth
))
4133 if (!UNSPECIFIEDP (value
))
4135 CHECK_SYMBOL (value
);
4136 if (face_numeric_swidth (value
) < 0)
4137 signal_error ("Invalid face width", value
);
4139 old_value
= LFACE_SWIDTH (lface
);
4140 LFACE_SWIDTH (lface
) = value
;
4141 font_related_attr_p
= 1;
4143 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4145 #ifdef HAVE_WINDOW_SYSTEM
4146 if (FRAME_WINDOW_P (XFRAME (frame
)))
4148 /* Set font-related attributes of the Lisp face from an XLFD
4153 CHECK_STRING (value
);
4155 f
= SELECTED_FRAME ();
4157 f
= check_x_frame (frame
);
4159 /* VALUE may be a fontset name or an alias of fontset. In
4160 such a case, use the base fontset name. */
4161 tmp
= Fquery_fontset (value
, Qnil
);
4164 else if (EQ (attr
, QCfontset
))
4165 signal_error ("Invalid fontset name", value
);
4167 if (EQ (attr
, QCfont
))
4169 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4170 signal_error ("Invalid font or fontset name", value
);
4173 LFACE_FONTSET (lface
) = value
;
4177 #endif /* HAVE_WINDOW_SYSTEM */
4179 else if (EQ (attr
, QCinherit
))
4182 if (SYMBOLP (value
))
4185 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4186 if (!SYMBOLP (XCAR (tail
)))
4189 LFACE_INHERIT (lface
) = value
;
4191 signal_error ("Invalid face inheritance", value
);
4193 else if (EQ (attr
, QCbold
))
4195 old_value
= LFACE_WEIGHT (lface
);
4196 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4197 font_related_attr_p
= 1;
4199 else if (EQ (attr
, QCitalic
))
4201 old_value
= LFACE_SLANT (lface
);
4202 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4203 font_related_attr_p
= 1;
4206 signal_error ("Invalid face attribute name", attr
);
4208 if (font_related_attr_p
4209 && !UNSPECIFIEDP (value
))
4210 /* If a font-related attribute other than QCfont is specified, the
4211 original `font' attribute nor that of default face is useless
4212 to determine a new font. Thus, we set it to nil so that font
4213 selection mechanism doesn't use it. */
4214 LFACE_FONT (lface
) = Qnil
;
4216 /* Changing a named face means that all realized faces depending on
4217 that face are invalid. Since we cannot tell which realized faces
4218 depend on the face, make sure they are all removed. This is done
4219 by incrementing face_change_count. The next call to
4220 init_iterator will then free realized faces. */
4222 && (EQ (attr
, QCfont
)
4223 || EQ (attr
, QCfontset
)
4224 || NILP (Fequal (old_value
, value
))))
4226 ++face_change_count
;
4227 ++windows_or_buffers_changed
;
4230 if (!UNSPECIFIEDP (value
)
4231 && NILP (Fequal (old_value
, value
)))
4237 if (EQ (face
, Qdefault
))
4239 #ifdef HAVE_WINDOW_SYSTEM
4240 /* Changed font-related attributes of the `default' face are
4241 reflected in changed `font' frame parameters. */
4243 && (font_related_attr_p
|| font_attr_p
)
4244 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4245 set_font_frame_param (frame
, lface
);
4247 #endif /* HAVE_WINDOW_SYSTEM */
4249 if (EQ (attr
, QCforeground
))
4250 param
= Qforeground_color
;
4251 else if (EQ (attr
, QCbackground
))
4252 param
= Qbackground_color
;
4254 #ifdef HAVE_WINDOW_SYSTEM
4256 else if (EQ (face
, Qscroll_bar
))
4258 /* Changing the colors of `scroll-bar' sets frame parameters
4259 `scroll-bar-foreground' and `scroll-bar-background'. */
4260 if (EQ (attr
, QCforeground
))
4261 param
= Qscroll_bar_foreground
;
4262 else if (EQ (attr
, QCbackground
))
4263 param
= Qscroll_bar_background
;
4265 #endif /* not WINDOWSNT */
4266 else if (EQ (face
, Qborder
))
4268 /* Changing background color of `border' sets frame parameter
4270 if (EQ (attr
, QCbackground
))
4271 param
= Qborder_color
;
4273 else if (EQ (face
, Qcursor
))
4275 /* Changing background color of `cursor' sets frame parameter
4277 if (EQ (attr
, QCbackground
))
4278 param
= Qcursor_color
;
4280 else if (EQ (face
, Qmouse
))
4282 /* Changing background color of `mouse' sets frame parameter
4284 if (EQ (attr
, QCbackground
))
4285 param
= Qmouse_color
;
4287 #endif /* HAVE_WINDOW_SYSTEM */
4288 else if (EQ (face
, Qmenu
))
4290 /* Indicate that we have to update the menu bar when
4291 realizing faces on FRAME. FRAME t change the
4292 default for new frames. We do this by setting
4293 setting the flag in new face caches */
4296 struct frame
*f
= XFRAME (frame
);
4297 if (FRAME_FACE_CACHE (f
) == NULL
)
4298 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4299 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4302 menu_face_changed_default
= 1;
4308 /* Update `default-frame-alist', which is used for new frames. */
4310 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4313 /* Update the current frame's parameters. */
4316 cons
= XCAR (Vparam_value_alist
);
4317 XSETCAR (cons
, param
);
4318 XSETCDR (cons
, value
);
4319 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4328 #ifdef HAVE_WINDOW_SYSTEM
4330 /* Set the `font' frame parameter of FRAME determined from `default'
4331 face attributes LFACE. If a font name is explicitely
4332 specfied in LFACE, use it as is. Otherwise, determine a font name
4333 from the other font-related atrributes of LFACE. In that case, if
4334 there's no matching font, signals an error. */
4337 set_font_frame_param (frame
, lface
)
4338 Lisp_Object frame
, lface
;
4340 struct frame
*f
= XFRAME (frame
);
4342 if (FRAME_WINDOW_P (f
))
4344 Lisp_Object font_name
;
4347 if (STRINGP (LFACE_FONT (lface
)))
4348 font_name
= LFACE_FONT (lface
);
4351 /* Choose a font name that reflects LFACE's attributes and has
4352 the registry and encoding pattern specified in the default
4353 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4354 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
);
4356 error ("No font matches the specified attribute");
4357 font_name
= build_string (font
);
4361 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4366 /* Update the corresponding face when frame parameter PARAM on frame F
4367 has been assigned the value NEW_VALUE. */
4370 update_face_from_frame_parameter (f
, param
, new_value
)
4372 Lisp_Object param
, new_value
;
4376 /* If there are no faces yet, give up. This is the case when called
4377 from Fx_create_frame, and we do the necessary things later in
4378 face-set-after-frame-defaults. */
4379 if (NILP (f
->face_alist
))
4382 /* Changing a named face means that all realized faces depending on
4383 that face are invalid. Since we cannot tell which realized faces
4384 depend on the face, make sure they are all removed. This is done
4385 by incrementing face_change_count. The next call to
4386 init_iterator will then free realized faces. */
4387 ++face_change_count
;
4388 ++windows_or_buffers_changed
;
4390 if (EQ (param
, Qforeground_color
))
4392 lface
= lface_from_face_name (f
, Qdefault
, 1);
4393 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4394 ? new_value
: Qunspecified
);
4395 realize_basic_faces (f
);
4397 else if (EQ (param
, Qbackground_color
))
4401 /* Changing the background color might change the background
4402 mode, so that we have to load new defface specs. Call
4403 frame-update-face-colors to do that. */
4404 XSETFRAME (frame
, f
);
4405 call1 (Qframe_update_face_colors
, frame
);
4407 lface
= lface_from_face_name (f
, Qdefault
, 1);
4408 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4409 ? new_value
: Qunspecified
);
4410 realize_basic_faces (f
);
4412 if (EQ (param
, Qborder_color
))
4414 lface
= lface_from_face_name (f
, Qborder
, 1);
4415 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4416 ? new_value
: Qunspecified
);
4418 else if (EQ (param
, Qcursor_color
))
4420 lface
= lface_from_face_name (f
, Qcursor
, 1);
4421 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4422 ? new_value
: Qunspecified
);
4424 else if (EQ (param
, Qmouse_color
))
4426 lface
= lface_from_face_name (f
, Qmouse
, 1);
4427 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4428 ? new_value
: Qunspecified
);
4433 /* Get the value of X resource RESOURCE, class CLASS for the display
4434 of frame FRAME. This is here because ordinary `x-get-resource'
4435 doesn't take a frame argument. */
4437 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4438 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4439 (resource
, class, frame
)
4440 Lisp_Object resource
, class, frame
;
4442 Lisp_Object value
= Qnil
;
4445 CHECK_STRING (resource
);
4446 CHECK_STRING (class);
4447 CHECK_LIVE_FRAME (frame
);
4449 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4450 resource
, class, Qnil
, Qnil
);
4452 #endif /* not macintosh */
4453 #endif /* not WINDOWSNT */
4458 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4459 If VALUE is "on" or "true", return t. If VALUE is "off" or
4460 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4461 error; if SIGNAL_P is zero, return 0. */
4464 face_boolean_x_resource_value (value
, signal_p
)
4468 Lisp_Object result
= make_number (0);
4470 xassert (STRINGP (value
));
4472 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4473 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4475 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4476 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4478 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4479 result
= Qunspecified
;
4481 signal_error ("Invalid face attribute value from X resource", value
);
4487 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4488 Finternal_set_lisp_face_attribute_from_resource
,
4489 Sinternal_set_lisp_face_attribute_from_resource
,
4490 3, 4, 0, doc
: /* */)
4491 (face
, attr
, value
, frame
)
4492 Lisp_Object face
, attr
, value
, frame
;
4494 CHECK_SYMBOL (face
);
4495 CHECK_SYMBOL (attr
);
4496 CHECK_STRING (value
);
4498 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4499 value
= Qunspecified
;
4500 else if (EQ (attr
, QCheight
))
4502 value
= Fstring_to_number (value
, make_number (10));
4503 if (XINT (value
) <= 0)
4504 signal_error ("Invalid face height from X resource", value
);
4506 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4507 value
= face_boolean_x_resource_value (value
, 1);
4508 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4509 value
= intern (XSTRING (value
)->data
);
4510 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4511 value
= face_boolean_x_resource_value (value
, 1);
4512 else if (EQ (attr
, QCunderline
)
4513 || EQ (attr
, QCoverline
)
4514 || EQ (attr
, QCstrike_through
))
4516 Lisp_Object boolean_value
;
4518 /* If the result of face_boolean_x_resource_value is t or nil,
4519 VALUE does NOT specify a color. */
4520 boolean_value
= face_boolean_x_resource_value (value
, 0);
4521 if (SYMBOLP (boolean_value
))
4522 value
= boolean_value
;
4524 else if (EQ (attr
, QCbox
))
4525 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4527 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4530 #endif /* HAVE_WINDOW_SYSTEM */
4533 /***********************************************************************
4535 ***********************************************************************/
4537 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4539 /* Make menus on frame F appear as specified by the `menu' face. */
4542 x_update_menu_appearance (f
)
4545 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4549 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4553 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4554 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4555 char *myname
= XSTRING (Vx_resource_name
)->data
;
4558 const char *popup_path
= "popup_menu";
4560 const char *popup_path
= "menu.popup";
4563 if (STRINGP (LFACE_FOREGROUND (lface
)))
4565 sprintf (line
, "%s.%s*foreground: %s",
4567 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4568 XrmPutLineResource (&rdb
, line
);
4569 sprintf (line
, "%s.pane.menubar*foreground: %s",
4570 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4571 XrmPutLineResource (&rdb
, line
);
4575 if (STRINGP (LFACE_BACKGROUND (lface
)))
4577 sprintf (line
, "%s.%s*background: %s",
4579 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4580 XrmPutLineResource (&rdb
, line
);
4581 sprintf (line
, "%s.pane.menubar*background: %s",
4582 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4583 XrmPutLineResource (&rdb
, line
);
4588 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4589 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4590 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4591 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4592 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4593 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4596 const char *suffix
= "List";
4598 const char *suffix
= "";
4600 sprintf (line
, "%s.pane.menubar*font%s: %s",
4601 myname
, suffix
, face
->font_name
);
4602 XrmPutLineResource (&rdb
, line
);
4603 sprintf (line
, "%s.%s*font%s: %s",
4604 myname
, popup_path
, suffix
, face
->font_name
);
4605 XrmPutLineResource (&rdb
, line
);
4609 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4610 free_frame_menubar (f
);
4614 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4617 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4618 Sface_attribute_relative_p
,
4620 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4622 Lisp_Object attribute
, value
;
4624 if (EQ (value
, Qunspecified
))
4626 else if (EQ (attribute
, QCheight
))
4627 return INTEGERP (value
) ? Qnil
: Qt
;
4632 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4634 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4635 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4636 the result will be absolute, otherwise it will be relative. */)
4637 (attribute
, value1
, value2
)
4638 Lisp_Object attribute
, value1
, value2
;
4640 if (EQ (value1
, Qunspecified
))
4642 else if (EQ (attribute
, QCheight
))
4643 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4649 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4650 Sinternal_get_lisp_face_attribute
,
4652 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4653 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4654 face attribute name, signal an error.
4655 If the optional argument FRAME is given, report on face FACE in that
4656 frame. If FRAME is t, report on the defaults for face FACE (for new
4657 frames). If FRAME is omitted or nil, use the selected frame. */)
4658 (symbol
, keyword
, frame
)
4659 Lisp_Object symbol
, keyword
, frame
;
4661 Lisp_Object lface
, value
= Qnil
;
4663 CHECK_SYMBOL (symbol
);
4664 CHECK_SYMBOL (keyword
);
4667 lface
= lface_from_face_name (NULL
, symbol
, 1);
4671 frame
= selected_frame
;
4672 CHECK_LIVE_FRAME (frame
);
4673 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4676 if (EQ (keyword
, QCfamily
))
4677 value
= LFACE_FAMILY (lface
);
4678 else if (EQ (keyword
, QCheight
))
4679 value
= LFACE_HEIGHT (lface
);
4680 else if (EQ (keyword
, QCweight
))
4681 value
= LFACE_WEIGHT (lface
);
4682 else if (EQ (keyword
, QCslant
))
4683 value
= LFACE_SLANT (lface
);
4684 else if (EQ (keyword
, QCunderline
))
4685 value
= LFACE_UNDERLINE (lface
);
4686 else if (EQ (keyword
, QCoverline
))
4687 value
= LFACE_OVERLINE (lface
);
4688 else if (EQ (keyword
, QCstrike_through
))
4689 value
= LFACE_STRIKE_THROUGH (lface
);
4690 else if (EQ (keyword
, QCbox
))
4691 value
= LFACE_BOX (lface
);
4692 else if (EQ (keyword
, QCinverse_video
)
4693 || EQ (keyword
, QCreverse_video
))
4694 value
= LFACE_INVERSE (lface
);
4695 else if (EQ (keyword
, QCforeground
))
4696 value
= LFACE_FOREGROUND (lface
);
4697 else if (EQ (keyword
, QCbackground
))
4698 value
= LFACE_BACKGROUND (lface
);
4699 else if (EQ (keyword
, QCstipple
))
4700 value
= LFACE_STIPPLE (lface
);
4701 else if (EQ (keyword
, QCwidth
))
4702 value
= LFACE_SWIDTH (lface
);
4703 else if (EQ (keyword
, QCinherit
))
4704 value
= LFACE_INHERIT (lface
);
4705 else if (EQ (keyword
, QCfont
))
4706 value
= LFACE_FONT (lface
);
4707 else if (EQ (keyword
, QCfontset
))
4708 value
= LFACE_FONTSET (lface
);
4710 signal_error ("Invalid face attribute name", keyword
);
4716 DEFUN ("internal-lisp-face-attribute-values",
4717 Finternal_lisp_face_attribute_values
,
4718 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4719 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4720 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4724 Lisp_Object result
= Qnil
;
4726 CHECK_SYMBOL (attr
);
4728 if (EQ (attr
, QCweight
)
4729 || EQ (attr
, QCslant
)
4730 || EQ (attr
, QCwidth
))
4732 /* Extract permissible symbols from tables. */
4733 struct table_entry
*table
;
4736 if (EQ (attr
, QCweight
))
4737 table
= weight_table
, dim
= DIM (weight_table
);
4738 else if (EQ (attr
, QCslant
))
4739 table
= slant_table
, dim
= DIM (slant_table
);
4741 table
= swidth_table
, dim
= DIM (swidth_table
);
4743 for (i
= 0; i
< dim
; ++i
)
4745 Lisp_Object symbol
= *table
[i
].symbol
;
4746 Lisp_Object tail
= result
;
4749 && !EQ (XCAR (tail
), symbol
))
4753 result
= Fcons (symbol
, result
);
4756 else if (EQ (attr
, QCunderline
))
4757 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4758 else if (EQ (attr
, QCoverline
))
4759 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4760 else if (EQ (attr
, QCstrike_through
))
4761 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4762 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4763 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4769 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4770 Sinternal_merge_in_global_face
, 2, 2, 0,
4771 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4772 Default face attributes override any local face attributes. */)
4774 Lisp_Object face
, frame
;
4777 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4779 CHECK_LIVE_FRAME (frame
);
4780 global_lface
= lface_from_face_name (NULL
, face
, 1);
4781 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4782 if (NILP (local_lface
))
4783 local_lface
= Finternal_make_lisp_face (face
, frame
);
4785 /* Make every specified global attribute override the local one.
4786 BEWARE!! This is only used from `face-set-after-frame-default' where
4787 the local frame is defined from default specs in `face-defface-spec'
4788 and those should be overridden by global settings. Hence the strange
4789 "global before local" priority. */
4790 lvec
= XVECTOR (local_lface
)->contents
;
4791 gvec
= XVECTOR (global_lface
)->contents
;
4792 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4793 if (! UNSPECIFIEDP (gvec
[i
]))
4800 /* The following function is implemented for compatibility with 20.2.
4801 The function is used in x-resolve-fonts when it is asked to
4802 return fonts with the same size as the font of a face. This is
4803 done in fontset.el. */
4805 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4806 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4807 If the optional argument FRAME is given, report on face FACE in that frame.
4808 If FRAME is t, report on the defaults for face FACE (for new frames).
4809 The font default for a face is either nil, or a list
4810 of the form (bold), (italic) or (bold italic).
4811 If FRAME is omitted or nil, use the selected frame. */)
4813 Lisp_Object face
, frame
;
4817 Lisp_Object result
= Qnil
;
4818 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4820 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4821 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4822 result
= Fcons (Qbold
, result
);
4824 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4825 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4826 result
= Fcons (Qitalic
, result
);
4832 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4833 int face_id
= lookup_named_face (f
, face
);
4834 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4835 return face
? build_string (face
->font_name
) : Qnil
;
4840 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4841 all attributes are `equal'. Tries to be fast because this function
4842 is called quite often. */
4845 lface_equal_p (v1
, v2
)
4846 Lisp_Object
*v1
, *v2
;
4850 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4852 Lisp_Object a
= v1
[i
];
4853 Lisp_Object b
= v2
[i
];
4855 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4856 and the other is specified. */
4857 equal_p
= XTYPE (a
) == XTYPE (b
);
4866 equal_p
= ((STRING_BYTES (XSTRING (a
))
4867 == STRING_BYTES (XSTRING (b
)))
4868 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4869 STRING_BYTES (XSTRING (a
))) == 0);
4878 equal_p
= !NILP (Fequal (a
, b
));
4888 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4889 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4890 doc
: /* True if FACE1 and FACE2 are equal.
4891 If the optional argument FRAME is given, report on face FACE in that frame.
4892 If FRAME is t, report on the defaults for face FACE (for new frames).
4893 If FRAME is omitted or nil, use the selected frame. */)
4894 (face1
, face2
, frame
)
4895 Lisp_Object face1
, face2
, frame
;
4899 Lisp_Object lface1
, lface2
;
4904 /* Don't use check_x_frame here because this function is called
4905 before X frames exist. At that time, if FRAME is nil,
4906 selected_frame will be used which is the frame dumped with
4907 Emacs. That frame is not an X frame. */
4908 f
= frame_or_selected_frame (frame
, 2);
4910 lface1
= lface_from_face_name (NULL
, face1
, 1);
4911 lface2
= lface_from_face_name (NULL
, face2
, 1);
4912 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4913 XVECTOR (lface2
)->contents
);
4914 return equal_p
? Qt
: Qnil
;
4918 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4919 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4920 doc
: /* True if FACE has no attribute specified.
4921 If the optional argument FRAME is given, report on face FACE in that frame.
4922 If FRAME is t, report on the defaults for face FACE (for new frames).
4923 If FRAME is omitted or nil, use the selected frame. */)
4925 Lisp_Object face
, frame
;
4932 frame
= selected_frame
;
4933 CHECK_LIVE_FRAME (frame
);
4937 lface
= lface_from_face_name (NULL
, face
, 1);
4939 lface
= lface_from_face_name (f
, face
, 1);
4941 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4942 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4945 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4949 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4951 doc
: /* Return an alist of frame-local faces defined on FRAME.
4952 For internal use only. */)
4956 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4957 return f
->face_alist
;
4961 /* Return a hash code for Lisp string STRING with case ignored. Used
4962 below in computing a hash value for a Lisp face. */
4964 static INLINE
unsigned
4965 hash_string_case_insensitive (string
)
4970 xassert (STRINGP (string
));
4971 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4972 hash
= (hash
<< 1) ^ tolower (*s
);
4977 /* Return a hash code for face attribute vector V. */
4979 static INLINE
unsigned
4983 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4984 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4985 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4986 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4987 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4988 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4989 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4993 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4994 considering charsets/registries). They do if they specify the same
4995 family, point size, weight, width, slant, font, and fontset. Both
4996 LFACE1 and LFACE2 must be fully-specified. */
4999 lface_same_font_attributes_p (lface1
, lface2
)
5000 Lisp_Object
*lface1
, *lface2
;
5002 xassert (lface_fully_specified_p (lface1
)
5003 && lface_fully_specified_p (lface2
));
5004 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
5005 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
5006 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5007 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5008 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5009 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5010 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5011 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5012 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5013 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5014 && ! xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
5015 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
)))
5016 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5017 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5018 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5019 && ! xstricmp (XSTRING (lface1
[LFACE_FONTSET_INDEX
])->data
,
5020 XSTRING (lface2
[LFACE_FONTSET_INDEX
])->data
)))
5026 /***********************************************************************
5028 ***********************************************************************/
5030 /* Allocate and return a new realized face for Lisp face attribute
5033 static struct face
*
5034 make_realized_face (attr
)
5037 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5038 bzero (face
, sizeof *face
);
5039 face
->ascii_face
= face
;
5040 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5045 /* Free realized face FACE, including its X resources. FACE may
5049 free_realized_face (f
, face
)
5055 #ifdef HAVE_WINDOW_SYSTEM
5056 if (FRAME_WINDOW_P (f
))
5058 /* Free fontset of FACE if it is ASCII face. */
5059 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5060 free_face_fontset (f
, face
);
5063 x_free_gc (f
, face
->gc
);
5067 free_face_colors (f
, face
);
5068 x_destroy_bitmap (f
, face
->stipple
);
5070 #endif /* HAVE_WINDOW_SYSTEM */
5077 /* Prepare face FACE for subsequent display on frame F. This
5078 allocated GCs if they haven't been allocated yet or have been freed
5079 by clearing the face cache. */
5082 prepare_face_for_display (f
, face
)
5086 #ifdef HAVE_WINDOW_SYSTEM
5087 xassert (FRAME_WINDOW_P (f
));
5092 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5094 xgcv
.foreground
= face
->foreground
;
5095 xgcv
.background
= face
->background
;
5096 #ifdef HAVE_X_WINDOWS
5097 xgcv
.graphics_exposures
= False
;
5099 /* The font of FACE may be null if we couldn't load it. */
5102 #ifdef HAVE_X_WINDOWS
5103 xgcv
.font
= face
->font
->fid
;
5106 xgcv
.font
= face
->font
;
5109 xgcv
.font
= face
->font
;
5115 #ifdef HAVE_X_WINDOWS
5118 xgcv
.fill_style
= FillOpaqueStippled
;
5119 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5120 mask
|= GCFillStyle
| GCStipple
;
5123 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5126 #endif /* HAVE_WINDOW_SYSTEM */
5130 /***********************************************************************
5132 ***********************************************************************/
5134 /* Return a new face cache for frame F. */
5136 static struct face_cache
*
5140 struct face_cache
*c
;
5143 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5144 bzero (c
, sizeof *c
);
5145 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5146 c
->buckets
= (struct face
**) xmalloc (size
);
5147 bzero (c
->buckets
, size
);
5149 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5151 c
->menu_face_changed_p
= menu_face_changed_default
;
5156 /* Clear out all graphics contexts for all realized faces, except for
5157 the basic faces. This should be done from time to time just to avoid
5158 keeping too many graphics contexts that are no longer needed. */
5162 struct face_cache
*c
;
5164 if (c
&& FRAME_WINDOW_P (c
->f
))
5166 #ifdef HAVE_WINDOW_SYSTEM
5168 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5170 struct face
*face
= c
->faces_by_id
[i
];
5171 if (face
&& face
->gc
)
5173 x_free_gc (c
->f
, face
->gc
);
5177 #endif /* HAVE_WINDOW_SYSTEM */
5182 /* Free all realized faces in face cache C, including basic faces. C
5183 may be null. If faces are freed, make sure the frame's current
5184 matrix is marked invalid, so that a display caused by an expose
5185 event doesn't try to use faces we destroyed. */
5188 free_realized_faces (c
)
5189 struct face_cache
*c
;
5194 struct frame
*f
= c
->f
;
5196 /* We must block input here because we can't process X events
5197 safely while only some faces are freed, or when the frame's
5198 current matrix still references freed faces. */
5201 for (i
= 0; i
< c
->used
; ++i
)
5203 free_realized_face (f
, c
->faces_by_id
[i
]);
5204 c
->faces_by_id
[i
] = NULL
;
5208 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5209 bzero (c
->buckets
, size
);
5211 /* Must do a thorough redisplay the next time. Mark current
5212 matrices as invalid because they will reference faces freed
5213 above. This function is also called when a frame is
5214 destroyed. In this case, the root window of F is nil. */
5215 if (WINDOWP (f
->root_window
))
5217 clear_current_matrices (f
);
5218 ++windows_or_buffers_changed
;
5226 /* Free all realized faces that are using FONTSET on frame F. */
5229 free_realized_faces_for_fontset (f
, fontset
)
5233 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5237 /* We must block input here because we can't process X events safely
5238 while only some faces are freed, or when the frame's current
5239 matrix still references freed faces. */
5242 for (i
= 0; i
< cache
->used
; i
++)
5244 face
= cache
->faces_by_id
[i
];
5246 && face
->fontset
== fontset
)
5248 uncache_face (cache
, face
);
5249 free_realized_face (f
, face
);
5253 /* Must do a thorough redisplay the next time. Mark current
5254 matrices as invalid because they will reference faces freed
5255 above. This function is also called when a frame is destroyed.
5256 In this case, the root window of F is nil. */
5257 if (WINDOWP (f
->root_window
))
5259 clear_current_matrices (f
);
5260 ++windows_or_buffers_changed
;
5267 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5268 This is done after attributes of a named face have been changed,
5269 because we can't tell which realized faces depend on that face. */
5272 free_all_realized_faces (frame
)
5278 FOR_EACH_FRAME (rest
, frame
)
5279 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5282 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5286 /* Free face cache C and faces in it, including their X resources. */
5290 struct face_cache
*c
;
5294 free_realized_faces (c
);
5296 xfree (c
->faces_by_id
);
5302 /* Cache realized face FACE in face cache C. HASH is the hash value
5303 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5304 FACE), insert the new face to the beginning of the collision list
5305 of the face hash table of C. Otherwise, add the new face to the
5306 end of the collision list. This way, lookup_face can quickly find
5307 that a requested face is not cached. */
5310 cache_face (c
, face
, hash
)
5311 struct face_cache
*c
;
5315 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5319 if (face
->ascii_face
!= face
)
5321 struct face
*last
= c
->buckets
[i
];
5332 c
->buckets
[i
] = face
;
5333 face
->prev
= face
->next
= NULL
;
5339 face
->next
= c
->buckets
[i
];
5341 face
->next
->prev
= face
;
5342 c
->buckets
[i
] = face
;
5345 /* Find a free slot in C->faces_by_id and use the index of the free
5346 slot as FACE->id. */
5347 for (i
= 0; i
< c
->used
; ++i
)
5348 if (c
->faces_by_id
[i
] == NULL
)
5352 /* Maybe enlarge C->faces_by_id. */
5353 if (i
== c
->used
&& c
->used
== c
->size
)
5355 int new_size
= 2 * c
->size
;
5356 int sz
= new_size
* sizeof *c
->faces_by_id
;
5357 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5362 /* Check that FACE got a unique id. */
5367 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5368 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5374 #endif /* GLYPH_DEBUG */
5376 c
->faces_by_id
[i
] = face
;
5382 /* Remove face FACE from cache C. */
5385 uncache_face (c
, face
)
5386 struct face_cache
*c
;
5389 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5392 face
->prev
->next
= face
->next
;
5394 c
->buckets
[i
] = face
->next
;
5397 face
->next
->prev
= face
->prev
;
5399 c
->faces_by_id
[face
->id
] = NULL
;
5400 if (face
->id
== c
->used
)
5405 /* Look up a realized face with face attributes ATTR in the face cache
5406 of frame F. The face will be used to display ASCII characters.
5407 Value is the ID of the face found. If no suitable face is found,
5408 realize a new one. */
5411 lookup_face (f
, attr
)
5415 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5420 xassert (cache
!= NULL
);
5421 check_lface_attrs (attr
);
5423 /* Look up ATTR in the face cache. */
5424 hash
= lface_hash (attr
);
5425 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5427 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5429 if (face
->ascii_face
!= face
)
5431 /* There's no more ASCII face. */
5435 if (face
->hash
== hash
5436 && lface_equal_p (face
->lface
, attr
))
5440 /* If not found, realize a new face. */
5442 face
= realize_face (cache
, attr
, -1);
5445 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5446 #endif /* GLYPH_DEBUG */
5452 /* Look up a realized face that has the same attributes as BASE_FACE
5453 except for the font in the face cache of frame F. If FONT_ID is
5454 not negative, it is an ID number of an already opened font that is
5455 used by the face. If FONT_ID is negative, the face has no font.
5456 Value is the ID of the face found. If no suitable face is found,
5457 realize a new one. */
5460 lookup_non_ascii_face (f
, font_id
, base_face
)
5463 struct face
*base_face
;
5465 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5470 xassert (cache
!= NULL
);
5471 base_face
= base_face
->ascii_face
;
5472 hash
= lface_hash (base_face
->lface
);
5473 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5475 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5477 if (face
->ascii_face
== face
)
5479 if (face
->ascii_face
== base_face
5480 && face
->font_info_id
== font_id
)
5484 /* If not found, realize a new face. */
5486 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5489 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5490 #endif /* GLYPH_DEBUG */
5496 /* Return the face id of the realized face for named face SYMBOL on
5497 frame F suitable for displaying ASCII characters. Value is -1 if
5498 the face couldn't be determined, which might happen if the default
5499 face isn't realized and cannot be realized. */
5502 lookup_named_face (f
, symbol
)
5506 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5507 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5508 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5510 if (default_face
== NULL
)
5512 if (!realize_basic_faces (f
))
5514 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5517 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5518 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5519 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5520 return lookup_face (f
, attrs
);
5524 /* Return the ID of the realized ASCII face of Lisp face with ID
5525 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5528 ascii_face_of_lisp_face (f
, lface_id
)
5534 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5536 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5537 face_id
= lookup_named_face (f
, face_name
);
5546 /* Return a face for charset ASCII that is like the face with id
5547 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5548 STEPS < 0 means larger. Value is the id of the face. */
5551 smaller_face (f
, face_id
, steps
)
5555 #ifdef HAVE_WINDOW_SYSTEM
5557 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5558 int pt
, last_pt
, last_height
;
5561 struct face
*new_face
;
5563 /* If not called for an X frame, just return the original face. */
5564 if (FRAME_TERMCAP_P (f
))
5567 /* Try in increments of 1/2 pt. */
5568 delta
= steps
< 0 ? 5 : -5;
5569 steps
= abs (steps
);
5571 face
= FACE_FROM_ID (f
, face_id
);
5572 bcopy (face
->lface
, attrs
, sizeof attrs
);
5573 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5574 new_face_id
= face_id
;
5575 last_height
= FONT_HEIGHT (face
->font
);
5579 /* Give up if we cannot find a font within 10pt. */
5580 && abs (last_pt
- pt
) < 100)
5582 /* Look up a face for a slightly smaller/larger font. */
5584 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5585 new_face_id
= lookup_face (f
, attrs
);
5586 new_face
= FACE_FROM_ID (f
, new_face_id
);
5588 /* If height changes, count that as one step. */
5589 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5590 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5593 last_height
= FONT_HEIGHT (new_face
->font
);
5600 #else /* not HAVE_WINDOW_SYSTEM */
5604 #endif /* not HAVE_WINDOW_SYSTEM */
5608 /* Return a face for charset ASCII that is like the face with id
5609 FACE_ID on frame F, but has height HEIGHT. */
5612 face_with_height (f
, face_id
, height
)
5617 #ifdef HAVE_WINDOW_SYSTEM
5619 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5621 if (FRAME_TERMCAP_P (f
)
5625 face
= FACE_FROM_ID (f
, face_id
);
5626 bcopy (face
->lface
, attrs
, sizeof attrs
);
5627 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5628 face_id
= lookup_face (f
, attrs
);
5629 #endif /* HAVE_WINDOW_SYSTEM */
5635 /* Return the face id of the realized face for named face SYMBOL on
5636 frame F suitable for displaying ASCII characters, and use
5637 attributes of the face FACE_ID for attributes that aren't
5638 completely specified by SYMBOL. This is like lookup_named_face,
5639 except that the default attributes come from FACE_ID, not from the
5640 default face. FACE_ID is assumed to be already realized. */
5643 lookup_derived_face (f
, symbol
, face_id
)
5648 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5649 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5650 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5655 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5656 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5657 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5658 return lookup_face (f
, attrs
);
5661 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5662 Sface_attributes_as_vector
, 1, 1, 0,
5663 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5668 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5670 merge_face_vector_with_property (XFRAME (selected_frame
),
5671 XVECTOR (lface
)->contents
,
5678 /***********************************************************************
5680 ***********************************************************************/
5682 DEFUN ("internal-set-font-selection-order",
5683 Finternal_set_font_selection_order
,
5684 Sinternal_set_font_selection_order
, 1, 1, 0,
5685 doc
: /* Set font selection order for face font selection to ORDER.
5686 ORDER must be a list of length 4 containing the symbols `:width',
5687 `:height', `:weight', and `:slant'. Face attributes appearing
5688 first in ORDER are matched first, e.g. if `:height' appears before
5689 `:weight' in ORDER, font selection first tries to find a font with
5690 a suitable height, and then tries to match the font weight.
5697 int indices
[DIM (font_sort_order
)];
5700 bzero (indices
, sizeof indices
);
5704 CONSP (list
) && i
< DIM (indices
);
5705 list
= XCDR (list
), ++i
)
5707 Lisp_Object attr
= XCAR (list
);
5710 if (EQ (attr
, QCwidth
))
5712 else if (EQ (attr
, QCheight
))
5713 xlfd
= XLFD_POINT_SIZE
;
5714 else if (EQ (attr
, QCweight
))
5716 else if (EQ (attr
, QCslant
))
5721 if (indices
[i
] != 0)
5726 if (!NILP (list
) || i
!= DIM (indices
))
5727 signal_error ("Invalid font sort order", order
);
5728 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5729 if (indices
[i
] == 0)
5730 signal_error ("Invalid font sort order", order
);
5732 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5734 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5735 free_all_realized_faces (Qnil
);
5742 DEFUN ("internal-set-alternative-font-family-alist",
5743 Finternal_set_alternative_font_family_alist
,
5744 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5745 doc
: /* Define alternative font families to try in face font selection.
5746 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5747 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5748 be found. Value is ALIST. */)
5753 Vface_alternative_font_family_alist
= alist
;
5754 free_all_realized_faces (Qnil
);
5759 DEFUN ("internal-set-alternative-font-registry-alist",
5760 Finternal_set_alternative_font_registry_alist
,
5761 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5762 doc
: /* Define alternative font registries to try in face font selection.
5763 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5764 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5765 be found. Value is ALIST. */)
5770 Vface_alternative_font_registry_alist
= alist
;
5771 free_all_realized_faces (Qnil
);
5776 #ifdef HAVE_WINDOW_SYSTEM
5778 /* Value is non-zero if FONT is the name of a scalable font. The
5779 X11R6 XLFD spec says that point size, pixel size, and average width
5780 are zero for scalable fonts. Intlfonts contain at least one
5781 scalable font ("*-muleindian-1") for which this isn't true, so we
5782 just test average width. */
5785 font_scalable_p (font
)
5786 struct font_name
*font
;
5788 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5789 return (*s
== '0' && *(s
+ 1) == '\0')
5791 /* Windows implementation of XLFD is slightly broken for backward
5792 compatibility with previous broken versions, so test for
5793 wildcards as well as 0. */
5800 /* Ignore the difference of font point size less than this value. */
5802 #define FONT_POINT_SIZE_QUANTUM 5
5804 /* Value is non-zero if FONT1 is a better match for font attributes
5805 VALUES than FONT2. VALUES is an array of face attribute values in
5806 font sort order. COMPARE_PT_P zero means don't compare point
5807 sizes. AVGWIDTH, if not zero, is a specified font average width
5811 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5813 struct font_name
*font1
, *font2
;
5814 int compare_pt_p
, avgwidth
;
5818 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5820 int xlfd_idx
= font_sort_order
[i
];
5822 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5824 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5825 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5827 if (xlfd_idx
== XLFD_POINT_SIZE
5828 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5830 if (delta1
> delta2
)
5832 else if (delta1
< delta2
)
5836 /* The difference may be equal because, e.g., the face
5837 specifies `italic' but we have only `regular' and
5838 `oblique'. Prefer `oblique' in this case. */
5839 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5840 && font1
->numeric
[xlfd_idx
] > values
[i
]
5841 && font2
->numeric
[xlfd_idx
] < values
[i
])
5849 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5850 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5851 if (delta1
> delta2
)
5853 else if (delta1
< delta2
)
5857 return font1
->registry_priority
< font2
->registry_priority
;
5861 /* Value is non-zero if FONT is an exact match for face attributes in
5862 SPECIFIED. SPECIFIED is an array of face attribute values in font
5863 sort order. AVGWIDTH, if non-zero, is an average width to compare
5867 exact_face_match_p (specified
, font
, avgwidth
)
5869 struct font_name
*font
;
5874 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5875 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5878 return (i
== DIM (font_sort_order
)
5880 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5884 /* Value is the name of a scaled font, generated from scalable font
5885 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5886 Value is allocated from heap. */
5889 build_scalable_font_name (f
, font
, specified_pt
)
5891 struct font_name
*font
;
5894 char point_size
[20], pixel_size
[20];
5896 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5899 /* If scalable font is for a specific resolution, compute
5900 the point size we must specify from the resolution of
5901 the display and the specified resolution of the font. */
5902 if (font
->numeric
[XLFD_RESY
] != 0)
5904 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5905 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5910 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5913 /* Set point size of the font. */
5914 sprintf (point_size
, "%d", (int) pt
);
5915 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5916 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5918 /* Set pixel size. */
5919 sprintf (pixel_size
, "%d", pixel_value
);
5920 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5921 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5923 /* If font doesn't specify its resolution, use the
5924 resolution of the display. */
5925 if (font
->numeric
[XLFD_RESY
] == 0)
5928 sprintf (buffer
, "%d", (int) resy
);
5929 font
->fields
[XLFD_RESY
] = buffer
;
5930 font
->numeric
[XLFD_RESY
] = resy
;
5933 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5936 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5937 sprintf (buffer
, "%d", resx
);
5938 font
->fields
[XLFD_RESX
] = buffer
;
5939 font
->numeric
[XLFD_RESX
] = resx
;
5942 return build_font_name (font
);
5946 /* Value is non-zero if we are allowed to use scalable font FONT. We
5947 can't run a Lisp function here since this function may be called
5948 with input blocked. */
5951 may_use_scalable_font_p (font
)
5954 if (EQ (Vscalable_fonts_allowed
, Qt
))
5956 else if (CONSP (Vscalable_fonts_allowed
))
5958 Lisp_Object tail
, regexp
;
5960 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5962 regexp
= XCAR (tail
);
5963 if (STRINGP (regexp
)
5964 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5974 /* Return the name of the best matching font for face attributes ATTRS
5975 in the array of font_name structures FONTS which contains NFONTS
5976 elements. WIDTH_RATIO is a factor with which to multiply average
5977 widths if ATTRS specifies such a width.
5979 Value is a font name which is allocated from the heap. FONTS is
5980 freed by this function. */
5983 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5986 struct font_name
*fonts
;
5991 struct font_name
*best
;
5994 int exact_p
, avgwidth
;
5999 /* Make specified font attributes available in `specified',
6000 indexed by sort order. */
6001 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6003 int xlfd_idx
= font_sort_order
[i
];
6005 if (xlfd_idx
== XLFD_SWIDTH
)
6006 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6007 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6008 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6009 else if (xlfd_idx
== XLFD_WEIGHT
)
6010 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6011 else if (xlfd_idx
== XLFD_SLANT
)
6012 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6017 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6019 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6023 /* Start with the first non-scalable font in the list. */
6024 for (i
= 0; i
< nfonts
; ++i
)
6025 if (!font_scalable_p (fonts
+ i
))
6028 /* Find the best match among the non-scalable fonts. */
6033 for (i
= 1; i
< nfonts
; ++i
)
6034 if (!font_scalable_p (fonts
+ i
)
6035 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6039 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6048 /* Unless we found an exact match among non-scalable fonts, see if
6049 we can find a better match among scalable fonts. */
6052 /* A scalable font is better if
6054 1. its weight, slant, swidth attributes are better, or.
6056 2. the best non-scalable font doesn't have the required
6057 point size, and the scalable fonts weight, slant, swidth
6060 int non_scalable_has_exact_height_p
;
6062 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6063 non_scalable_has_exact_height_p
= 1;
6065 non_scalable_has_exact_height_p
= 0;
6067 for (i
= 0; i
< nfonts
; ++i
)
6068 if (font_scalable_p (fonts
+ i
))
6071 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6072 || (!non_scalable_has_exact_height_p
6073 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6078 if (font_scalable_p (best
))
6079 font_name
= build_scalable_font_name (f
, best
, pt
);
6081 font_name
= build_font_name (best
);
6083 /* Free font_name structures. */
6084 free_font_names (fonts
, nfonts
);
6090 /* Get a list of matching fonts on frame F, considering FAMILY
6091 and alternative font families from Vface_alternative_font_registry_alist.
6093 FAMILY is the font family whose alternatives are considered.
6095 REGISTRY, if a string, specifies a font registry and encoding to
6096 match. A value of nil means include fonts of any registry and
6099 Return in *FONTS a pointer to a vector of font_name structures for
6100 the fonts matched. Value is the number of fonts found. */
6103 try_alternative_families (f
, family
, registry
, fonts
)
6105 Lisp_Object family
, registry
;
6106 struct font_name
**fonts
;
6111 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6114 /* Try alternative font families. */
6115 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6118 for (alter
= XCDR (alter
);
6119 CONSP (alter
) && nfonts
== 0;
6120 alter
= XCDR (alter
))
6122 if (STRINGP (XCAR (alter
)))
6123 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6127 /* Try scalable fonts before giving up. */
6128 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
6130 int count
= BINDING_STACK_SIZE ();
6131 specbind (Qscalable_fonts_allowed
, Qt
);
6132 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6133 unbind_to (count
, Qnil
);
6140 /* Get a list of matching fonts on frame F.
6142 PATTERN, if a string, specifies a font name pattern to match while
6143 ignoring FAMILY and REGISTRY.
6145 FAMILY, if a list, specifies a list of font families to try.
6147 REGISTRY, if a list, specifies a list of font registries and
6150 Return in *FONTS a pointer to a vector of font_name structures for
6151 the fonts matched. Value is the number of fonts found. */
6154 try_font_list (f
, pattern
, family
, registry
, fonts
)
6156 Lisp_Object pattern
, family
, registry
;
6157 struct font_name
**fonts
;
6161 if (STRINGP (pattern
))
6162 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6168 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6170 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6171 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6173 /* Try font family of the default face or "fixed". */
6174 if (nfonts
== 0 && !NILP (family
))
6176 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6178 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6180 family
= build_string ("fixed");
6181 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6184 /* Try any family with the given registry. */
6185 if (nfonts
== 0 && !NILP (family
))
6186 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6193 /* Return the fontset id of the base fontset name or alias name given
6194 by the fontset attribute of ATTRS. Value is -1 if the fontset
6195 attribute of ATTRS doesn't name a fontset. */
6198 face_fontset (attrs
)
6204 name
= attrs
[LFACE_FONTSET_INDEX
];
6205 if (!STRINGP (name
))
6207 return fs_query_fontset (name
, 0);
6211 /* Choose a name of font to use on frame F to display characters with
6212 Lisp face attributes specified by ATTRS. The font name is
6213 determined by the font-related attributes in ATTRS and FONT-SPEC
6216 When we are choosing a font for ASCII characters, FONT-SPEC is
6217 always nil. Otherwise FONT-SPEC is a list
6218 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6219 or a string specifying a font name pattern.
6221 Value is the font name which is allocated from the heap and must be
6222 freed by the caller. */
6225 choose_face_font (f
, attrs
, font_spec
)
6228 Lisp_Object font_spec
;
6230 Lisp_Object pattern
, family
, adstyle
, registry
;
6231 char *font_name
= NULL
;
6232 struct font_name
*fonts
;
6235 /* If we are choosing an ASCII font and a font name is explicitly
6236 specified in ATTRS, return it. */
6238 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6239 return xstrdup (XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6242 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6245 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6247 if (VECTORP (font_spec
))
6250 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6251 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6252 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6253 registry
= AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
);
6255 else if (STRINGP (font_spec
))
6257 pattern
= font_spec
;
6266 registry
= build_string ("iso8859-1");
6269 /* Get a list of fonts matching that pattern and choose the
6270 best match for the specified face attributes from it. */
6271 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6272 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
));
6276 #endif /* HAVE_WINDOW_SYSTEM */
6280 /***********************************************************************
6282 ***********************************************************************/
6284 /* Realize basic faces on frame F. Value is zero if frame parameters
6285 of F don't contain enough information needed to realize the default
6289 realize_basic_faces (f
)
6293 int count
= BINDING_STACK_SIZE ();
6295 /* Block input here so that we won't be surprised by an X expose
6296 event, for instance, without having the faces set up. */
6298 specbind (Qscalable_fonts_allowed
, Qt
);
6300 if (realize_default_face (f
))
6302 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6303 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6304 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6305 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6306 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6307 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6308 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6309 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6310 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6311 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6313 /* Reflect changes in the `menu' face in menu bars. */
6314 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6316 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6317 #ifdef USE_X_TOOLKIT
6318 x_update_menu_appearance (f
);
6325 unbind_to (count
, Qnil
);
6331 /* Realize the default face on frame F. If the face is not fully
6332 specified, make it fully-specified. Attributes of the default face
6333 that are not explicitly specified are taken from frame parameters. */
6336 realize_default_face (f
)
6339 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6341 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6342 Lisp_Object frame_font
;
6345 /* If the `default' face is not yet known, create it. */
6346 lface
= lface_from_face_name (f
, Qdefault
, 0);
6350 XSETFRAME (frame
, f
);
6351 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6354 #ifdef HAVE_WINDOW_SYSTEM
6355 if (FRAME_WINDOW_P (f
))
6357 /* Set frame_font to the value of the `font' frame parameter. */
6358 frame_font
= Fassq (Qfont
, f
->param_alist
);
6359 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6360 frame_font
= XCDR (frame_font
);
6361 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6363 #endif /* HAVE_WINDOW_SYSTEM */
6365 if (!FRAME_WINDOW_P (f
))
6367 LFACE_FAMILY (lface
) = build_string ("default");
6368 LFACE_SWIDTH (lface
) = Qnormal
;
6369 LFACE_HEIGHT (lface
) = make_number (1);
6370 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6371 LFACE_WEIGHT (lface
) = Qnormal
;
6372 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6373 LFACE_SLANT (lface
) = Qnormal
;
6374 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6377 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6378 LFACE_UNDERLINE (lface
) = Qnil
;
6380 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6381 LFACE_OVERLINE (lface
) = Qnil
;
6383 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6384 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6386 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6387 LFACE_BOX (lface
) = Qnil
;
6389 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6390 LFACE_INVERSE (lface
) = Qnil
;
6392 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6394 /* This function is called so early that colors are not yet
6395 set in the frame parameter list. */
6396 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6398 if (CONSP (color
) && STRINGP (XCDR (color
)))
6399 LFACE_FOREGROUND (lface
) = XCDR (color
);
6400 else if (FRAME_WINDOW_P (f
))
6402 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6403 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6408 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6410 /* This function is called so early that colors are not yet
6411 set in the frame parameter list. */
6412 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6413 if (CONSP (color
) && STRINGP (XCDR (color
)))
6414 LFACE_BACKGROUND (lface
) = XCDR (color
);
6415 else if (FRAME_WINDOW_P (f
))
6417 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6418 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6423 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6424 LFACE_STIPPLE (lface
) = Qnil
;
6426 /* Realize the face; it must be fully-specified now. */
6427 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6428 check_lface (lface
);
6429 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6430 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6435 /* Realize basic faces other than the default face in face cache C.
6436 SYMBOL is the face name, ID is the face id the realized face must
6437 have. The default face must have been realized already. */
6440 realize_named_face (f
, symbol
, id
)
6445 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6446 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6447 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6448 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6449 struct face
*new_face
;
6451 /* The default face must exist and be fully specified. */
6452 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6453 check_lface_attrs (attrs
);
6454 xassert (lface_fully_specified_p (attrs
));
6456 /* If SYMBOL isn't know as a face, create it. */
6460 XSETFRAME (frame
, f
);
6461 lface
= Finternal_make_lisp_face (symbol
, frame
);
6464 /* Merge SYMBOL's face with the default face. */
6465 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6466 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6468 /* Realize the face. */
6469 new_face
= realize_face (c
, attrs
, id
);
6473 /* Realize the fully-specified face with attributes ATTRS in face
6474 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6475 non-negative, it is an ID of face to remove before caching the new
6476 face. Value is a pointer to the newly created realized face. */
6478 static struct face
*
6479 realize_face (cache
, attrs
, former_face_id
)
6480 struct face_cache
*cache
;
6486 /* LFACE must be fully specified. */
6487 xassert (cache
!= NULL
);
6488 check_lface_attrs (attrs
);
6490 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6492 /* Remove the former face. */
6493 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6494 uncache_face (cache
, former_face
);
6495 free_realized_face (cache
->f
, former_face
);
6498 if (FRAME_WINDOW_P (cache
->f
))
6499 face
= realize_x_face (cache
, attrs
);
6500 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6501 face
= realize_tty_face (cache
, attrs
);
6505 /* Insert the new face. */
6506 cache_face (cache
, face
, lface_hash (attrs
));
6511 /* Realize the fully-specified face that has the same attributes as
6512 BASE_FACE except for the font on frame F. If FONT_ID is not
6513 negative, it is an ID number of an already opened font that should
6514 be used by the face. If FONT_ID is negative, the face has no font,
6515 i.e., characters are displayed by empty boxes. */
6517 static struct face
*
6518 realize_non_ascii_face (f
, font_id
, base_face
)
6521 struct face
*base_face
;
6523 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6525 struct font_info
*font_info
;
6527 face
= (struct face
*) xmalloc (sizeof *face
);
6531 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6532 face
->colors_copied_bitwise_p
= 1;
6534 face
->font_info_id
= font_id
;
6537 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6538 face
->font
= font_info
->font
;
6539 face
->font_name
= font_info
->full_name
;
6544 face
->font_name
= NULL
;
6549 cache_face (cache
, face
, face
->hash
);
6555 /* Realize the fully-specified face with attributes ATTRS in face
6556 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6557 the new face doesn't share font with the default face, a fontname
6558 is allocated from the heap and set in `font_name' of the new face,
6559 but it is not yet loaded here. Value is a pointer to the newly
6560 created realized face. */
6562 static struct face
*
6563 realize_x_face (cache
, attrs
)
6564 struct face_cache
*cache
;
6567 #ifdef HAVE_WINDOW_SYSTEM
6568 struct face
*face
, *default_face
;
6570 Lisp_Object stipple
, overline
, strike_through
, box
;
6572 xassert (FRAME_WINDOW_P (cache
->f
));
6574 /* Allocate a new realized face. */
6575 face
= make_realized_face (attrs
);
6576 face
->ascii_face
= face
;
6580 /* Determine the font to use. Most of the time, the font will be
6581 the same as the font of the default face, so try that first. */
6582 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6584 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6586 face
->font
= default_face
->font
;
6587 face
->font_info_id
= default_face
->font_info_id
;
6588 face
->font_name
= default_face
->font_name
;
6590 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6594 /* If the face attribute ATTRS specifies a fontset, use it as
6595 the base of a new realized fontset. Otherwise, use the same
6596 base fontset as of the default face. The base determines
6597 registry and encoding of a font. It may also determine
6598 foundry and family. The other fields of font name pattern
6599 are constructed from ATTRS. */
6600 int fontset
= face_fontset (attrs
);
6602 /* If we are realizing the default face, ATTRS should specify a
6603 fontset. In other words, if FONTSET is -1, we are not
6604 realizing the default face, thus the default face should have
6605 already been realized. */
6607 fontset
= default_face
->fontset
;
6610 face
->font
= NULL
; /* to force realize_face to load font */
6613 /* Load the font if it is specified in ATTRS. This fixes
6614 changing frame font on the Mac. */
6615 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6617 struct font_info
*font_info
=
6618 FS_LOAD_FONT (f
, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6620 face
->font
= font_info
->font
;
6624 load_face_font (f
, face
);
6625 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6628 /* Load colors, and set remaining attributes. */
6630 load_face_colors (f
, face
, attrs
);
6633 box
= attrs
[LFACE_BOX_INDEX
];
6636 /* A simple box of line width 1 drawn in color given by
6638 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6640 face
->box
= FACE_SIMPLE_BOX
;
6641 face
->box_line_width
= 1;
6643 else if (INTEGERP (box
))
6645 /* Simple box of specified line width in foreground color of the
6647 xassert (XINT (box
) != 0);
6648 face
->box
= FACE_SIMPLE_BOX
;
6649 face
->box_line_width
= XINT (box
);
6650 face
->box_color
= face
->foreground
;
6651 face
->box_color_defaulted_p
= 1;
6653 else if (CONSP (box
))
6655 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6656 being one of `raised' or `sunken'. */
6657 face
->box
= FACE_SIMPLE_BOX
;
6658 face
->box_color
= face
->foreground
;
6659 face
->box_color_defaulted_p
= 1;
6660 face
->box_line_width
= 1;
6664 Lisp_Object keyword
, value
;
6666 keyword
= XCAR (box
);
6674 if (EQ (keyword
, QCline_width
))
6676 if (INTEGERP (value
) && XINT (value
) != 0)
6677 face
->box_line_width
= XINT (value
);
6679 else if (EQ (keyword
, QCcolor
))
6681 if (STRINGP (value
))
6683 face
->box_color
= load_color (f
, face
, value
,
6685 face
->use_box_color_for_shadows_p
= 1;
6688 else if (EQ (keyword
, QCstyle
))
6690 if (EQ (value
, Qreleased_button
))
6691 face
->box
= FACE_RAISED_BOX
;
6692 else if (EQ (value
, Qpressed_button
))
6693 face
->box
= FACE_SUNKEN_BOX
;
6698 /* Text underline, overline, strike-through. */
6700 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6702 /* Use default color (same as foreground color). */
6703 face
->underline_p
= 1;
6704 face
->underline_defaulted_p
= 1;
6705 face
->underline_color
= 0;
6707 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6709 /* Use specified color. */
6710 face
->underline_p
= 1;
6711 face
->underline_defaulted_p
= 0;
6712 face
->underline_color
6713 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6714 LFACE_UNDERLINE_INDEX
);
6716 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6718 face
->underline_p
= 0;
6719 face
->underline_defaulted_p
= 0;
6720 face
->underline_color
= 0;
6723 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6724 if (STRINGP (overline
))
6726 face
->overline_color
6727 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6728 LFACE_OVERLINE_INDEX
);
6729 face
->overline_p
= 1;
6731 else if (EQ (overline
, Qt
))
6733 face
->overline_color
= face
->foreground
;
6734 face
->overline_color_defaulted_p
= 1;
6735 face
->overline_p
= 1;
6738 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6739 if (STRINGP (strike_through
))
6741 face
->strike_through_color
6742 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6743 LFACE_STRIKE_THROUGH_INDEX
);
6744 face
->strike_through_p
= 1;
6746 else if (EQ (strike_through
, Qt
))
6748 face
->strike_through_color
= face
->foreground
;
6749 face
->strike_through_color_defaulted_p
= 1;
6750 face
->strike_through_p
= 1;
6753 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6754 if (!NILP (stipple
))
6755 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6757 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6759 #endif /* HAVE_WINDOW_SYSTEM */
6763 /* Map a specified color of face FACE on frame F to a tty color index.
6764 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6765 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6766 default foreground/background colors. */
6769 map_tty_color (f
, face
, idx
, defaulted
)
6772 enum lface_attribute_index idx
;
6775 Lisp_Object frame
, color
, def
;
6776 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6777 unsigned long default_pixel
, default_other_pixel
, pixel
;
6779 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6783 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6784 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6788 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6789 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6792 XSETFRAME (frame
, f
);
6793 color
= face
->lface
[idx
];
6796 && XSTRING (color
)->size
6797 && CONSP (Vtty_defined_color_alist
)
6798 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6801 /* Associations in tty-defined-color-alist are of the form
6802 (NAME INDEX R G B). We need the INDEX part. */
6803 pixel
= XINT (XCAR (XCDR (def
)));
6806 if (pixel
== default_pixel
&& STRINGP (color
))
6808 pixel
= load_color (f
, face
, color
, idx
);
6810 #if defined (MSDOS) || defined (WINDOWSNT)
6811 /* If the foreground of the default face is the default color,
6812 use the foreground color defined by the frame. */
6814 if (FRAME_MSDOS_P (f
))
6817 if (pixel
== default_pixel
6818 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6821 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6823 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6824 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6827 else if (pixel
== default_other_pixel
)
6830 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6832 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6833 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6839 #endif /* MSDOS or WINDOWSNT */
6843 face
->foreground
= pixel
;
6845 face
->background
= pixel
;
6849 /* Realize the fully-specified face with attributes ATTRS in face
6850 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6851 Value is a pointer to the newly created realized face. */
6853 static struct face
*
6854 realize_tty_face (cache
, attrs
)
6855 struct face_cache
*cache
;
6860 int face_colors_defaulted
= 0;
6861 struct frame
*f
= cache
->f
;
6863 /* Frame must be a termcap frame. */
6864 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6866 /* Allocate a new realized face. */
6867 face
= make_realized_face (attrs
);
6868 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6870 /* Map face attributes to TTY appearances. We map slant to
6871 dimmed text because we want italic text to appear differently
6872 and because dimmed text is probably used infrequently. */
6873 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6874 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6876 if (weight
> XLFD_WEIGHT_MEDIUM
)
6877 face
->tty_bold_p
= 1;
6878 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6879 face
->tty_dim_p
= 1;
6880 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6881 face
->tty_underline_p
= 1;
6882 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6883 face
->tty_reverse_p
= 1;
6885 /* Map color names to color indices. */
6886 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6887 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6889 /* Swap colors if face is inverse-video. If the colors are taken
6890 from the frame colors, they are already inverted, since the
6891 frame-creation function calls x-handle-reverse-video. */
6892 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6894 unsigned long tem
= face
->foreground
;
6895 face
->foreground
= face
->background
;
6896 face
->background
= tem
;
6899 if (tty_suppress_bold_inverse_default_colors_p
6901 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6902 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6903 face
->tty_bold_p
= 0;
6909 DEFUN ("tty-suppress-bold-inverse-default-colors",
6910 Ftty_suppress_bold_inverse_default_colors
,
6911 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6912 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6913 SUPPRESS non-nil means suppress it.
6914 This affects bold faces on TTYs whose foreground is the default background
6915 color of the display and whose background is the default foreground color.
6916 For such faces, the bold face attribute is ignored if this variable
6919 Lisp_Object suppress
;
6921 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6922 ++face_change_count
;
6928 /***********************************************************************
6930 ***********************************************************************/
6932 /* Return the ID of the face to use to display character CH with face
6933 property PROP on frame F in current_buffer. */
6936 compute_char_face (f
, ch
, prop
)
6943 if (NILP (current_buffer
->enable_multibyte_characters
))
6948 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6949 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6953 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6954 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6955 bcopy (face
->lface
, attrs
, sizeof attrs
);
6956 merge_face_vector_with_property (f
, attrs
, prop
);
6957 face_id
= lookup_face (f
, attrs
);
6958 if (! ASCII_CHAR_P (ch
))
6960 face
= FACE_FROM_ID (f
, face_id
);
6961 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6968 /* Return the face ID associated with buffer position POS for
6969 displaying ASCII characters. Return in *ENDPTR the position at
6970 which a different face is needed, as far as text properties and
6971 overlays are concerned. W is a window displaying current_buffer.
6973 REGION_BEG, REGION_END delimit the region, so it can be
6976 LIMIT is a position not to scan beyond. That is to limit the time
6977 this function can take.
6979 If MOUSE is non-zero, use the character's mouse-face, not its face.
6981 The face returned is suitable for displaying ASCII characters. */
6984 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6985 endptr
, limit
, mouse
)
6988 int region_beg
, region_end
;
6993 struct frame
*f
= XFRAME (w
->frame
);
6994 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6995 Lisp_Object prop
, position
;
6997 Lisp_Object
*overlay_vec
;
7000 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7001 Lisp_Object limit1
, end
;
7002 struct face
*default_face
;
7004 /* W must display the current buffer. We could write this function
7005 to use the frame and buffer of W, but right now it doesn't. */
7006 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7008 XSETFRAME (frame
, f
);
7009 XSETFASTINT (position
, pos
);
7012 if (pos
< region_beg
&& region_beg
< endpos
)
7013 endpos
= region_beg
;
7015 /* Get the `face' or `mouse_face' text property at POS, and
7016 determine the next position at which the property changes. */
7017 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7018 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7019 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7021 endpos
= XINT (end
);
7023 /* Look at properties from overlays. */
7028 /* First try with room for 40 overlays. */
7030 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7031 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7032 &next_overlay
, NULL
, 0);
7034 /* If there are more than 40, make enough space for all, and try
7036 if (noverlays
> len
)
7039 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7040 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7041 &next_overlay
, NULL
, 0);
7044 if (next_overlay
< endpos
)
7045 endpos
= next_overlay
;
7050 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7052 /* Optimize common cases where we can use the default face. */
7055 && !(pos
>= region_beg
&& pos
< region_end
))
7056 return DEFAULT_FACE_ID
;
7058 /* Begin with attributes from the default face. */
7059 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7061 /* Merge in attributes specified via text properties. */
7063 merge_face_vector_with_property (f
, attrs
, prop
);
7065 /* Now merge the overlay data. */
7066 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7067 for (i
= 0; i
< noverlays
; i
++)
7072 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7074 merge_face_vector_with_property (f
, attrs
, prop
);
7076 oend
= OVERLAY_END (overlay_vec
[i
]);
7077 oendpos
= OVERLAY_POSITION (oend
);
7078 if (oendpos
< endpos
)
7082 /* If in the region, merge in the region face. */
7083 if (pos
>= region_beg
&& pos
< region_end
)
7085 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7086 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7088 if (region_end
< endpos
)
7089 endpos
= region_end
;
7094 /* Look up a realized face with the given face attributes,
7095 or realize a new one for ASCII characters. */
7096 return lookup_face (f
, attrs
);
7100 /* Compute the face at character position POS in Lisp string STRING on
7101 window W, for ASCII characters.
7103 If STRING is an overlay string, it comes from position BUFPOS in
7104 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7105 not an overlay string. W must display the current buffer.
7106 REGION_BEG and REGION_END give the start and end positions of the
7107 region; both are -1 if no region is visible.
7109 BASE_FACE_ID is the id of a face to merge with. For strings coming
7110 from overlays or the `display' property it is the face at BUFPOS.
7112 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7114 Set *ENDPTR to the next position where to check for faces in
7115 STRING; -1 if the face is constant from POS to the end of the
7118 Value is the id of the face to use. The face returned is suitable
7119 for displaying ASCII characters. */
7122 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7123 region_end
, endptr
, base_face_id
, mouse_p
)
7127 int region_beg
, region_end
;
7129 enum face_id base_face_id
;
7132 Lisp_Object prop
, position
, end
, limit
;
7133 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7134 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7135 struct face
*base_face
;
7136 int multibyte_p
= STRING_MULTIBYTE (string
);
7137 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7139 /* Get the value of the face property at the current position within
7140 STRING. Value is nil if there is no face property. */
7141 XSETFASTINT (position
, pos
);
7142 prop
= Fget_text_property (position
, prop_name
, string
);
7144 /* Get the next position at which to check for faces. Value of end
7145 is nil if face is constant all the way to the end of the string.
7146 Otherwise it is a string position where to check faces next.
7147 Limit is the maximum position up to which to check for property
7148 changes in Fnext_single_property_change. Strings are usually
7149 short, so set the limit to the end of the string. */
7150 XSETFASTINT (limit
, XSTRING (string
)->size
);
7151 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7153 *endptr
= XFASTINT (end
);
7157 base_face
= FACE_FROM_ID (f
, base_face_id
);
7158 xassert (base_face
);
7160 /* Optimize the default case that there is no face property and we
7161 are not in the region. */
7163 && (base_face_id
!= DEFAULT_FACE_ID
7164 /* BUFPOS <= 0 means STRING is not an overlay string, so
7165 that the region doesn't have to be taken into account. */
7167 || bufpos
< region_beg
7168 || bufpos
>= region_end
)
7170 /* We can't realize faces for different charsets differently
7171 if we don't have fonts, so we can stop here if not working
7172 on a window-system frame. */
7173 || !FRAME_WINDOW_P (f
)
7174 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7175 return base_face
->id
;
7177 /* Begin with attributes from the base face. */
7178 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7180 /* Merge in attributes specified via text properties. */
7182 merge_face_vector_with_property (f
, attrs
, prop
);
7184 /* If in the region, merge in the region face. */
7186 && bufpos
>= region_beg
7187 && bufpos
< region_end
)
7189 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7190 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7193 /* Look up a realized face with the given face attributes,
7194 or realize a new one for ASCII characters. */
7195 return lookup_face (f
, attrs
);
7200 /***********************************************************************
7202 ***********************************************************************/
7206 /* Print the contents of the realized face FACE to stderr. */
7209 dump_realized_face (face
)
7212 fprintf (stderr
, "ID: %d\n", face
->id
);
7213 #ifdef HAVE_X_WINDOWS
7214 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7216 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7218 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7219 fprintf (stderr
, "background: 0x%lx (%s)\n",
7221 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7222 fprintf (stderr
, "font_name: %s (%s)\n",
7224 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7225 #ifdef HAVE_X_WINDOWS
7226 fprintf (stderr
, "font = %p\n", face
->font
);
7228 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7229 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7230 fprintf (stderr
, "underline: %d (%s)\n",
7232 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7233 fprintf (stderr
, "hash: %d\n", face
->hash
);
7237 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7245 fprintf (stderr
, "font selection order: ");
7246 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7247 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7248 fprintf (stderr
, "\n");
7250 fprintf (stderr
, "alternative fonts: ");
7251 debug_print (Vface_alternative_font_family_alist
);
7252 fprintf (stderr
, "\n");
7254 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7255 Fdump_face (make_number (i
));
7261 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7263 error ("Not a valid face");
7264 dump_realized_face (face
);
7271 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7272 0, 0, 0, doc
: /* */)
7275 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7276 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7277 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7281 #endif /* GLYPH_DEBUG != 0 */
7285 /***********************************************************************
7287 ***********************************************************************/
7292 Qface
= intern ("face");
7294 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7295 staticpro (&Qbitmap_spec_p
);
7296 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7297 staticpro (&Qframe_update_face_colors
);
7299 /* Lisp face attribute keywords. */
7300 QCfamily
= intern (":family");
7301 staticpro (&QCfamily
);
7302 QCheight
= intern (":height");
7303 staticpro (&QCheight
);
7304 QCweight
= intern (":weight");
7305 staticpro (&QCweight
);
7306 QCslant
= intern (":slant");
7307 staticpro (&QCslant
);
7308 QCunderline
= intern (":underline");
7309 staticpro (&QCunderline
);
7310 QCinverse_video
= intern (":inverse-video");
7311 staticpro (&QCinverse_video
);
7312 QCreverse_video
= intern (":reverse-video");
7313 staticpro (&QCreverse_video
);
7314 QCforeground
= intern (":foreground");
7315 staticpro (&QCforeground
);
7316 QCbackground
= intern (":background");
7317 staticpro (&QCbackground
);
7318 QCstipple
= intern (":stipple");;
7319 staticpro (&QCstipple
);
7320 QCwidth
= intern (":width");
7321 staticpro (&QCwidth
);
7322 QCfont
= intern (":font");
7323 staticpro (&QCfont
);
7324 QCfontset
= intern (":fontset");
7325 staticpro (&QCfontset
);
7326 QCbold
= intern (":bold");
7327 staticpro (&QCbold
);
7328 QCitalic
= intern (":italic");
7329 staticpro (&QCitalic
);
7330 QCoverline
= intern (":overline");
7331 staticpro (&QCoverline
);
7332 QCstrike_through
= intern (":strike-through");
7333 staticpro (&QCstrike_through
);
7334 QCbox
= intern (":box");
7336 QCinherit
= intern (":inherit");
7337 staticpro (&QCinherit
);
7339 /* Symbols used for Lisp face attribute values. */
7340 QCcolor
= intern (":color");
7341 staticpro (&QCcolor
);
7342 QCline_width
= intern (":line-width");
7343 staticpro (&QCline_width
);
7344 QCstyle
= intern (":style");
7345 staticpro (&QCstyle
);
7346 Qreleased_button
= intern ("released-button");
7347 staticpro (&Qreleased_button
);
7348 Qpressed_button
= intern ("pressed-button");
7349 staticpro (&Qpressed_button
);
7350 Qnormal
= intern ("normal");
7351 staticpro (&Qnormal
);
7352 Qultra_light
= intern ("ultra-light");
7353 staticpro (&Qultra_light
);
7354 Qextra_light
= intern ("extra-light");
7355 staticpro (&Qextra_light
);
7356 Qlight
= intern ("light");
7357 staticpro (&Qlight
);
7358 Qsemi_light
= intern ("semi-light");
7359 staticpro (&Qsemi_light
);
7360 Qsemi_bold
= intern ("semi-bold");
7361 staticpro (&Qsemi_bold
);
7362 Qbold
= intern ("bold");
7364 Qextra_bold
= intern ("extra-bold");
7365 staticpro (&Qextra_bold
);
7366 Qultra_bold
= intern ("ultra-bold");
7367 staticpro (&Qultra_bold
);
7368 Qoblique
= intern ("oblique");
7369 staticpro (&Qoblique
);
7370 Qitalic
= intern ("italic");
7371 staticpro (&Qitalic
);
7372 Qreverse_oblique
= intern ("reverse-oblique");
7373 staticpro (&Qreverse_oblique
);
7374 Qreverse_italic
= intern ("reverse-italic");
7375 staticpro (&Qreverse_italic
);
7376 Qultra_condensed
= intern ("ultra-condensed");
7377 staticpro (&Qultra_condensed
);
7378 Qextra_condensed
= intern ("extra-condensed");
7379 staticpro (&Qextra_condensed
);
7380 Qcondensed
= intern ("condensed");
7381 staticpro (&Qcondensed
);
7382 Qsemi_condensed
= intern ("semi-condensed");
7383 staticpro (&Qsemi_condensed
);
7384 Qsemi_expanded
= intern ("semi-expanded");
7385 staticpro (&Qsemi_expanded
);
7386 Qexpanded
= intern ("expanded");
7387 staticpro (&Qexpanded
);
7388 Qextra_expanded
= intern ("extra-expanded");
7389 staticpro (&Qextra_expanded
);
7390 Qultra_expanded
= intern ("ultra-expanded");
7391 staticpro (&Qultra_expanded
);
7392 Qbackground_color
= intern ("background-color");
7393 staticpro (&Qbackground_color
);
7394 Qforeground_color
= intern ("foreground-color");
7395 staticpro (&Qforeground_color
);
7396 Qunspecified
= intern ("unspecified");
7397 staticpro (&Qunspecified
);
7399 Qface_alias
= intern ("face-alias");
7400 staticpro (&Qface_alias
);
7401 Qdefault
= intern ("default");
7402 staticpro (&Qdefault
);
7403 Qtool_bar
= intern ("tool-bar");
7404 staticpro (&Qtool_bar
);
7405 Qregion
= intern ("region");
7406 staticpro (&Qregion
);
7407 Qfringe
= intern ("fringe");
7408 staticpro (&Qfringe
);
7409 Qheader_line
= intern ("header-line");
7410 staticpro (&Qheader_line
);
7411 Qscroll_bar
= intern ("scroll-bar");
7412 staticpro (&Qscroll_bar
);
7413 Qmenu
= intern ("menu");
7415 Qcursor
= intern ("cursor");
7416 staticpro (&Qcursor
);
7417 Qborder
= intern ("border");
7418 staticpro (&Qborder
);
7419 Qmouse
= intern ("mouse");
7420 staticpro (&Qmouse
);
7421 Qmode_line_inactive
= intern ("mode-line-inactive");
7422 staticpro (&Qmode_line_inactive
);
7423 Qtty_color_desc
= intern ("tty-color-desc");
7424 staticpro (&Qtty_color_desc
);
7425 Qtty_color_by_index
= intern ("tty-color-by-index");
7426 staticpro (&Qtty_color_by_index
);
7427 Qtty_color_alist
= intern ("tty-color-alist");
7428 staticpro (&Qtty_color_alist
);
7429 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7430 staticpro (&Qscalable_fonts_allowed
);
7432 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7433 staticpro (&Vparam_value_alist
);
7434 Vface_alternative_font_family_alist
= Qnil
;
7435 staticpro (&Vface_alternative_font_family_alist
);
7436 Vface_alternative_font_registry_alist
= Qnil
;
7437 staticpro (&Vface_alternative_font_registry_alist
);
7439 defsubr (&Sinternal_make_lisp_face
);
7440 defsubr (&Sinternal_lisp_face_p
);
7441 defsubr (&Sinternal_set_lisp_face_attribute
);
7442 #ifdef HAVE_WINDOW_SYSTEM
7443 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7445 defsubr (&Scolor_gray_p
);
7446 defsubr (&Scolor_supported_p
);
7447 defsubr (&Sface_attribute_relative_p
);
7448 defsubr (&Smerge_face_attribute
);
7449 defsubr (&Sinternal_get_lisp_face_attribute
);
7450 defsubr (&Sinternal_lisp_face_attribute_values
);
7451 defsubr (&Sinternal_lisp_face_equal_p
);
7452 defsubr (&Sinternal_lisp_face_empty_p
);
7453 defsubr (&Sinternal_copy_lisp_face
);
7454 defsubr (&Sinternal_merge_in_global_face
);
7455 defsubr (&Sface_font
);
7456 defsubr (&Sframe_face_alist
);
7457 defsubr (&Sinternal_set_font_selection_order
);
7458 defsubr (&Sinternal_set_alternative_font_family_alist
);
7459 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7460 defsubr (&Sface_attributes_as_vector
);
7462 defsubr (&Sdump_face
);
7463 defsubr (&Sshow_face_resources
);
7464 #endif /* GLYPH_DEBUG */
7465 defsubr (&Sclear_face_cache
);
7466 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7468 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7469 defsubr (&Sdump_colors
);
7472 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7473 doc
: /* *Limit for font matching.
7474 If an integer > 0, font matching functions won't load more than
7475 that number of fonts when searching for a matching font. */);
7476 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7478 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7479 doc
: /* List of global face definitions (for internal use only.) */);
7480 Vface_new_frame_defaults
= Qnil
;
7482 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7483 doc
: /* *Default stipple pattern used on monochrome displays.
7484 This stipple pattern is used on monochrome displays
7485 instead of shades of gray for a face background color.
7486 See `set-face-stipple' for possible values for this variable. */);
7487 Vface_default_stipple
= build_string ("gray3");
7489 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7490 doc
: /* An alist of defined terminal colors and their RGB values. */);
7491 Vtty_defined_color_alist
= Qnil
;
7493 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7494 doc
: /* Allowed scalable fonts.
7495 A value of nil means don't allow any scalable fonts.
7496 A value of t means allow any scalable font.
7497 Otherwise, value must be a list of regular expressions. A font may be
7498 scaled if its name matches a regular expression in the list.
7499 Note that if value is nil, a scalable font might still be used, if no
7500 other font of the appropriate family and registry is available. */);
7501 Vscalable_fonts_allowed
= Qnil
;
7503 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7504 doc
: /* List of ignored fonts.
7505 Each element is a regular expression that matches names of fonts to
7507 Vface_ignored_fonts
= Qnil
;
7509 #ifdef HAVE_WINDOW_SYSTEM
7510 defsubr (&Sbitmap_spec_p
);
7511 defsubr (&Sx_list_fonts
);
7512 defsubr (&Sinternal_face_x_get_resource
);
7513 defsubr (&Sx_family_fonts
);
7514 defsubr (&Sx_font_family_list
);
7515 #endif /* HAVE_WINDOW_SYSTEM */