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 /* Alist of font name patterns vs the resizing factor. */
418 Lisp_Object Vface_resizing_fonts
;
420 /* Maximum number of fonts to consider in font_list. If not an
421 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
423 Lisp_Object Vfont_list_limit
;
424 #define DEFAULT_FONT_LIST_LIMIT 100
426 /* The symbols `foreground-color' and `background-color' which can be
427 used as part of a `face' property. This is for compatibility with
430 Lisp_Object Qforeground_color
, Qbackground_color
;
432 /* The symbols `face' and `mouse-face' used as text properties. */
435 extern Lisp_Object Qmouse_face
;
437 /* Error symbol for wrong_type_argument in load_pixmap. */
439 Lisp_Object Qbitmap_spec_p
;
441 /* Alist of global face definitions. Each element is of the form
442 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
443 is a Lisp vector of face attributes. These faces are used
444 to initialize faces for new frames. */
446 Lisp_Object Vface_new_frame_defaults
;
448 /* The next ID to assign to Lisp faces. */
450 static int next_lface_id
;
452 /* A vector mapping Lisp face Id's to face names. */
454 static Lisp_Object
*lface_id_to_name
;
455 static int lface_id_to_name_size
;
457 /* TTY color-related functions (defined in tty-colors.el). */
459 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
461 /* The name of the function used to compute colors on TTYs. */
463 Lisp_Object Qtty_color_alist
;
465 /* An alist of defined terminal colors and their RGB values. */
467 Lisp_Object Vtty_defined_color_alist
;
469 /* Counter for calls to clear_face_cache. If this counter reaches
470 CLEAR_FONT_TABLE_COUNT, and a frame has more than
471 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
473 static int clear_font_table_count
;
474 #define CLEAR_FONT_TABLE_COUNT 100
475 #define CLEAR_FONT_TABLE_NFONTS 10
477 /* Non-zero means face attributes have been changed since the last
478 redisplay. Used in redisplay_internal. */
480 int face_change_count
;
482 /* Non-zero means don't display bold text if a face's foreground
483 and background colors are the inverse of the default colors of the
484 display. This is a kluge to suppress `bold black' foreground text
485 which is hard to read on an LCD monitor. */
487 int tty_suppress_bold_inverse_default_colors_p
;
489 /* A list of the form `((x . y))' used to avoid consing in
490 Finternal_set_lisp_face_attribute. */
492 static Lisp_Object Vparam_value_alist
;
494 /* The total number of colors currently allocated. */
497 static int ncolors_allocated
;
498 static int npixmaps_allocated
;
502 /* Non-zero means the definition of the `menu' face for new frames has
505 int menu_face_changed_default
;
508 /* Function prototypes. */
513 static void map_tty_color
P_ ((struct frame
*, struct face
*,
514 enum lface_attribute_index
, int *));
515 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
516 static int may_use_scalable_font_p
P_ ((char *));
517 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
518 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
520 static int x_face_list_fonts
P_ ((struct frame
*, char *,
521 struct font_name
*, int, int));
522 static int font_scalable_p
P_ ((struct font_name
*));
523 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
524 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
525 static unsigned char *xstrlwr
P_ ((unsigned char *));
526 static void signal_error
P_ ((char *, Lisp_Object
));
527 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
528 static void load_face_font
P_ ((struct frame
*, struct face
*));
529 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
530 static void free_face_colors
P_ ((struct frame
*, struct face
*));
531 static int face_color_gray_p
P_ ((struct frame
*, char *));
532 static char *build_font_name
P_ ((struct font_name
*));
533 static void free_font_names
P_ ((struct font_name
*, int));
534 static int sorted_font_list
P_ ((struct frame
*, char *,
535 int (*cmpfn
) P_ ((const void *, const void *)),
536 struct font_name
**));
537 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
538 Lisp_Object
, struct font_name
**));
539 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
540 Lisp_Object
, struct font_name
**));
541 static int try_font_list
P_ ((struct frame
*, Lisp_Object
,
542 Lisp_Object
, Lisp_Object
, struct font_name
**));
543 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
544 Lisp_Object
, struct font_name
**));
545 static int cmp_font_names
P_ ((const void *, const void *));
546 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*,
548 static struct face
*realize_non_ascii_face
P_ ((struct frame
*, int,
551 static struct face
*realize_x_face
P_ ((struct face_cache
*, Lisp_Object
*));
552 static struct face
*realize_tty_face
P_ ((struct face_cache
*, Lisp_Object
*));
553 static int realize_basic_faces
P_ ((struct frame
*));
554 static int realize_default_face
P_ ((struct frame
*));
555 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
556 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
557 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
558 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
559 static unsigned lface_hash
P_ ((Lisp_Object
*));
560 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
561 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
562 static void clear_face_gcs
P_ ((struct face_cache
*));
563 static void free_face_cache
P_ ((struct face_cache
*));
564 static int face_numeric_weight
P_ ((Lisp_Object
));
565 static int face_numeric_slant
P_ ((Lisp_Object
));
566 static int face_numeric_swidth
P_ ((Lisp_Object
));
567 static int face_fontset
P_ ((Lisp_Object
*));
568 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
569 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
570 Lisp_Object
*, Lisp_Object
));
571 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
573 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
574 Lisp_Object
, int, int));
575 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
576 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
577 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
578 struct font_name
*, int, int));
579 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
580 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
581 static int xlfd_numeric_slant
P_ ((struct font_name
*));
582 static int xlfd_numeric_weight
P_ ((struct font_name
*));
583 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
584 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
585 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
586 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
587 static int xlfd_fixed_p
P_ ((struct font_name
*));
588 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
590 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
591 struct font_name
*, int,
593 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
594 struct font_name
*, int));
596 #ifdef HAVE_WINDOW_SYSTEM
598 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
599 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
600 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
601 int (*cmpfn
) P_ ((const void *, const void *))));
602 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
603 static void x_free_gc
P_ ((struct frame
*, GC
));
604 static void clear_font_table
P_ ((struct x_display_info
*));
607 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
608 #endif /* WINDOWSNT */
611 static void x_update_menu_appearance
P_ ((struct frame
*));
613 extern void free_frame_menubar
P_ ((struct frame
*));
614 #endif /* USE_X_TOOLKIT */
616 #endif /* HAVE_WINDOW_SYSTEM */
619 /***********************************************************************
621 ***********************************************************************/
623 #ifdef HAVE_X_WINDOWS
625 #ifdef DEBUG_X_COLORS
627 /* The following is a poor mans infrastructure for debugging X color
628 allocation problems on displays with PseudoColor-8. Some X servers
629 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
630 color reference counts completely so that they don't signal an
631 error when a color is freed whose reference count is already 0.
632 Other X servers do. To help me debug this, the following code
633 implements a simple reference counting schema of its own, for a
634 single display/screen. --gerd. */
636 /* Reference counts for pixel colors. */
638 int color_count
[256];
640 /* Register color PIXEL as allocated. */
643 register_color (pixel
)
646 xassert (pixel
< 256);
647 ++color_count
[pixel
];
651 /* Register color PIXEL as deallocated. */
654 unregister_color (pixel
)
657 xassert (pixel
< 256);
658 if (color_count
[pixel
] > 0)
659 --color_count
[pixel
];
665 /* Register N colors from PIXELS as deallocated. */
668 unregister_colors (pixels
, n
)
669 unsigned long *pixels
;
673 for (i
= 0; i
< n
; ++i
)
674 unregister_color (pixels
[i
]);
678 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
679 doc
: /* Dump currently allocated colors to stderr. */)
684 fputc ('\n', stderr
);
686 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
689 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
692 fputc ('\n', stderr
);
694 fputc ('\t', stderr
);
698 fputc ('\n', stderr
);
702 #endif /* DEBUG_X_COLORS */
705 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
706 color values. Interrupt input must be blocked when this function
710 x_free_colors (f
, pixels
, npixels
)
712 unsigned long *pixels
;
715 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
717 /* If display has an immutable color map, freeing colors is not
718 necessary and some servers don't allow it. So don't do it. */
719 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
721 #ifdef DEBUG_X_COLORS
722 unregister_colors (pixels
, npixels
);
724 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
730 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
731 color values. Interrupt input must be blocked when this function
735 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
739 unsigned long *pixels
;
742 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
743 int class = dpyinfo
->visual
->class;
745 /* If display has an immutable color map, freeing colors is not
746 necessary and some servers don't allow it. So don't do it. */
747 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
749 #ifdef DEBUG_X_COLORS
750 unregister_colors (pixels
, npixels
);
752 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
757 /* Create and return a GC for use on frame F. GC values and mask
758 are given by XGCV and MASK. */
761 x_create_gc (f
, mask
, xgcv
)
768 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
775 /* Free GC which was used on frame F. */
783 xassert (--ngcs
>= 0);
784 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
788 #endif /* HAVE_X_WINDOWS */
791 /* W32 emulation of GCs */
794 x_create_gc (f
, mask
, xgcv
)
801 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
808 /* Free GC which was used on frame F. */
816 xassert (--ngcs
>= 0);
821 #endif /* WINDOWSNT */
823 /* Like stricmp. Used to compare parts of font names which are in
828 unsigned char *s1
, *s2
;
832 unsigned char c1
= tolower (*s1
);
833 unsigned char c2
= tolower (*s2
);
835 return c1
< c2
? -1 : 1;
840 return *s2
== 0 ? 0 : -1;
845 /* Like strlwr, which might not always be available. */
847 static unsigned char *
851 unsigned char *p
= s
;
860 /* Signal `error' with message S, and additional argument ARG. */
863 signal_error (s
, arg
)
867 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
871 /* If FRAME is nil, return a pointer to the selected frame.
872 Otherwise, check that FRAME is a live frame, and return a pointer
873 to it. NPARAM is the parameter number of FRAME, for
874 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
875 Lisp function definitions. */
877 static INLINE
struct frame
*
878 frame_or_selected_frame (frame
, nparam
)
883 frame
= selected_frame
;
885 CHECK_LIVE_FRAME (frame
);
886 return XFRAME (frame
);
890 /***********************************************************************
892 ***********************************************************************/
894 /* Initialize face cache and basic faces for frame F. */
900 /* Make a face cache, if F doesn't have one. */
901 if (FRAME_FACE_CACHE (f
) == NULL
)
902 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
904 #ifdef HAVE_WINDOW_SYSTEM
905 /* Make the image cache. */
906 if (FRAME_WINDOW_P (f
))
908 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
909 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
910 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
912 #endif /* HAVE_WINDOW_SYSTEM */
914 /* Realize basic faces. Must have enough information in frame
915 parameters to realize basic faces at this point. */
916 #ifdef HAVE_X_WINDOWS
917 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
920 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
922 if (!realize_basic_faces (f
))
927 /* Free face cache of frame F. Called from Fdelete_frame. */
933 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
937 free_face_cache (face_cache
);
938 FRAME_FACE_CACHE (f
) = NULL
;
941 #ifdef HAVE_WINDOW_SYSTEM
942 if (FRAME_WINDOW_P (f
))
944 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
947 --image_cache
->refcount
;
948 if (image_cache
->refcount
== 0)
949 free_image_cache (f
);
952 #endif /* HAVE_WINDOW_SYSTEM */
956 /* Clear face caches, and recompute basic faces for frame F. Call
957 this after changing frame parameters on which those faces depend,
958 or when realized faces have been freed due to changing attributes
962 recompute_basic_faces (f
)
965 if (FRAME_FACE_CACHE (f
))
967 clear_face_cache (0);
968 if (!realize_basic_faces (f
))
974 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
975 try to free unused fonts, too. */
978 clear_face_cache (clear_fonts_p
)
981 #ifdef HAVE_WINDOW_SYSTEM
982 Lisp_Object tail
, frame
;
986 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
988 struct x_display_info
*dpyinfo
;
990 /* Fonts are common for frames on one display, i.e. on
992 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
993 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
994 clear_font_table (dpyinfo
);
996 /* From time to time see if we can unload some fonts. This also
997 frees all realized faces on all frames. Fonts needed by
998 faces will be loaded again when faces are realized again. */
999 clear_font_table_count
= 0;
1001 FOR_EACH_FRAME (tail
, frame
)
1003 struct frame
*f
= XFRAME (frame
);
1004 if (FRAME_WINDOW_P (f
)
1005 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1006 free_all_realized_faces (frame
);
1011 /* Clear GCs of realized faces. */
1012 FOR_EACH_FRAME (tail
, frame
)
1015 if (FRAME_WINDOW_P (f
))
1017 clear_face_gcs (FRAME_FACE_CACHE (f
));
1018 clear_image_cache (f
, 0);
1022 #endif /* HAVE_WINDOW_SYSTEM */
1026 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1027 doc
: /* Clear face caches on all frames.
1028 Optional THOROUGHLY non-nil means try to free unused fonts, too. */)
1030 Lisp_Object thoroughly
;
1032 clear_face_cache (!NILP (thoroughly
));
1033 ++face_change_count
;
1034 ++windows_or_buffers_changed
;
1040 #ifdef HAVE_WINDOW_SYSTEM
1043 /* Remove fonts from the font table of DPYINFO except for the default
1044 ASCII fonts of frames on that display. Called from clear_face_cache
1045 from time to time. */
1048 clear_font_table (dpyinfo
)
1049 struct x_display_info
*dpyinfo
;
1053 /* Free those fonts that are not used by frames on DPYINFO. */
1054 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1056 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1057 Lisp_Object tail
, frame
;
1059 /* Check if slot is already free. */
1060 if (font_info
->name
== NULL
)
1063 /* Don't free a default font of some frame on this display. */
1064 FOR_EACH_FRAME (tail
, frame
)
1066 struct frame
*f
= XFRAME (frame
);
1067 if (FRAME_WINDOW_P (f
)
1068 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1069 && font_info
->font
== FRAME_FONT (f
))
1077 if (font_info
->full_name
!= font_info
->name
)
1078 xfree (font_info
->full_name
);
1079 xfree (font_info
->name
);
1081 /* Free the font. */
1083 #ifdef HAVE_X_WINDOWS
1084 XFreeFont (dpyinfo
->display
, font_info
->font
);
1087 w32_unload_font (dpyinfo
, font_info
->font
);
1091 /* Mark font table slot free. */
1092 font_info
->font
= NULL
;
1093 font_info
->name
= font_info
->full_name
= NULL
;
1097 #endif /* HAVE_WINDOW_SYSTEM */
1101 /***********************************************************************
1103 ***********************************************************************/
1105 #ifdef HAVE_WINDOW_SYSTEM
1107 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1108 doc
: /* Value is non-nil if OBJECT is a valid bitmap specification.
1109 A bitmap specification is either a string, a file name, or a list
1110 \(WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,
1111 HEIGHT is its height, and DATA is a string containing the bits of
1112 the pixmap. Bits are stored row by row, each row occupies
1113 \(WIDTH + 7)/8 bytes. */)
1119 if (STRINGP (object
))
1120 /* If OBJECT is a string, it's a file name. */
1122 else if (CONSP (object
))
1124 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1125 HEIGHT must be integers > 0, and DATA must be string large
1126 enough to hold a bitmap of the specified size. */
1127 Lisp_Object width
, height
, data
;
1129 height
= width
= data
= Qnil
;
1133 width
= XCAR (object
);
1134 object
= XCDR (object
);
1137 height
= XCAR (object
);
1138 object
= XCDR (object
);
1140 data
= XCAR (object
);
1144 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1146 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1148 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1153 return pixmap_p
? Qt
: Qnil
;
1157 /* Load a bitmap according to NAME (which is either a file name or a
1158 pixmap spec) for use on frame F. Value is the bitmap_id (see
1159 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1160 bitmap cannot be loaded, display a message saying so, and return
1161 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1162 if these pointers are not null. */
1165 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1168 unsigned int *w_ptr
, *h_ptr
;
1176 tem
= Fbitmap_spec_p (name
);
1178 wrong_type_argument (Qbitmap_spec_p
, name
);
1183 /* Decode a bitmap spec into a bitmap. */
1188 w
= XINT (Fcar (name
));
1189 h
= XINT (Fcar (Fcdr (name
)));
1190 bits
= Fcar (Fcdr (Fcdr (name
)));
1192 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1197 /* It must be a string -- a file name. */
1198 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1204 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1215 ++npixmaps_allocated
;
1218 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1221 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1227 #endif /* HAVE_WINDOW_SYSTEM */
1231 /***********************************************************************
1233 ***********************************************************************/
1235 #ifdef HAVE_WINDOW_SYSTEM
1237 /* Update the line_height of frame F. Return non-zero if line height
1241 frame_update_line_height (f
)
1244 int line_height
, changed_p
;
1246 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1247 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1248 FRAME_LINE_HEIGHT (f
) = line_height
;
1252 #endif /* HAVE_WINDOW_SYSTEM */
1255 /***********************************************************************
1257 ***********************************************************************/
1259 #ifdef HAVE_WINDOW_SYSTEM
1261 /* Load font of face FACE which is used on frame F to display ASCII
1262 characters. The name of the font to load is determined by lface. */
1265 load_face_font (f
, face
)
1269 struct font_info
*font_info
= NULL
;
1272 face
->font_info_id
= -1;
1274 face
->font_name
= NULL
;
1276 font_name
= choose_face_font (f
, face
->lface
, Qnil
);
1282 font_info
= FS_LOAD_FONT (f
, font_name
);
1287 face
->font_info_id
= font_info
->font_idx
;
1288 face
->font
= font_info
->font
;
1289 face
->font_name
= font_info
->full_name
;
1292 x_free_gc (f
, face
->gc
);
1297 add_to_log ("Unable to load font %s",
1298 build_string (font_name
), Qnil
);
1302 #endif /* HAVE_WINDOW_SYSTEM */
1306 /***********************************************************************
1308 ***********************************************************************/
1310 /* A version of defined_color for non-X frames. */
1313 tty_defined_color (f
, color_name
, color_def
, alloc
)
1319 Lisp_Object color_desc
;
1320 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1321 unsigned long red
= 0, green
= 0, blue
= 0;
1324 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1328 XSETFRAME (frame
, f
);
1330 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1331 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1333 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1334 if (CONSP (XCDR (XCDR (color_desc
))))
1336 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1337 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1338 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1342 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1343 /* We were called early during startup, and the colors are not
1344 yet set up in tty-defined-color-alist. Don't return a failure
1345 indication, since this produces the annoying "Unable to
1346 load color" messages in the *Messages* buffer. */
1349 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1351 if (strcmp (color_name
, "unspecified-fg") == 0)
1352 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1353 else if (strcmp (color_name
, "unspecified-bg") == 0)
1354 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1357 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1360 color_def
->pixel
= color_idx
;
1361 color_def
->red
= red
;
1362 color_def
->green
= green
;
1363 color_def
->blue
= blue
;
1369 /* Decide if color named COLOR_NAME is valid for the display
1370 associated with the frame F; if so, return the rgb values in
1371 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1373 This does the right thing for any type of frame. */
1376 defined_color (f
, color_name
, color_def
, alloc
)
1382 if (!FRAME_WINDOW_P (f
))
1383 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1384 #ifdef HAVE_X_WINDOWS
1385 else if (FRAME_X_P (f
))
1386 return x_defined_color (f
, color_name
, color_def
, alloc
);
1389 else if (FRAME_W32_P (f
))
1390 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1393 else if (FRAME_MAC_P (f
))
1394 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1401 /* Given the index IDX of a tty color on frame F, return its name, a
1405 tty_color_name (f
, idx
)
1409 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1412 Lisp_Object coldesc
;
1414 XSETFRAME (frame
, f
);
1415 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1417 if (!NILP (coldesc
))
1418 return XCAR (coldesc
);
1421 /* We can have an MSDOG frame under -nw for a short window of
1422 opportunity before internal_terminal_init is called. DTRT. */
1423 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1424 return msdos_stdcolor_name (idx
);
1427 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1428 return build_string (unspecified_fg
);
1429 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1430 return build_string (unspecified_bg
);
1433 return vga_stdcolor_name (idx
);
1436 return Qunspecified
;
1440 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1441 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1444 face_color_gray_p (f
, color_name
)
1451 if (defined_color (f
, color_name
, &color
, 0))
1452 gray_p
= ((abs (color
.red
- color
.green
)
1453 < max (color
.red
, color
.green
) / 20)
1454 && (abs (color
.green
- color
.blue
)
1455 < max (color
.green
, color
.blue
) / 20)
1456 && (abs (color
.blue
- color
.red
)
1457 < max (color
.blue
, color
.red
) / 20));
1465 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1466 BACKGROUND_P non-zero means the color will be used as background
1470 face_color_supported_p (f
, color_name
, background_p
)
1478 XSETFRAME (frame
, f
);
1479 return (FRAME_WINDOW_P (f
)
1480 ? (!NILP (Fxw_display_color_p (frame
))
1481 || xstricmp (color_name
, "black") == 0
1482 || xstricmp (color_name
, "white") == 0
1484 && face_color_gray_p (f
, color_name
))
1485 || (!NILP (Fx_display_grayscale_p (frame
))
1486 && face_color_gray_p (f
, color_name
)))
1487 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1491 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1492 doc
: /* Return non-nil if COLOR is a shade of gray (or white or black).
1493 FRAME specifies the frame and thus the display for interpreting COLOR.
1494 If FRAME is nil or omitted, use the selected frame. */)
1496 Lisp_Object color
, frame
;
1500 CHECK_FRAME (frame
);
1501 CHECK_STRING (color
);
1503 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1507 DEFUN ("color-supported-p", Fcolor_supported_p
,
1508 Scolor_supported_p
, 2, 3, 0,
1509 doc
: /* Return non-nil if COLOR can be displayed on FRAME.
1510 BACKGROUND-P non-nil means COLOR is used as a background.
1511 If FRAME is nil or omitted, use the selected frame.
1512 COLOR must be a valid color name. */)
1513 (color
, frame
, background_p
)
1514 Lisp_Object frame
, color
, background_p
;
1518 CHECK_FRAME (frame
);
1519 CHECK_STRING (color
);
1521 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1527 /* Load color with name NAME for use by face FACE on frame F.
1528 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1529 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1530 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1531 pixel color. If color cannot be loaded, display a message, and
1532 return the foreground, background or underline color of F, but
1533 record that fact in flags of the face so that we don't try to free
1537 load_color (f
, face
, name
, target_index
)
1541 enum lface_attribute_index target_index
;
1545 xassert (STRINGP (name
));
1546 xassert (target_index
== LFACE_FOREGROUND_INDEX
1547 || target_index
== LFACE_BACKGROUND_INDEX
1548 || target_index
== LFACE_UNDERLINE_INDEX
1549 || target_index
== LFACE_OVERLINE_INDEX
1550 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1551 || target_index
== LFACE_BOX_INDEX
);
1553 /* if the color map is full, defined_color will return a best match
1554 to the values in an existing cell. */
1555 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1557 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1559 switch (target_index
)
1561 case LFACE_FOREGROUND_INDEX
:
1562 face
->foreground_defaulted_p
= 1;
1563 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1566 case LFACE_BACKGROUND_INDEX
:
1567 face
->background_defaulted_p
= 1;
1568 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1571 case LFACE_UNDERLINE_INDEX
:
1572 face
->underline_defaulted_p
= 1;
1573 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1576 case LFACE_OVERLINE_INDEX
:
1577 face
->overline_color_defaulted_p
= 1;
1578 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1581 case LFACE_STRIKE_THROUGH_INDEX
:
1582 face
->strike_through_color_defaulted_p
= 1;
1583 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1586 case LFACE_BOX_INDEX
:
1587 face
->box_color_defaulted_p
= 1;
1588 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1597 ++ncolors_allocated
;
1604 #ifdef HAVE_WINDOW_SYSTEM
1606 /* Load colors for face FACE which is used on frame F. Colors are
1607 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1608 of ATTRS. If the background color specified is not supported on F,
1609 try to emulate gray colors with a stipple from Vface_default_stipple. */
1612 load_face_colors (f
, face
, attrs
)
1619 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1620 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1622 /* Swap colors if face is inverse-video. */
1623 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1631 /* Check for support for foreground, not for background because
1632 face_color_supported_p is smart enough to know that grays are
1633 "supported" as background because we are supposed to use stipple
1635 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1636 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1638 x_destroy_bitmap (f
, face
->stipple
);
1639 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1640 &face
->pixmap_w
, &face
->pixmap_h
);
1643 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1644 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1648 /* Free color PIXEL on frame F. */
1651 unload_color (f
, pixel
)
1653 unsigned long pixel
;
1655 #ifdef HAVE_X_WINDOWS
1659 x_free_colors (f
, &pixel
, 1);
1666 /* Free colors allocated for FACE. */
1669 free_face_colors (f
, face
)
1673 #ifdef HAVE_X_WINDOWS
1674 if (face
->colors_copied_bitwise_p
)
1679 if (!face
->foreground_defaulted_p
)
1681 x_free_colors (f
, &face
->foreground
, 1);
1682 IF_DEBUG (--ncolors_allocated
);
1685 if (!face
->background_defaulted_p
)
1687 x_free_colors (f
, &face
->background
, 1);
1688 IF_DEBUG (--ncolors_allocated
);
1691 if (face
->underline_p
1692 && !face
->underline_defaulted_p
)
1694 x_free_colors (f
, &face
->underline_color
, 1);
1695 IF_DEBUG (--ncolors_allocated
);
1698 if (face
->overline_p
1699 && !face
->overline_color_defaulted_p
)
1701 x_free_colors (f
, &face
->overline_color
, 1);
1702 IF_DEBUG (--ncolors_allocated
);
1705 if (face
->strike_through_p
1706 && !face
->strike_through_color_defaulted_p
)
1708 x_free_colors (f
, &face
->strike_through_color
, 1);
1709 IF_DEBUG (--ncolors_allocated
);
1712 if (face
->box
!= FACE_NO_BOX
1713 && !face
->box_color_defaulted_p
)
1715 x_free_colors (f
, &face
->box_color
, 1);
1716 IF_DEBUG (--ncolors_allocated
);
1720 #endif /* HAVE_X_WINDOWS */
1723 #endif /* HAVE_WINDOW_SYSTEM */
1727 /***********************************************************************
1729 ***********************************************************************/
1731 /* An enumerator for each field of an XLFD font name. */
1752 /* An enumerator for each possible slant value of a font. Taken from
1753 the XLFD specification. */
1761 XLFD_SLANT_REVERSE_ITALIC
,
1762 XLFD_SLANT_REVERSE_OBLIQUE
,
1766 /* Relative font weight according to XLFD documentation. */
1770 XLFD_WEIGHT_UNKNOWN
,
1771 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1772 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1773 XLFD_WEIGHT_LIGHT
, /* 30 */
1774 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1775 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1776 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1777 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1778 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1779 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1782 /* Relative proportionate width. */
1786 XLFD_SWIDTH_UNKNOWN
,
1787 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1788 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1789 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1790 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1791 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1792 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1793 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1794 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1795 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1798 /* Structure used for tables mapping XLFD weight, slant, and width
1799 names to numeric and symbolic values. */
1805 Lisp_Object
*symbol
;
1808 /* Table of XLFD slant names and their numeric and symbolic
1809 representations. This table must be sorted by slant names in
1812 static struct table_entry slant_table
[] =
1814 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1815 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1816 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1817 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1818 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1819 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1822 /* Table of XLFD weight names. This table must be sorted by weight
1823 names in ascending order. */
1825 static struct table_entry weight_table
[] =
1827 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1828 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1829 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1830 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1831 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1832 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1833 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1834 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1835 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1836 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1837 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1838 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1839 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1840 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1841 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1842 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1845 /* Table of XLFD width names. This table must be sorted by width
1846 names in ascending order. */
1848 static struct table_entry swidth_table
[] =
1850 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1851 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1852 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1853 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1854 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1855 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1856 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1857 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1858 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1859 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1860 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1861 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1862 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1863 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1864 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1867 /* Structure used to hold the result of splitting font names in XLFD
1868 format into their fields. */
1872 /* The original name which is modified destructively by
1873 split_font_name. The pointer is kept here to be able to free it
1874 if it was allocated from the heap. */
1877 /* Font name fields. Each vector element points into `name' above.
1878 Fields are NUL-terminated. */
1879 char *fields
[XLFD_LAST
];
1881 /* Numeric values for those fields that interest us. See
1882 split_font_name for which these are. */
1883 int numeric
[XLFD_LAST
];
1885 /* If the original name matches one of Vface_resizing_fonts, the
1886 value is the corresponding resizing ratio. Otherwise, the value
1888 double resizing_ratio
;
1890 /* Lower value mean higher priority. */
1891 int registry_priority
;
1894 /* The frame in effect when sorting font names. Set temporarily in
1895 sort_fonts so that it is available in font comparison functions. */
1897 static struct frame
*font_frame
;
1899 /* Order by which font selection chooses fonts. The default values
1900 mean `first, find a best match for the font width, then for the
1901 font height, then for weight, then for slant.' This variable can be
1902 set via set-face-font-sort-order. */
1905 static int font_sort_order
[4] = {
1906 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1909 static int font_sort_order
[4];
1912 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1913 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1914 is a pointer to the matching table entry or null if no table entry
1917 static struct table_entry
*
1918 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1919 struct table_entry
*table
;
1921 struct font_name
*font
;
1924 /* Function split_font_name converts fields to lower-case, so there
1925 is no need to use xstrlwr or xstricmp here. */
1926 char *s
= font
->fields
[field_index
];
1927 int low
, mid
, high
, cmp
;
1934 mid
= (low
+ high
) / 2;
1935 cmp
= strcmp (table
[mid
].name
, s
);
1949 /* Return a numeric representation for font name field
1950 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1951 has DIM entries. Value is the numeric value found or DFLT if no
1952 table entry matches. This function is used to translate weight,
1953 slant, and swidth names of XLFD font names to numeric values. */
1956 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1957 struct table_entry
*table
;
1959 struct font_name
*font
;
1963 struct table_entry
*p
;
1964 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1965 return p
? p
->numeric
: dflt
;
1969 /* Return a symbolic representation for font name field
1970 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1971 has DIM entries. Value is the symbolic value found or DFLT if no
1972 table entry matches. This function is used to translate weight,
1973 slant, and swidth names of XLFD font names to symbols. */
1975 static INLINE Lisp_Object
1976 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1977 struct table_entry
*table
;
1979 struct font_name
*font
;
1983 struct table_entry
*p
;
1984 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1985 return p
? *p
->symbol
: dflt
;
1989 /* Return a numeric value for the slant of the font given by FONT. */
1992 xlfd_numeric_slant (font
)
1993 struct font_name
*font
;
1995 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1996 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
2000 /* Return a symbol representing the weight of the font given by FONT. */
2002 static INLINE Lisp_Object
2003 xlfd_symbolic_slant (font
)
2004 struct font_name
*font
;
2006 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
2007 font
, XLFD_SLANT
, Qnormal
);
2011 /* Return a numeric value for the weight of the font given by FONT. */
2014 xlfd_numeric_weight (font
)
2015 struct font_name
*font
;
2017 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2018 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2022 /* Return a symbol representing the slant of the font given by FONT. */
2024 static INLINE Lisp_Object
2025 xlfd_symbolic_weight (font
)
2026 struct font_name
*font
;
2028 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2029 font
, XLFD_WEIGHT
, Qnormal
);
2033 /* Return a numeric value for the swidth of the font whose XLFD font
2034 name fields are found in FONT. */
2037 xlfd_numeric_swidth (font
)
2038 struct font_name
*font
;
2040 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2041 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2045 /* Return a symbolic value for the swidth of FONT. */
2047 static INLINE Lisp_Object
2048 xlfd_symbolic_swidth (font
)
2049 struct font_name
*font
;
2051 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2052 font
, XLFD_SWIDTH
, Qnormal
);
2056 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2057 entries. Value is a pointer to the matching table entry or null if
2058 no element of TABLE contains SYMBOL. */
2060 static struct table_entry
*
2061 face_value (table
, dim
, symbol
)
2062 struct table_entry
*table
;
2068 xassert (SYMBOLP (symbol
));
2070 for (i
= 0; i
< dim
; ++i
)
2071 if (EQ (*table
[i
].symbol
, symbol
))
2074 return i
< dim
? table
+ i
: NULL
;
2078 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2079 entries. Value is -1 if SYMBOL is not found in TABLE. */
2082 face_numeric_value (table
, dim
, symbol
)
2083 struct table_entry
*table
;
2087 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2088 return p
? p
->numeric
: -1;
2092 /* Return a numeric value representing the weight specified by Lisp
2093 symbol WEIGHT. Value is one of the enumerators of enum
2097 face_numeric_weight (weight
)
2100 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2104 /* Return a numeric value representing the slant specified by Lisp
2105 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2108 face_numeric_slant (slant
)
2111 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2115 /* Return a numeric value representing the swidth specified by Lisp
2116 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2119 face_numeric_swidth (width
)
2122 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2126 /* Return an ASCII font name generated from fontset name NAME and
2127 ASCII font specification ASCII_SPEC. NAME is a string conforming
2128 to XLFD. ASCII_SPEC is a vector:
2129 [FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY]. */
2132 generate_ascii_font_name (name
, ascii_spec
)
2133 Lisp_Object name
, ascii_spec
;
2135 struct font_name font
;
2138 font
.name
= LSTRDUPA (name
);
2139 if (! split_font_name (NULL
, &font
, 0))
2142 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
)))
2144 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_FAMILY_INDEX
));
2145 font
.fields
[XLFD_FOUNDRY
] = p
;
2146 while (*p
!= '-') p
++;
2150 font
.fields
[XLFD_FAMILY
] = p
;
2154 font
.fields
[XLFD_FAMILY
] = font
.fields
[XLFD_FOUNDRY
];
2155 font
.fields
[XLFD_FOUNDRY
] = "*";
2158 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
)))
2159 font
.fields
[XLFD_WEIGHT
]
2160 = XSTRING (AREF (ascii_spec
, FONT_SPEC_WEIGHT_INDEX
))->data
;
2161 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
)))
2162 font
.fields
[XLFD_SLANT
]
2163 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SLANT_INDEX
))->data
;
2164 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
)))
2165 font
.fields
[XLFD_SWIDTH
]
2166 = XSTRING (AREF (ascii_spec
, FONT_SPEC_SWIDTH_INDEX
))->data
;
2167 if (STRINGP (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
)))
2168 font
.fields
[XLFD_ADSTYLE
]
2169 = XSTRING (AREF (ascii_spec
, FONT_SPEC_ADSTYLE_INDEX
))->data
;
2170 p
= LSTRDUPA (AREF (ascii_spec
, FONT_SPEC_REGISTRY_INDEX
));
2171 font
.fields
[XLFD_REGISTRY
] = p
;
2172 while (*p
!= '-') p
++;
2177 font
.fields
[XLFD_ENCODING
] = p
;
2179 p
= build_font_name (&font
);
2180 name
= build_string (p
);
2187 font_name_registry (fontname
)
2188 Lisp_Object fontname
;
2190 struct font_name font
;
2192 font
.name
= LSTRDUPA (fontname
);
2193 if (! split_font_name (NULL
, &font
, 0))
2195 font
.fields
[XLFD_ENCODING
][-1] = '-';
2196 return build_string (font
.fields
[XLFD_REGISTRY
]);
2199 #ifdef HAVE_WINDOW_SYSTEM
2201 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2205 struct font_name
*font
;
2207 /* Function split_font_name converts fields to lower-case, so there
2208 is no need to use tolower here. */
2209 return *font
->fields
[XLFD_SPACING
] != 'p';
2213 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2215 The actual height of the font when displayed on F depends on the
2216 resolution of both the font and frame. For example, a 10pt font
2217 designed for a 100dpi display will display larger than 10pt on a
2218 75dpi display. (It's not unusual to use fonts not designed for the
2219 display one is using. For example, some intlfonts are available in
2220 72dpi versions, only.)
2222 Value is the real point size of FONT on frame F, or 0 if it cannot
2226 xlfd_point_size (f
, font
)
2228 struct font_name
*font
;
2230 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2231 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2235 if (*pixel_field
== '[')
2237 /* The pixel size field is `[A B C D]' which specifies
2238 a transformation matrix.
2244 by which all glyphs of the font are transformed. The spec
2245 says that s scalar value N for the pixel size is equivalent
2246 to A = N * resx/resy, B = C = 0, D = N. */
2247 char *start
= pixel_field
+ 1, *end
;
2251 for (i
= 0; i
< 4; ++i
)
2253 matrix
[i
] = strtod (start
, &end
);
2260 pixel
= atoi (pixel_field
);
2265 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2271 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2272 of frame F. This function is used to guess a point size of font
2273 when only the pixel height of the font is available. */
2276 pixel_point_size (f
, pixel
)
2280 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2284 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2285 point size of one dot. */
2286 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2287 int_pt
= real_pt
+ 0.5;
2293 /* Return a resizing ratio of a font of NAME. */
2295 static INLINE
double
2296 font_resizing_ratio (char *name
)
2298 Lisp_Object tail
, elt
;
2300 if (CONSP (Vface_resizing_fonts
))
2302 for (tail
= Vface_resizing_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2305 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2306 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2307 return XFLOAT_DATA (XCDR (elt
));
2314 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2315 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2316 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2317 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2318 zero if the font name doesn't have the format we expect. The
2319 expected format is a font name that starts with a `-' and has
2320 XLFD_LAST fields separated by `-'. */
2323 split_font_name (f
, font
, numeric_p
)
2325 struct font_name
*font
;
2330 double resizing_ratio
= 1.0;
2332 if (numeric_p
&& CONSP (Vface_resizing_fonts
))
2333 resizing_ratio
= font_resizing_ratio (font
->name
);
2335 if (*font
->name
== '-')
2337 char *p
= xstrlwr (font
->name
) + 1;
2339 while (i
< XLFD_LAST
)
2341 font
->fields
[i
] = p
;
2344 /* Pixel and point size may be of the form `[....]'. For
2345 BNF, see XLFD spec, chapter 4. Negative values are
2346 indicated by tilde characters which we replace with
2347 `-' characters, here. */
2349 && (i
- 1 == XLFD_PIXEL_SIZE
2350 || i
- 1 == XLFD_POINT_SIZE
))
2355 for (++p
; *p
&& *p
!= ']'; ++p
)
2359 /* Check that the matrix contains 4 floating point
2361 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2364 if (strtod (start
, &end
) == 0 && start
== end
)
2371 while (*p
&& *p
!= '-')
2381 success_p
= i
== XLFD_LAST
;
2383 /* If requested, and font name was in the expected format,
2384 compute numeric values for some fields. */
2385 if (numeric_p
&& success_p
)
2387 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2388 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2389 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2390 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2391 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2392 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2393 font
->resizing_ratio
= resizing_ratio
;
2396 /* Initialize it to zero. It will be overridden by font_list while
2397 trying alternate registries. */
2398 font
->registry_priority
= 0;
2404 /* Build an XLFD font name from font name fields in FONT. Value is a
2405 pointer to the font name, which is allocated via xmalloc. */
2408 build_font_name (font
)
2409 struct font_name
*font
;
2413 char *font_name
= (char *) xmalloc (size
);
2414 int total_length
= 0;
2416 for (i
= 0; i
< XLFD_LAST
; ++i
)
2418 /* Add 1 because of the leading `-'. */
2419 int len
= strlen (font
->fields
[i
]) + 1;
2421 /* Reallocate font_name if necessary. Add 1 for the final
2423 if (total_length
+ len
+ 1 >= size
)
2425 int new_size
= max (2 * size
, size
+ len
+ 1);
2426 int sz
= new_size
* sizeof *font_name
;
2427 font_name
= (char *) xrealloc (font_name
, sz
);
2431 font_name
[total_length
] = '-';
2432 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2433 total_length
+= len
;
2436 font_name
[total_length
] = 0;
2441 /* Free an array FONTS of N font_name structures. This frees FONTS
2442 itself and all `name' fields in its elements. */
2445 free_font_names (fonts
, n
)
2446 struct font_name
*fonts
;
2450 xfree (fonts
[--n
].name
);
2455 /* Sort vector FONTS of font_name structures which contains NFONTS
2456 elements using qsort and comparison function CMPFN. F is the frame
2457 on which the fonts will be used. The global variable font_frame
2458 is temporarily set to F to make it available in CMPFN. */
2461 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2463 struct font_name
*fonts
;
2465 int (*cmpfn
) P_ ((const void *, const void *));
2468 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2473 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2474 display in x_display_list. FONTS is a pointer to a vector of
2475 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2476 alternative patterns from Valternate_fontname_alist if no fonts are
2477 found matching PATTERN.
2479 For all fonts found, set FONTS[i].name to the name of the font,
2480 allocated via xmalloc, and split font names into fields. Ignore
2481 fonts that we can't parse. Value is the number of fonts found. */
2484 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2487 struct font_name
*fonts
;
2488 int nfonts
, try_alternatives_p
;
2492 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2493 better to do it the other way around. */
2495 Lisp_Object lpattern
, tem
;
2497 lpattern
= build_string (pattern
);
2499 /* Get the list of fonts matching PATTERN. */
2502 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2505 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2508 /* Make a copy of the font names we got from X, and
2509 split them into fields. */
2511 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2513 Lisp_Object elt
, tail
;
2514 char *name
= XSTRING (XCAR (tem
))->data
;
2516 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2517 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2521 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2530 /* Make a copy of the font name. */
2531 fonts
[n
].name
= xstrdup (name
);
2533 if (split_font_name (f
, fonts
+ n
, 1))
2535 if (font_scalable_p (fonts
+ n
)
2536 && !may_use_scalable_font_p (name
))
2539 xfree (fonts
[n
].name
);
2545 xfree (fonts
[n
].name
);
2548 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2549 if (n
== 0 && try_alternatives_p
)
2551 Lisp_Object list
= Valternate_fontname_alist
;
2553 while (CONSP (list
))
2555 Lisp_Object entry
= XCAR (list
);
2557 && STRINGP (XCAR (entry
))
2558 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2565 Lisp_Object patterns
= XCAR (list
);
2568 while (CONSP (patterns
)
2569 /* If list is screwed up, give up. */
2570 && (name
= XCAR (patterns
),
2572 /* Ignore patterns equal to PATTERN because we tried that
2573 already with no success. */
2574 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2575 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2578 patterns
= XCDR (patterns
);
2586 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2587 using comparison function CMPFN. Value is the number of fonts
2588 found. If value is non-zero, *FONTS is set to a vector of
2589 font_name structures allocated from the heap containing matching
2590 fonts. Each element of *FONTS contains a name member that is also
2591 allocated from the heap. Font names in these structures are split
2592 into fields. Use free_font_names to free such an array. */
2595 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2598 int (*cmpfn
) P_ ((const void *, const void *));
2599 struct font_name
**fonts
;
2603 /* Get the list of fonts matching pattern. 100 should suffice. */
2604 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2605 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2606 nfonts
= XFASTINT (Vfont_list_limit
);
2608 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2609 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2611 /* Sort the resulting array and return it in *FONTS. If no
2612 fonts were found, make sure to set *FONTS to null. */
2614 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2625 /* Compare two font_name structures *A and *B. Value is analogous to
2626 strcmp. Sort order is given by the global variable
2627 font_sort_order. Font names are sorted so that, everything else
2628 being equal, fonts with a resolution closer to that of the frame on
2629 which they are used are listed first. The global variable
2630 font_frame is the frame on which we operate. */
2633 cmp_font_names (a
, b
)
2636 struct font_name
*x
= (struct font_name
*) a
;
2637 struct font_name
*y
= (struct font_name
*) b
;
2640 /* All strings have been converted to lower-case by split_font_name,
2641 so we can use strcmp here. */
2642 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2647 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2649 int j
= font_sort_order
[i
];
2650 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2655 /* Everything else being equal, we prefer fonts with an
2656 y-resolution closer to that of the frame. */
2657 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2658 int x_resy
= x
->numeric
[XLFD_RESY
];
2659 int y_resy
= y
->numeric
[XLFD_RESY
];
2660 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2668 /* Get a sorted list of fonts matching PATTERN. If PATTERN is nil,
2669 list fonts matching FAMILY and REGISTRY. FAMILY is a family name
2670 string or nil. REGISTRY is a registry name string. Set *FONTS to
2671 a vector of font_name structures allocated from the heap containing
2672 the fonts found. Value is the number of fonts found. */
2675 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2677 Lisp_Object pattern
, family
, registry
;
2678 struct font_name
**fonts
;
2680 char *pattern_str
, *family_str
, *registry_str
;
2684 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2685 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2687 pattern_str
= (char *) alloca (strlen (family_str
)
2688 + strlen (registry_str
)
2690 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2691 strcat (pattern_str
, family_str
);
2692 strcat (pattern_str
, "-*-");
2693 strcat (pattern_str
, registry_str
);
2694 if (!index (registry_str
, '-'))
2696 if (registry_str
[strlen (registry_str
) - 1] == '*')
2697 strcat (pattern_str
, "-*");
2699 strcat (pattern_str
, "*-*");
2703 pattern_str
= (char *) XSTRING (pattern
)->data
;
2705 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2709 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2710 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2711 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2714 static struct font_name
*
2715 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2716 struct font_name
*fonts1
, *fonts2
;
2717 int nfonts1
, nfonts2
;
2719 int new_nfonts
= nfonts1
+ nfonts2
;
2720 struct font_name
*new_fonts
;
2722 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2723 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2724 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2731 /* Get a sorted list of fonts of family FAMILY on frame F.
2733 If PATTERN is non-nil, list fonts matching that pattern.
2735 If REGISTRY is non-nil, return fonts with that registry and the
2736 alternative registries from Vface_alternative_font_registry_alist.
2738 If REGISTRY is nil return fonts of any registry.
2740 Set *FONTS to a vector of font_name structures allocated from the
2741 heap containing the fonts found. Value is the number of fonts
2745 font_list (f
, pattern
, family
, registry
, fonts
)
2747 Lisp_Object pattern
, family
, registry
;
2748 struct font_name
**fonts
;
2750 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2752 if (!NILP (registry
)
2753 && CONSP (Vface_alternative_font_registry_alist
))
2757 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2762 for (alter
= XCDR (alter
), reg_prio
= 1;
2764 alter
= XCDR (alter
), reg_prio
++)
2765 if (STRINGP (XCAR (alter
)))
2768 struct font_name
*fonts2
;
2770 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2772 for (i
= 0; i
< nfonts2
; i
++)
2773 fonts2
[i
].registry_priority
= reg_prio
;
2774 *fonts
= (nfonts
> 0
2775 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2786 /* Remove elements from LIST whose cars are `equal'. Called from
2787 x-family-fonts and x-font-family-list to remove duplicate font
2791 remove_duplicates (list
)
2794 Lisp_Object tail
= list
;
2796 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2798 Lisp_Object next
= XCDR (tail
);
2799 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2800 XSETCDR (tail
, XCDR (next
));
2807 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2808 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2809 If FAMILY is omitted or nil, list all families.
2810 Otherwise, FAMILY must be a string, possibly containing wildcards
2812 If FRAME is omitted or nil, use the selected frame.
2813 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2814 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2815 FAMILY is the font family name. POINT-SIZE is the size of the
2816 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2817 width, weight and slant of the font. These symbols are the same as for
2818 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2819 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2820 giving the registry and encoding of the font.
2821 The result list is sorted according to the current setting of
2822 the face font sort order. */)
2824 Lisp_Object family
, frame
;
2826 struct frame
*f
= check_x_frame (frame
);
2827 struct font_name
*fonts
;
2830 struct gcpro gcpro1
;
2833 CHECK_STRING (family
);
2837 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2838 for (i
= nfonts
- 1; i
>= 0; --i
)
2840 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2843 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2844 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2845 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2846 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2847 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2848 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2849 tem
= build_font_name (fonts
+ i
);
2850 ASET (v
, 6, build_string (tem
));
2851 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2852 fonts
[i
].fields
[XLFD_ENCODING
]);
2853 ASET (v
, 7, build_string (tem
));
2856 result
= Fcons (v
, result
);
2859 remove_duplicates (result
);
2860 free_font_names (fonts
, nfonts
);
2866 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2868 doc
: /* Return a list of available font families on FRAME.
2869 If FRAME is omitted or nil, use the selected frame.
2870 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2871 is a font family, and FIXED-P is non-nil if fonts of that family
2872 are fixed-pitch. */)
2876 struct frame
*f
= check_x_frame (frame
);
2878 struct font_name
*fonts
;
2880 struct gcpro gcpro1
;
2881 int count
= specpdl_ptr
- specpdl
;
2884 /* Let's consider all fonts. Increase the limit for matching
2885 fonts until we have them all. */
2888 specbind (intern ("font-list-limit"), make_number (limit
));
2889 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2891 if (nfonts
== limit
)
2893 free_font_names (fonts
, nfonts
);
2902 for (i
= nfonts
- 1; i
>= 0; --i
)
2903 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2904 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2907 remove_duplicates (result
);
2908 free_font_names (fonts
, nfonts
);
2910 return unbind_to (count
, result
);
2914 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2915 doc
: /* Return a list of the names of available fonts matching PATTERN.
2916 If optional arguments FACE and FRAME are specified, return only fonts
2917 the same size as FACE on FRAME.
2918 PATTERN is a string, perhaps with wildcard characters;
2919 the * character matches any substring, and
2920 the ? character matches any single character.
2921 PATTERN is case-insensitive.
2922 FACE is a face name--a symbol.
2924 The return value is a list of strings, suitable as arguments to
2927 Fonts Emacs can't use may or may not be excluded
2928 even if they match PATTERN and FACE.
2929 The optional fourth argument MAXIMUM sets a limit on how many
2930 fonts to match. The first MAXIMUM fonts are reported.
2931 The optional fifth argument WIDTH, if specified, is a number of columns
2932 occupied by a character of a font. In that case, return only fonts
2933 the WIDTH times as wide as FACE on FRAME. */)
2934 (pattern
, face
, frame
, maximum
, width
)
2935 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2942 CHECK_STRING (pattern
);
2948 CHECK_NATNUM (maximum
);
2949 maxnames
= XINT (maximum
);
2953 CHECK_NUMBER (width
);
2955 /* We can't simply call check_x_frame because this function may be
2956 called before any frame is created. */
2957 f
= frame_or_selected_frame (frame
, 2);
2958 if (!FRAME_WINDOW_P (f
))
2960 /* Perhaps we have not yet created any frame. */
2965 /* Determine the width standard for comparison with the fonts we find. */
2971 /* This is of limited utility since it works with character
2972 widths. Keep it for compatibility. --gerd. */
2973 int face_id
= lookup_named_face (f
, face
);
2974 struct face
*face
= (face_id
< 0
2976 : FACE_FROM_ID (f
, face_id
));
2978 if (face
&& face
->font
)
2979 size
= FONT_WIDTH (face
->font
);
2981 size
= FONT_WIDTH (FRAME_FONT (f
));
2984 size
*= XINT (width
);
2988 Lisp_Object args
[2];
2990 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2992 /* We don't have to check fontsets. */
2994 args
[1] = list_fontsets (f
, pattern
, size
);
2995 return Fnconc (2, args
);
2999 #endif /* HAVE_WINDOW_SYSTEM */
3003 /***********************************************************************
3005 ***********************************************************************/
3007 /* Access face attributes of face LFACE, a Lisp vector. */
3009 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
3010 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
3011 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
3012 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
3013 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
3014 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3015 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3016 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3017 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3018 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3019 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3020 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3021 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3022 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3023 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3024 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3025 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3027 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3028 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3030 #define LFACEP(LFACE) \
3032 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3033 && EQ (AREF (LFACE, 0), Qface))
3038 /* Check consistency of Lisp face attribute vector ATTRS. */
3041 check_lface_attrs (attrs
)
3044 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3045 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3046 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3047 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3048 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3049 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3050 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3051 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3052 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3053 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3054 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3055 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3056 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3057 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3058 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3059 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3060 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3061 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3062 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3063 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3064 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3065 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3066 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3067 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3068 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3069 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3070 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3071 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3072 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3073 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3074 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3075 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3076 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3077 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3078 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3079 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3080 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3081 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3082 #ifdef HAVE_WINDOW_SYSTEM
3083 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3084 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3085 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3086 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3087 || NILP (attrs
[LFACE_FONT_INDEX
])
3088 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3089 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3090 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3095 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3103 xassert (LFACEP (lface
));
3104 check_lface_attrs (XVECTOR (lface
)->contents
);
3108 #else /* GLYPH_DEBUG == 0 */
3110 #define check_lface_attrs(attrs) (void) 0
3111 #define check_lface(lface) (void) 0
3113 #endif /* GLYPH_DEBUG == 0 */
3116 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3117 to make it a symvol. If FACE_NAME is an alias for another face,
3118 return that face's name. */
3121 resolve_face_name (face_name
)
3122 Lisp_Object face_name
;
3124 Lisp_Object aliased
;
3126 if (STRINGP (face_name
))
3127 face_name
= intern (XSTRING (face_name
)->data
);
3129 while (SYMBOLP (face_name
))
3131 aliased
= Fget (face_name
, Qface_alias
);
3135 face_name
= aliased
;
3142 /* Return the face definition of FACE_NAME on frame F. F null means
3143 return the definition for new frames. FACE_NAME may be a string or
3144 a symbol (apparently Emacs 20.2 allowed strings as face names in
3145 face text properties; Ediff uses that). If FACE_NAME is an alias
3146 for another face, return that face's definition. If SIGNAL_P is
3147 non-zero, signal an error if FACE_NAME is not a valid face name.
3148 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3151 static INLINE Lisp_Object
3152 lface_from_face_name (f
, face_name
, signal_p
)
3154 Lisp_Object face_name
;
3159 face_name
= resolve_face_name (face_name
);
3162 lface
= assq_no_quit (face_name
, f
->face_alist
);
3164 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3167 lface
= XCDR (lface
);
3169 signal_error ("Invalid face", face_name
);
3171 check_lface (lface
);
3176 /* Get face attributes of face FACE_NAME from frame-local faces on
3177 frame F. Store the resulting attributes in ATTRS which must point
3178 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3179 is non-zero, signal an error if FACE_NAME does not name a face.
3180 Otherwise, value is zero if FACE_NAME is not a face. */
3183 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3185 Lisp_Object face_name
;
3192 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3195 bcopy (XVECTOR (lface
)->contents
, attrs
,
3196 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3206 /* Non-zero if all attributes in face attribute vector ATTRS are
3207 specified, i.e. are non-nil. */
3210 lface_fully_specified_p (attrs
)
3215 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3216 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3217 && i
!= LFACE_AVGWIDTH_INDEX
)
3218 if (UNSPECIFIEDP (attrs
[i
]))
3221 return i
== LFACE_VECTOR_SIZE
;
3224 #ifdef HAVE_WINDOW_SYSTEM
3226 /* Set font-related attributes of Lisp face LFACE from the fullname of
3227 the font opened by FONTNAME. If FORCE_P is zero, set only
3228 unspecified attributes of LFACE. The exception is `font'
3229 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3231 If FONTNAME is not available on frame F,
3232 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3233 If the fullname is not in a valid XLFD format,
3234 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3235 in LFACE and return 1.
3236 Otherwise, return 1.
3238 Currently this function is always called with both FORCE_P and
3239 MAIL_FAIL_P non-zero. */
3242 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3245 Lisp_Object fontname
;
3246 int force_p
, may_fail_p
;
3248 struct font_name font
;
3253 char *font_name
= XSTRING (fontname
)->data
;
3254 struct font_info
*font_info
;
3256 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3257 fontset
= fs_query_fontset (fontname
, 0);
3259 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3260 else if (fontset
== 0)
3267 /* Check if FONT_NAME is surely available on the system. Usually
3268 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3269 returns quickly. But, even if FONT_NAME is not yet cached,
3270 caching it now is not futail because we anyway load the font
3273 font_info
= FS_LOAD_FONT (f
, font_name
);
3283 font
.name
= STRDUPA (font_info
->full_name
);
3284 have_xlfd_p
= split_font_name (f
, &font
, 1);
3286 /* Set attributes only if unspecified, otherwise face defaults for
3287 new frames would never take effect. If we couldn't get a font
3288 name conforming to XLFD, set normal values. */
3290 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3295 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3296 + strlen (font
.fields
[XLFD_FOUNDRY
])
3298 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3299 font
.fields
[XLFD_FAMILY
]);
3300 val
= build_string (buffer
);
3303 val
= build_string ("*");
3304 LFACE_FAMILY (lface
) = val
;
3307 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3310 pt
= xlfd_point_size (f
, &font
);
3312 pt
= pixel_point_size (f
, font_info
->height
* 10);
3314 LFACE_HEIGHT (lface
) = make_number (pt
);
3317 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3318 LFACE_SWIDTH (lface
)
3319 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3321 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3322 LFACE_AVGWIDTH (lface
)
3324 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3327 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3328 LFACE_WEIGHT (lface
)
3329 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3331 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3333 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3337 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3338 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3341 LFACE_FONT (lface
) = fontname
;
3345 #endif /* HAVE_WINDOW_SYSTEM */
3348 /* Merges the face height FROM with the face height TO, and returns the
3349 merged height. If FROM is an invalid height, then INVALID is
3350 returned instead. FROM and TO may be either absolute face heights or
3351 `relative' heights; the returned value is always an absolute height
3352 unless both FROM and TO are relative. GCPRO is a lisp value that
3353 will be protected from garbage-collection if this function makes a
3357 merge_face_heights (from
, to
, invalid
, gcpro
)
3358 Lisp_Object from
, to
, invalid
, gcpro
;
3360 Lisp_Object result
= invalid
;
3362 if (INTEGERP (from
))
3363 /* FROM is absolute, just use it as is. */
3365 else if (FLOATP (from
))
3366 /* FROM is a scale, use it to adjust TO. */
3369 /* relative X absolute => absolute */
3370 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3371 else if (FLOATP (to
))
3372 /* relative X relative => relative */
3373 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3375 else if (FUNCTIONP (from
))
3376 /* FROM is a function, which use to adjust TO. */
3378 /* Call function with current height as argument.
3379 From is the new height. */
3380 Lisp_Object args
[2];
3381 struct gcpro gcpro1
;
3387 result
= safe_call (2, args
);
3391 /* Ensure that if TO was absolute, so is the result. */
3392 if (INTEGERP (to
) && !INTEGERP (result
))
3400 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3401 store the resulting attributes in TO, which must be already be
3402 completely specified and contain only absolute attributes. Every
3403 specified attribute of FROM overrides the corresponding attribute of
3404 TO; relative attributes in FROM are merged with the absolute value in
3405 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3406 face inheritance; it should be Qnil when called from other places. */
3409 merge_face_vectors (f
, from
, to
, cycle_check
)
3411 Lisp_Object
*from
, *to
;
3412 Lisp_Object cycle_check
;
3416 /* If FROM inherits from some other faces, merge their attributes into
3417 TO before merging FROM's direct attributes. Note that an :inherit
3418 attribute of `unspecified' is the same as one of nil; we never
3419 merge :inherit attributes, so nil is more correct, but lots of
3420 other code uses `unspecified' as a generic value for face attributes. */
3421 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3422 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3423 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3425 /* If TO specifies a :font attribute, and FROM specifies some
3426 font-related attribute, we need to clear TO's :font attribute
3427 (because it will be inconsistent with whatever FROM specifies, and
3428 FROM takes precedence). */
3429 if (!NILP (to
[LFACE_FONT_INDEX
])
3430 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3431 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3432 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3433 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3434 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3435 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3436 to
[LFACE_FONT_INDEX
] = Qnil
;
3438 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3439 if (!UNSPECIFIEDP (from
[i
]))
3441 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3442 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3447 /* TO is always an absolute face, which should inherit from nothing.
3448 We blindly copy the :inherit attribute above and fix it up here. */
3449 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3453 /* Checks the `cycle check' variable CHECK to see if it indicates that
3454 EL is part of a cycle; CHECK must be either Qnil or a value returned
3455 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3456 elements after which a cycle might be suspected; after that many
3457 elements, this macro begins consing in order to keep more precise
3460 Returns nil if a cycle was detected, otherwise a new value for CHECK
3463 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3464 the caller should make sure that's ok. */
3466 #define CYCLE_CHECK(check, el, suspicious) \
3469 : (INTEGERP (check) \
3470 ? (XFASTINT (check) < (suspicious) \
3471 ? make_number (XFASTINT (check) + 1) \
3472 : Fcons (el, Qnil)) \
3473 : (!NILP (Fmemq ((el), (check))) \
3475 : Fcons ((el), (check)))))
3478 /* Merge face attributes from the face on frame F whose name is
3479 INHERITS, into the vector of face attributes TO; INHERITS may also be
3480 a list of face names, in which case they are applied in order.
3481 CYCLE_CHECK is used to detect loops in face inheritance.
3482 Returns true if any of the inherited attributes are `font-related'. */
3485 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3487 Lisp_Object inherit
;
3489 Lisp_Object cycle_check
;
3491 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3492 /* Inherit from the named face INHERIT. */
3496 /* Make sure we're not in an inheritance loop. */
3497 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3498 if (NILP (cycle_check
))
3499 /* Cycle detected, ignore any further inheritance. */
3502 lface
= lface_from_face_name (f
, inherit
, 0);
3504 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3506 else if (CONSP (inherit
))
3507 /* Handle a list of inherited faces by calling ourselves recursively
3508 on each element. Note that we only do so for symbol elements, so
3509 it's not possible to infinitely recurse. */
3511 while (CONSP (inherit
))
3513 if (SYMBOLP (XCAR (inherit
)))
3514 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3516 /* Check for a circular inheritance list. */
3517 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3518 if (NILP (cycle_check
))
3519 /* Cycle detected. */
3522 inherit
= XCDR (inherit
);
3528 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3529 is a face property, determine the resulting face attributes on
3530 frame F, and store them in TO. PROP may be a single face
3531 specification or a list of such specifications. Each face
3532 specification can be
3534 1. A symbol or string naming a Lisp face.
3536 2. A property list of the form (KEYWORD VALUE ...) where each
3537 KEYWORD is a face attribute name, and value is an appropriate value
3540 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3541 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3542 for compatibility with 20.2.
3544 Face specifications earlier in lists take precedence over later
3548 merge_face_vector_with_property (f
, to
, prop
)
3555 Lisp_Object first
= XCAR (prop
);
3557 if (EQ (first
, Qforeground_color
)
3558 || EQ (first
, Qbackground_color
))
3560 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3561 . COLOR). COLOR must be a string. */
3562 Lisp_Object color_name
= XCDR (prop
);
3563 Lisp_Object color
= first
;
3565 if (STRINGP (color_name
))
3567 if (EQ (color
, Qforeground_color
))
3568 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3570 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3573 add_to_log ("Invalid face color", color_name
, Qnil
);
3575 else if (SYMBOLP (first
)
3576 && *XSYMBOL (first
)->name
->data
== ':')
3578 /* Assume this is the property list form. */
3579 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3581 Lisp_Object keyword
= XCAR (prop
);
3582 Lisp_Object value
= XCAR (XCDR (prop
));
3584 if (EQ (keyword
, QCfamily
))
3586 if (STRINGP (value
))
3587 to
[LFACE_FAMILY_INDEX
] = value
;
3589 add_to_log ("Invalid face font family", value
, Qnil
);
3591 else if (EQ (keyword
, QCheight
))
3593 Lisp_Object new_height
=
3594 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3597 if (NILP (new_height
))
3598 add_to_log ("Invalid face font height", value
, Qnil
);
3600 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3602 else if (EQ (keyword
, QCweight
))
3605 && face_numeric_weight (value
) >= 0)
3606 to
[LFACE_WEIGHT_INDEX
] = value
;
3608 add_to_log ("Invalid face weight", value
, Qnil
);
3610 else if (EQ (keyword
, QCslant
))
3613 && face_numeric_slant (value
) >= 0)
3614 to
[LFACE_SLANT_INDEX
] = value
;
3616 add_to_log ("Invalid face slant", value
, Qnil
);
3618 else if (EQ (keyword
, QCunderline
))
3623 to
[LFACE_UNDERLINE_INDEX
] = value
;
3625 add_to_log ("Invalid face underline", value
, Qnil
);
3627 else if (EQ (keyword
, QCoverline
))
3632 to
[LFACE_OVERLINE_INDEX
] = value
;
3634 add_to_log ("Invalid face overline", value
, Qnil
);
3636 else if (EQ (keyword
, QCstrike_through
))
3641 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3643 add_to_log ("Invalid face strike-through", value
, Qnil
);
3645 else if (EQ (keyword
, QCbox
))
3648 value
= make_number (1);
3649 if (INTEGERP (value
)
3653 to
[LFACE_BOX_INDEX
] = value
;
3655 add_to_log ("Invalid face box", value
, Qnil
);
3657 else if (EQ (keyword
, QCinverse_video
)
3658 || EQ (keyword
, QCreverse_video
))
3660 if (EQ (value
, Qt
) || NILP (value
))
3661 to
[LFACE_INVERSE_INDEX
] = value
;
3663 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3665 else if (EQ (keyword
, QCforeground
))
3667 if (STRINGP (value
))
3668 to
[LFACE_FOREGROUND_INDEX
] = value
;
3670 add_to_log ("Invalid face foreground", value
, Qnil
);
3672 else if (EQ (keyword
, QCbackground
))
3674 if (STRINGP (value
))
3675 to
[LFACE_BACKGROUND_INDEX
] = value
;
3677 add_to_log ("Invalid face background", value
, Qnil
);
3679 else if (EQ (keyword
, QCstipple
))
3681 #ifdef HAVE_X_WINDOWS
3682 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3683 if (!NILP (pixmap_p
))
3684 to
[LFACE_STIPPLE_INDEX
] = value
;
3686 add_to_log ("Invalid face stipple", value
, Qnil
);
3689 else if (EQ (keyword
, QCwidth
))
3692 && face_numeric_swidth (value
) >= 0)
3693 to
[LFACE_SWIDTH_INDEX
] = value
;
3695 add_to_log ("Invalid face width", value
, Qnil
);
3697 else if (EQ (keyword
, QCinherit
))
3699 if (SYMBOLP (value
))
3700 to
[LFACE_INHERIT_INDEX
] = value
;
3704 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3705 if (!SYMBOLP (XCAR (tail
)))
3708 to
[LFACE_INHERIT_INDEX
] = value
;
3710 add_to_log ("Invalid face inherit", value
, Qnil
);
3714 add_to_log ("Invalid attribute %s in face property",
3717 prop
= XCDR (XCDR (prop
));
3722 /* This is a list of face specs. Specifications at the
3723 beginning of the list take precedence over later
3724 specifications, so we have to merge starting with the
3725 last specification. */
3726 Lisp_Object next
= XCDR (prop
);
3728 merge_face_vector_with_property (f
, to
, next
);
3729 merge_face_vector_with_property (f
, to
, first
);
3734 /* PROP ought to be a face name. */
3735 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3737 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3739 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3744 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3745 Sinternal_make_lisp_face
, 1, 2, 0,
3746 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3747 If FACE was not known as a face before, create a new one.
3748 If optional argument FRAME is specified, make a frame-local face
3749 for that frame. Otherwise operate on the global face definition.
3750 Value is a vector of face attributes. */)
3752 Lisp_Object face
, frame
;
3754 Lisp_Object global_lface
, lface
;
3758 CHECK_SYMBOL (face
);
3759 global_lface
= lface_from_face_name (NULL
, face
, 0);
3763 CHECK_LIVE_FRAME (frame
);
3765 lface
= lface_from_face_name (f
, face
, 0);
3768 f
= NULL
, lface
= Qnil
;
3770 /* Add a global definition if there is none. */
3771 if (NILP (global_lface
))
3773 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3775 AREF (global_lface
, 0) = Qface
;
3776 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3777 Vface_new_frame_defaults
);
3779 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3780 face id to Lisp face is given by the vector lface_id_to_name.
3781 The mapping from Lisp face to Lisp face id is given by the
3782 property `face' of the Lisp face name. */
3783 if (next_lface_id
== lface_id_to_name_size
)
3785 int new_size
= max (50, 2 * lface_id_to_name_size
);
3786 int sz
= new_size
* sizeof *lface_id_to_name
;
3787 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3788 lface_id_to_name_size
= new_size
;
3791 lface_id_to_name
[next_lface_id
] = face
;
3792 Fput (face
, Qface
, make_number (next_lface_id
));
3796 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3797 AREF (global_lface
, i
) = Qunspecified
;
3799 /* Add a frame-local definition. */
3804 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3806 AREF (lface
, 0) = Qface
;
3807 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3810 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3811 AREF (lface
, i
) = Qunspecified
;
3814 lface
= global_lface
;
3816 /* Changing a named face means that all realized faces depending on
3817 that face are invalid. Since we cannot tell which realized faces
3818 depend on the face, make sure they are all removed. This is done
3819 by incrementing face_change_count. The next call to
3820 init_iterator will then free realized faces. */
3821 ++face_change_count
;
3822 ++windows_or_buffers_changed
;
3824 xassert (LFACEP (lface
));
3825 check_lface (lface
);
3830 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3831 Sinternal_lisp_face_p
, 1, 2, 0,
3832 doc
: /* Return non-nil if FACE names a face.
3833 If optional second parameter FRAME is non-nil, check for the
3834 existence of a frame-local face with name FACE on that frame.
3835 Otherwise check for the existence of a global face. */)
3837 Lisp_Object face
, frame
;
3843 CHECK_LIVE_FRAME (frame
);
3844 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3847 lface
= lface_from_face_name (NULL
, face
, 0);
3853 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3854 Sinternal_copy_lisp_face
, 4, 4, 0,
3855 doc
: /* Copy face FROM to TO.
3856 If FRAME it t, copy the global face definition of FROM to the
3857 global face definition of TO. Otherwise, copy the frame-local
3858 definition of FROM on FRAME to the frame-local definition of TO
3859 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3862 (from
, to
, frame
, new_frame
)
3863 Lisp_Object from
, to
, frame
, new_frame
;
3865 Lisp_Object lface
, copy
;
3867 CHECK_SYMBOL (from
);
3869 if (NILP (new_frame
))
3874 /* Copy global definition of FROM. We don't make copies of
3875 strings etc. because 20.2 didn't do it either. */
3876 lface
= lface_from_face_name (NULL
, from
, 1);
3877 copy
= Finternal_make_lisp_face (to
, Qnil
);
3881 /* Copy frame-local definition of FROM. */
3882 CHECK_LIVE_FRAME (frame
);
3883 CHECK_LIVE_FRAME (new_frame
);
3884 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3885 copy
= Finternal_make_lisp_face (to
, new_frame
);
3888 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3889 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3891 /* Changing a named face means that all realized faces depending on
3892 that face are invalid. Since we cannot tell which realized faces
3893 depend on the face, make sure they are all removed. This is done
3894 by incrementing face_change_count. The next call to
3895 init_iterator will then free realized faces. */
3896 ++face_change_count
;
3897 ++windows_or_buffers_changed
;
3903 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3904 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3905 doc
: /* Set attribute ATTR of FACE to VALUE.
3906 FRAME being a frame means change the face on that frame.
3907 FRAME nil means change the face of the selected frame.
3908 FRAME t means change the default for new frames.
3909 FRAME 0 means change the face on all frames, and change the default
3911 (face
, attr
, value
, frame
)
3912 Lisp_Object face
, attr
, value
, frame
;
3915 Lisp_Object old_value
= Qnil
;
3916 /* Set 1 if ATTR is QCfont. */
3917 int font_attr_p
= 0;
3918 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3919 int font_related_attr_p
= 0;
3921 CHECK_SYMBOL (face
);
3922 CHECK_SYMBOL (attr
);
3924 face
= resolve_face_name (face
);
3926 /* If FRAME is 0, change face on all frames, and change the
3927 default for new frames. */
3928 if (INTEGERP (frame
) && XINT (frame
) == 0)
3931 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3932 FOR_EACH_FRAME (tail
, frame
)
3933 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3937 /* Set lface to the Lisp attribute vector of FACE. */
3939 lface
= lface_from_face_name (NULL
, face
, 1);
3943 frame
= selected_frame
;
3945 CHECK_LIVE_FRAME (frame
);
3946 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3948 /* If a frame-local face doesn't exist yet, create one. */
3950 lface
= Finternal_make_lisp_face (face
, frame
);
3953 if (EQ (attr
, QCfamily
))
3955 if (!UNSPECIFIEDP (value
))
3957 CHECK_STRING (value
);
3958 if (XSTRING (value
)->size
== 0)
3959 signal_error ("Invalid face family", value
);
3961 old_value
= LFACE_FAMILY (lface
);
3962 LFACE_FAMILY (lface
) = value
;
3963 font_related_attr_p
= 1;
3965 else if (EQ (attr
, QCheight
))
3967 if (!UNSPECIFIEDP (value
))
3971 test
= (EQ (face
, Qdefault
)
3973 /* The default face must have an absolute size,
3974 otherwise, we do a test merge with a random
3975 height to see if VALUE's ok. */
3976 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3978 if (!INTEGERP (test
) || XINT (test
) <= 0)
3979 signal_error ("Invalid face height", value
);
3982 old_value
= LFACE_HEIGHT (lface
);
3983 LFACE_HEIGHT (lface
) = value
;
3984 font_related_attr_p
= 1;
3986 else if (EQ (attr
, QCweight
))
3988 if (!UNSPECIFIEDP (value
))
3990 CHECK_SYMBOL (value
);
3991 if (face_numeric_weight (value
) < 0)
3992 signal_error ("Invalid face weight", value
);
3994 old_value
= LFACE_WEIGHT (lface
);
3995 LFACE_WEIGHT (lface
) = value
;
3996 font_related_attr_p
= 1;
3998 else if (EQ (attr
, QCslant
))
4000 if (!UNSPECIFIEDP (value
))
4002 CHECK_SYMBOL (value
);
4003 if (face_numeric_slant (value
) < 0)
4004 signal_error ("Invalid face slant", value
);
4006 old_value
= LFACE_SLANT (lface
);
4007 LFACE_SLANT (lface
) = value
;
4008 font_related_attr_p
= 1;
4010 else if (EQ (attr
, QCunderline
))
4012 if (!UNSPECIFIEDP (value
))
4013 if ((SYMBOLP (value
)
4015 && !EQ (value
, Qnil
))
4016 /* Underline color. */
4018 && XSTRING (value
)->size
== 0))
4019 signal_error ("Invalid face underline", value
);
4021 old_value
= LFACE_UNDERLINE (lface
);
4022 LFACE_UNDERLINE (lface
) = value
;
4024 else if (EQ (attr
, QCoverline
))
4026 if (!UNSPECIFIEDP (value
))
4027 if ((SYMBOLP (value
)
4029 && !EQ (value
, Qnil
))
4030 /* Overline color. */
4032 && XSTRING (value
)->size
== 0))
4033 signal_error ("Invalid face overline", value
);
4035 old_value
= LFACE_OVERLINE (lface
);
4036 LFACE_OVERLINE (lface
) = value
;
4038 else if (EQ (attr
, QCstrike_through
))
4040 if (!UNSPECIFIEDP (value
))
4041 if ((SYMBOLP (value
)
4043 && !EQ (value
, Qnil
))
4044 /* Strike-through color. */
4046 && XSTRING (value
)->size
== 0))
4047 signal_error ("Invalid face strike-through", value
);
4049 old_value
= LFACE_STRIKE_THROUGH (lface
);
4050 LFACE_STRIKE_THROUGH (lface
) = value
;
4052 else if (EQ (attr
, QCbox
))
4056 /* Allow t meaning a simple box of width 1 in foreground color
4059 value
= make_number (1);
4061 if (UNSPECIFIEDP (value
))
4063 else if (NILP (value
))
4065 else if (INTEGERP (value
))
4066 valid_p
= XINT (value
) != 0;
4067 else if (STRINGP (value
))
4068 valid_p
= XSTRING (value
)->size
> 0;
4069 else if (CONSP (value
))
4085 if (EQ (k
, QCline_width
))
4087 if (!INTEGERP (v
) || XINT (v
) == 0)
4090 else if (EQ (k
, QCcolor
))
4092 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
4095 else if (EQ (k
, QCstyle
))
4097 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4104 valid_p
= NILP (tem
);
4110 signal_error ("Invalid face box", value
);
4112 old_value
= LFACE_BOX (lface
);
4113 LFACE_BOX (lface
) = value
;
4115 else if (EQ (attr
, QCinverse_video
)
4116 || EQ (attr
, QCreverse_video
))
4118 if (!UNSPECIFIEDP (value
))
4120 CHECK_SYMBOL (value
);
4121 if (!EQ (value
, Qt
) && !NILP (value
))
4122 signal_error ("Invalid inverse-video face attribute value", value
);
4124 old_value
= LFACE_INVERSE (lface
);
4125 LFACE_INVERSE (lface
) = value
;
4127 else if (EQ (attr
, QCforeground
))
4129 if (!UNSPECIFIEDP (value
))
4131 /* Don't check for valid color names here because it depends
4132 on the frame (display) whether the color will be valid
4133 when the face is realized. */
4134 CHECK_STRING (value
);
4135 if (XSTRING (value
)->size
== 0)
4136 signal_error ("Empty foreground color value", value
);
4138 old_value
= LFACE_FOREGROUND (lface
);
4139 LFACE_FOREGROUND (lface
) = value
;
4141 else if (EQ (attr
, QCbackground
))
4143 if (!UNSPECIFIEDP (value
))
4145 /* Don't check for valid color names here because it depends
4146 on the frame (display) whether the color will be valid
4147 when the face is realized. */
4148 CHECK_STRING (value
);
4149 if (XSTRING (value
)->size
== 0)
4150 signal_error ("Empty background color value", value
);
4152 old_value
= LFACE_BACKGROUND (lface
);
4153 LFACE_BACKGROUND (lface
) = value
;
4155 else if (EQ (attr
, QCstipple
))
4157 #ifdef HAVE_X_WINDOWS
4158 if (!UNSPECIFIEDP (value
)
4160 && NILP (Fbitmap_spec_p (value
)))
4161 signal_error ("Invalid stipple attribute", value
);
4162 old_value
= LFACE_STIPPLE (lface
);
4163 LFACE_STIPPLE (lface
) = value
;
4164 #endif /* HAVE_X_WINDOWS */
4166 else if (EQ (attr
, QCwidth
))
4168 if (!UNSPECIFIEDP (value
))
4170 CHECK_SYMBOL (value
);
4171 if (face_numeric_swidth (value
) < 0)
4172 signal_error ("Invalid face width", value
);
4174 old_value
= LFACE_SWIDTH (lface
);
4175 LFACE_SWIDTH (lface
) = value
;
4176 font_related_attr_p
= 1;
4178 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4180 #ifdef HAVE_WINDOW_SYSTEM
4181 if (FRAME_WINDOW_P (XFRAME (frame
)))
4183 /* Set font-related attributes of the Lisp face from an XLFD
4188 CHECK_STRING (value
);
4190 f
= SELECTED_FRAME ();
4192 f
= check_x_frame (frame
);
4194 /* VALUE may be a fontset name or an alias of fontset. In
4195 such a case, use the base fontset name. */
4196 tmp
= Fquery_fontset (value
, Qnil
);
4199 else if (EQ (attr
, QCfontset
))
4200 signal_error ("Invalid fontset name", value
);
4202 if (EQ (attr
, QCfont
))
4204 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4205 signal_error ("Invalid font or fontset name", value
);
4208 LFACE_FONTSET (lface
) = value
;
4212 #endif /* HAVE_WINDOW_SYSTEM */
4214 else if (EQ (attr
, QCinherit
))
4217 if (SYMBOLP (value
))
4220 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4221 if (!SYMBOLP (XCAR (tail
)))
4224 LFACE_INHERIT (lface
) = value
;
4226 signal_error ("Invalid face inheritance", value
);
4228 else if (EQ (attr
, QCbold
))
4230 old_value
= LFACE_WEIGHT (lface
);
4231 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4232 font_related_attr_p
= 1;
4234 else if (EQ (attr
, QCitalic
))
4236 old_value
= LFACE_SLANT (lface
);
4237 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4238 font_related_attr_p
= 1;
4241 signal_error ("Invalid face attribute name", attr
);
4243 if (font_related_attr_p
4244 && !UNSPECIFIEDP (value
))
4245 /* If a font-related attribute other than QCfont is specified, the
4246 original `font' attribute nor that of default face is useless
4247 to determine a new font. Thus, we set it to nil so that font
4248 selection mechanism doesn't use it. */
4249 LFACE_FONT (lface
) = Qnil
;
4251 /* Changing a named face means that all realized faces depending on
4252 that face are invalid. Since we cannot tell which realized faces
4253 depend on the face, make sure they are all removed. This is done
4254 by incrementing face_change_count. The next call to
4255 init_iterator will then free realized faces. */
4257 && (EQ (attr
, QCfont
)
4258 || EQ (attr
, QCfontset
)
4259 || NILP (Fequal (old_value
, value
))))
4261 ++face_change_count
;
4262 ++windows_or_buffers_changed
;
4265 if (!UNSPECIFIEDP (value
)
4266 && NILP (Fequal (old_value
, value
)))
4272 if (EQ (face
, Qdefault
))
4274 #ifdef HAVE_WINDOW_SYSTEM
4275 /* Changed font-related attributes of the `default' face are
4276 reflected in changed `font' frame parameters. */
4278 && (font_related_attr_p
|| font_attr_p
)
4279 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4280 set_font_frame_param (frame
, lface
);
4282 #endif /* HAVE_WINDOW_SYSTEM */
4284 if (EQ (attr
, QCforeground
))
4285 param
= Qforeground_color
;
4286 else if (EQ (attr
, QCbackground
))
4287 param
= Qbackground_color
;
4289 #ifdef HAVE_WINDOW_SYSTEM
4291 else if (EQ (face
, Qscroll_bar
))
4293 /* Changing the colors of `scroll-bar' sets frame parameters
4294 `scroll-bar-foreground' and `scroll-bar-background'. */
4295 if (EQ (attr
, QCforeground
))
4296 param
= Qscroll_bar_foreground
;
4297 else if (EQ (attr
, QCbackground
))
4298 param
= Qscroll_bar_background
;
4300 #endif /* not WINDOWSNT */
4301 else if (EQ (face
, Qborder
))
4303 /* Changing background color of `border' sets frame parameter
4305 if (EQ (attr
, QCbackground
))
4306 param
= Qborder_color
;
4308 else if (EQ (face
, Qcursor
))
4310 /* Changing background color of `cursor' sets frame parameter
4312 if (EQ (attr
, QCbackground
))
4313 param
= Qcursor_color
;
4315 else if (EQ (face
, Qmouse
))
4317 /* Changing background color of `mouse' sets frame parameter
4319 if (EQ (attr
, QCbackground
))
4320 param
= Qmouse_color
;
4322 #endif /* HAVE_WINDOW_SYSTEM */
4323 else if (EQ (face
, Qmenu
))
4325 /* Indicate that we have to update the menu bar when
4326 realizing faces on FRAME. FRAME t change the
4327 default for new frames. We do this by setting
4328 setting the flag in new face caches */
4331 struct frame
*f
= XFRAME (frame
);
4332 if (FRAME_FACE_CACHE (f
) == NULL
)
4333 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4334 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4337 menu_face_changed_default
= 1;
4343 /* Update `default-frame-alist', which is used for new frames. */
4345 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4348 /* Update the current frame's parameters. */
4351 cons
= XCAR (Vparam_value_alist
);
4352 XSETCAR (cons
, param
);
4353 XSETCDR (cons
, value
);
4354 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4363 #ifdef HAVE_WINDOW_SYSTEM
4365 /* Set the `font' frame parameter of FRAME determined from `default'
4366 face attributes LFACE. If a font name is explicitely
4367 specfied in LFACE, use it as is. Otherwise, determine a font name
4368 from the other font-related atrributes of LFACE. In that case, if
4369 there's no matching font, signals an error. */
4372 set_font_frame_param (frame
, lface
)
4373 Lisp_Object frame
, lface
;
4375 struct frame
*f
= XFRAME (frame
);
4377 if (FRAME_WINDOW_P (f
))
4379 Lisp_Object font_name
;
4382 if (STRINGP (LFACE_FONT (lface
)))
4383 font_name
= LFACE_FONT (lface
);
4386 /* Choose a font name that reflects LFACE's attributes and has
4387 the registry and encoding pattern specified in the default
4388 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4389 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
);
4391 error ("No font matches the specified attribute");
4392 font_name
= build_string (font
);
4396 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4401 /* Update the corresponding face when frame parameter PARAM on frame F
4402 has been assigned the value NEW_VALUE. */
4405 update_face_from_frame_parameter (f
, param
, new_value
)
4407 Lisp_Object param
, new_value
;
4411 /* If there are no faces yet, give up. This is the case when called
4412 from Fx_create_frame, and we do the necessary things later in
4413 face-set-after-frame-defaults. */
4414 if (NILP (f
->face_alist
))
4417 /* Changing a named face means that all realized faces depending on
4418 that face are invalid. Since we cannot tell which realized faces
4419 depend on the face, make sure they are all removed. This is done
4420 by incrementing face_change_count. The next call to
4421 init_iterator will then free realized faces. */
4422 ++face_change_count
;
4423 ++windows_or_buffers_changed
;
4425 if (EQ (param
, Qforeground_color
))
4427 lface
= lface_from_face_name (f
, Qdefault
, 1);
4428 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4429 ? new_value
: Qunspecified
);
4430 realize_basic_faces (f
);
4432 else if (EQ (param
, Qbackground_color
))
4436 /* Changing the background color might change the background
4437 mode, so that we have to load new defface specs. Call
4438 frame-update-face-colors to do that. */
4439 XSETFRAME (frame
, f
);
4440 call1 (Qframe_update_face_colors
, frame
);
4442 lface
= lface_from_face_name (f
, Qdefault
, 1);
4443 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4444 ? new_value
: Qunspecified
);
4445 realize_basic_faces (f
);
4447 if (EQ (param
, Qborder_color
))
4449 lface
= lface_from_face_name (f
, Qborder
, 1);
4450 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4451 ? new_value
: Qunspecified
);
4453 else if (EQ (param
, Qcursor_color
))
4455 lface
= lface_from_face_name (f
, Qcursor
, 1);
4456 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4457 ? new_value
: Qunspecified
);
4459 else if (EQ (param
, Qmouse_color
))
4461 lface
= lface_from_face_name (f
, Qmouse
, 1);
4462 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4463 ? new_value
: Qunspecified
);
4468 /* Get the value of X resource RESOURCE, class CLASS for the display
4469 of frame FRAME. This is here because ordinary `x-get-resource'
4470 doesn't take a frame argument. */
4472 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4473 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4474 (resource
, class, frame
)
4475 Lisp_Object resource
, class, frame
;
4477 Lisp_Object value
= Qnil
;
4480 CHECK_STRING (resource
);
4481 CHECK_STRING (class);
4482 CHECK_LIVE_FRAME (frame
);
4484 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4485 resource
, class, Qnil
, Qnil
);
4487 #endif /* not macintosh */
4488 #endif /* not WINDOWSNT */
4493 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4494 If VALUE is "on" or "true", return t. If VALUE is "off" or
4495 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4496 error; if SIGNAL_P is zero, return 0. */
4499 face_boolean_x_resource_value (value
, signal_p
)
4503 Lisp_Object result
= make_number (0);
4505 xassert (STRINGP (value
));
4507 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4508 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4510 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4511 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4513 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4514 result
= Qunspecified
;
4516 signal_error ("Invalid face attribute value from X resource", value
);
4522 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4523 Finternal_set_lisp_face_attribute_from_resource
,
4524 Sinternal_set_lisp_face_attribute_from_resource
,
4525 3, 4, 0, doc
: /* */)
4526 (face
, attr
, value
, frame
)
4527 Lisp_Object face
, attr
, value
, frame
;
4529 CHECK_SYMBOL (face
);
4530 CHECK_SYMBOL (attr
);
4531 CHECK_STRING (value
);
4533 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4534 value
= Qunspecified
;
4535 else if (EQ (attr
, QCheight
))
4537 value
= Fstring_to_number (value
, make_number (10));
4538 if (XINT (value
) <= 0)
4539 signal_error ("Invalid face height from X resource", value
);
4541 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4542 value
= face_boolean_x_resource_value (value
, 1);
4543 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4544 value
= intern (XSTRING (value
)->data
);
4545 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4546 value
= face_boolean_x_resource_value (value
, 1);
4547 else if (EQ (attr
, QCunderline
)
4548 || EQ (attr
, QCoverline
)
4549 || EQ (attr
, QCstrike_through
))
4551 Lisp_Object boolean_value
;
4553 /* If the result of face_boolean_x_resource_value is t or nil,
4554 VALUE does NOT specify a color. */
4555 boolean_value
= face_boolean_x_resource_value (value
, 0);
4556 if (SYMBOLP (boolean_value
))
4557 value
= boolean_value
;
4559 else if (EQ (attr
, QCbox
))
4560 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4562 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4565 #endif /* HAVE_WINDOW_SYSTEM */
4568 /***********************************************************************
4570 ***********************************************************************/
4572 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4574 /* Make menus on frame F appear as specified by the `menu' face. */
4577 x_update_menu_appearance (f
)
4580 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4584 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4588 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4589 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4590 char *myname
= XSTRING (Vx_resource_name
)->data
;
4593 const char *popup_path
= "popup_menu";
4595 const char *popup_path
= "menu.popup";
4598 if (STRINGP (LFACE_FOREGROUND (lface
)))
4600 sprintf (line
, "%s.%s*foreground: %s",
4602 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4603 XrmPutLineResource (&rdb
, line
);
4604 sprintf (line
, "%s.pane.menubar*foreground: %s",
4605 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4606 XrmPutLineResource (&rdb
, line
);
4610 if (STRINGP (LFACE_BACKGROUND (lface
)))
4612 sprintf (line
, "%s.%s*background: %s",
4614 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4615 XrmPutLineResource (&rdb
, line
);
4616 sprintf (line
, "%s.pane.menubar*background: %s",
4617 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4618 XrmPutLineResource (&rdb
, line
);
4623 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4624 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4625 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4626 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4627 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4628 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4631 const char *suffix
= "List";
4633 const char *suffix
= "";
4635 sprintf (line
, "%s.pane.menubar*font%s: %s",
4636 myname
, suffix
, face
->font_name
);
4637 XrmPutLineResource (&rdb
, line
);
4638 sprintf (line
, "%s.%s*font%s: %s",
4639 myname
, popup_path
, suffix
, face
->font_name
);
4640 XrmPutLineResource (&rdb
, line
);
4644 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4645 free_frame_menubar (f
);
4649 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4652 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4653 Sface_attribute_relative_p
,
4655 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4657 Lisp_Object attribute
, value
;
4659 if (EQ (value
, Qunspecified
))
4661 else if (EQ (attribute
, QCheight
))
4662 return INTEGERP (value
) ? Qnil
: Qt
;
4667 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4669 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4670 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4671 the result will be absolute, otherwise it will be relative. */)
4672 (attribute
, value1
, value2
)
4673 Lisp_Object attribute
, value1
, value2
;
4675 if (EQ (value1
, Qunspecified
))
4677 else if (EQ (attribute
, QCheight
))
4678 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4684 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4685 Sinternal_get_lisp_face_attribute
,
4687 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4688 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4689 face attribute name, signal an error.
4690 If the optional argument FRAME is given, report on face FACE in that
4691 frame. If FRAME is t, report on the defaults for face FACE (for new
4692 frames). If FRAME is omitted or nil, use the selected frame. */)
4693 (symbol
, keyword
, frame
)
4694 Lisp_Object symbol
, keyword
, frame
;
4696 Lisp_Object lface
, value
= Qnil
;
4698 CHECK_SYMBOL (symbol
);
4699 CHECK_SYMBOL (keyword
);
4702 lface
= lface_from_face_name (NULL
, symbol
, 1);
4706 frame
= selected_frame
;
4707 CHECK_LIVE_FRAME (frame
);
4708 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4711 if (EQ (keyword
, QCfamily
))
4712 value
= LFACE_FAMILY (lface
);
4713 else if (EQ (keyword
, QCheight
))
4714 value
= LFACE_HEIGHT (lface
);
4715 else if (EQ (keyword
, QCweight
))
4716 value
= LFACE_WEIGHT (lface
);
4717 else if (EQ (keyword
, QCslant
))
4718 value
= LFACE_SLANT (lface
);
4719 else if (EQ (keyword
, QCunderline
))
4720 value
= LFACE_UNDERLINE (lface
);
4721 else if (EQ (keyword
, QCoverline
))
4722 value
= LFACE_OVERLINE (lface
);
4723 else if (EQ (keyword
, QCstrike_through
))
4724 value
= LFACE_STRIKE_THROUGH (lface
);
4725 else if (EQ (keyword
, QCbox
))
4726 value
= LFACE_BOX (lface
);
4727 else if (EQ (keyword
, QCinverse_video
)
4728 || EQ (keyword
, QCreverse_video
))
4729 value
= LFACE_INVERSE (lface
);
4730 else if (EQ (keyword
, QCforeground
))
4731 value
= LFACE_FOREGROUND (lface
);
4732 else if (EQ (keyword
, QCbackground
))
4733 value
= LFACE_BACKGROUND (lface
);
4734 else if (EQ (keyword
, QCstipple
))
4735 value
= LFACE_STIPPLE (lface
);
4736 else if (EQ (keyword
, QCwidth
))
4737 value
= LFACE_SWIDTH (lface
);
4738 else if (EQ (keyword
, QCinherit
))
4739 value
= LFACE_INHERIT (lface
);
4740 else if (EQ (keyword
, QCfont
))
4741 value
= LFACE_FONT (lface
);
4742 else if (EQ (keyword
, QCfontset
))
4743 value
= LFACE_FONTSET (lface
);
4745 signal_error ("Invalid face attribute name", keyword
);
4751 DEFUN ("internal-lisp-face-attribute-values",
4752 Finternal_lisp_face_attribute_values
,
4753 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4754 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4755 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4759 Lisp_Object result
= Qnil
;
4761 CHECK_SYMBOL (attr
);
4763 if (EQ (attr
, QCweight
)
4764 || EQ (attr
, QCslant
)
4765 || EQ (attr
, QCwidth
))
4767 /* Extract permissible symbols from tables. */
4768 struct table_entry
*table
;
4771 if (EQ (attr
, QCweight
))
4772 table
= weight_table
, dim
= DIM (weight_table
);
4773 else if (EQ (attr
, QCslant
))
4774 table
= slant_table
, dim
= DIM (slant_table
);
4776 table
= swidth_table
, dim
= DIM (swidth_table
);
4778 for (i
= 0; i
< dim
; ++i
)
4780 Lisp_Object symbol
= *table
[i
].symbol
;
4781 Lisp_Object tail
= result
;
4784 && !EQ (XCAR (tail
), symbol
))
4788 result
= Fcons (symbol
, result
);
4791 else if (EQ (attr
, QCunderline
))
4792 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4793 else if (EQ (attr
, QCoverline
))
4794 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4795 else if (EQ (attr
, QCstrike_through
))
4796 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4797 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4798 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4804 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4805 Sinternal_merge_in_global_face
, 2, 2, 0,
4806 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4807 Default face attributes override any local face attributes. */)
4809 Lisp_Object face
, frame
;
4812 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4814 CHECK_LIVE_FRAME (frame
);
4815 global_lface
= lface_from_face_name (NULL
, face
, 1);
4816 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4817 if (NILP (local_lface
))
4818 local_lface
= Finternal_make_lisp_face (face
, frame
);
4820 /* Make every specified global attribute override the local one.
4821 BEWARE!! This is only used from `face-set-after-frame-default' where
4822 the local frame is defined from default specs in `face-defface-spec'
4823 and those should be overridden by global settings. Hence the strange
4824 "global before local" priority. */
4825 lvec
= XVECTOR (local_lface
)->contents
;
4826 gvec
= XVECTOR (global_lface
)->contents
;
4827 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4828 if (! UNSPECIFIEDP (gvec
[i
]))
4835 /* The following function is implemented for compatibility with 20.2.
4836 The function is used in x-resolve-fonts when it is asked to
4837 return fonts with the same size as the font of a face. This is
4838 done in fontset.el. */
4840 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4841 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4842 If the optional argument FRAME is given, report on face FACE in that frame.
4843 If FRAME is t, report on the defaults for face FACE (for new frames).
4844 The font default for a face is either nil, or a list
4845 of the form (bold), (italic) or (bold italic).
4846 If FRAME is omitted or nil, use the selected frame. */)
4848 Lisp_Object face
, frame
;
4852 Lisp_Object result
= Qnil
;
4853 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4855 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4856 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4857 result
= Fcons (Qbold
, result
);
4859 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4860 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4861 result
= Fcons (Qitalic
, result
);
4867 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4868 int face_id
= lookup_named_face (f
, face
);
4869 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4870 return face
? build_string (face
->font_name
) : Qnil
;
4875 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4876 all attributes are `equal'. Tries to be fast because this function
4877 is called quite often. */
4880 lface_equal_p (v1
, v2
)
4881 Lisp_Object
*v1
, *v2
;
4885 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4887 Lisp_Object a
= v1
[i
];
4888 Lisp_Object b
= v2
[i
];
4890 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4891 and the other is specified. */
4892 equal_p
= XTYPE (a
) == XTYPE (b
);
4901 equal_p
= ((STRING_BYTES (XSTRING (a
))
4902 == STRING_BYTES (XSTRING (b
)))
4903 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4904 STRING_BYTES (XSTRING (a
))) == 0);
4913 equal_p
= !NILP (Fequal (a
, b
));
4923 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4924 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4925 doc
: /* True if FACE1 and FACE2 are equal.
4926 If the optional argument FRAME is given, report on face FACE in that frame.
4927 If FRAME is t, report on the defaults for face FACE (for new frames).
4928 If FRAME is omitted or nil, use the selected frame. */)
4929 (face1
, face2
, frame
)
4930 Lisp_Object face1
, face2
, frame
;
4934 Lisp_Object lface1
, lface2
;
4939 /* Don't use check_x_frame here because this function is called
4940 before X frames exist. At that time, if FRAME is nil,
4941 selected_frame will be used which is the frame dumped with
4942 Emacs. That frame is not an X frame. */
4943 f
= frame_or_selected_frame (frame
, 2);
4945 lface1
= lface_from_face_name (NULL
, face1
, 1);
4946 lface2
= lface_from_face_name (NULL
, face2
, 1);
4947 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4948 XVECTOR (lface2
)->contents
);
4949 return equal_p
? Qt
: Qnil
;
4953 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4954 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4955 doc
: /* True if FACE has no attribute specified.
4956 If the optional argument FRAME is given, report on face FACE in that frame.
4957 If FRAME is t, report on the defaults for face FACE (for new frames).
4958 If FRAME is omitted or nil, use the selected frame. */)
4960 Lisp_Object face
, frame
;
4967 frame
= selected_frame
;
4968 CHECK_LIVE_FRAME (frame
);
4972 lface
= lface_from_face_name (NULL
, face
, 1);
4974 lface
= lface_from_face_name (f
, face
, 1);
4976 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4977 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4980 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4984 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4986 doc
: /* Return an alist of frame-local faces defined on FRAME.
4987 For internal use only. */)
4991 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4992 return f
->face_alist
;
4996 /* Return a hash code for Lisp string STRING with case ignored. Used
4997 below in computing a hash value for a Lisp face. */
4999 static INLINE
unsigned
5000 hash_string_case_insensitive (string
)
5005 xassert (STRINGP (string
));
5006 for (s
= XSTRING (string
)->data
; *s
; ++s
)
5007 hash
= (hash
<< 1) ^ tolower (*s
);
5012 /* Return a hash code for face attribute vector V. */
5014 static INLINE
unsigned
5018 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5019 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5020 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5021 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5022 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5023 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5024 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5028 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5029 considering charsets/registries). They do if they specify the same
5030 family, point size, weight, width, slant, font, and fontset. Both
5031 LFACE1 and LFACE2 must be fully-specified. */
5034 lface_same_font_attributes_p (lface1
, lface2
)
5035 Lisp_Object
*lface1
, *lface2
;
5037 xassert (lface_fully_specified_p (lface1
)
5038 && lface_fully_specified_p (lface2
));
5039 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
5040 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
5041 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5042 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5043 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5044 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5045 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5046 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5047 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5048 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5049 && ! xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
5050 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
)))
5051 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5052 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5053 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5054 && ! xstricmp (XSTRING (lface1
[LFACE_FONTSET_INDEX
])->data
,
5055 XSTRING (lface2
[LFACE_FONTSET_INDEX
])->data
)))
5061 /***********************************************************************
5063 ***********************************************************************/
5065 /* Allocate and return a new realized face for Lisp face attribute
5068 static struct face
*
5069 make_realized_face (attr
)
5072 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5073 bzero (face
, sizeof *face
);
5074 face
->ascii_face
= face
;
5075 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5080 /* Free realized face FACE, including its X resources. FACE may
5084 free_realized_face (f
, face
)
5090 #ifdef HAVE_WINDOW_SYSTEM
5091 if (FRAME_WINDOW_P (f
))
5093 /* Free fontset of FACE if it is ASCII face. */
5094 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5095 free_face_fontset (f
, face
);
5098 x_free_gc (f
, face
->gc
);
5102 free_face_colors (f
, face
);
5103 x_destroy_bitmap (f
, face
->stipple
);
5105 #endif /* HAVE_WINDOW_SYSTEM */
5112 /* Prepare face FACE for subsequent display on frame F. This
5113 allocated GCs if they haven't been allocated yet or have been freed
5114 by clearing the face cache. */
5117 prepare_face_for_display (f
, face
)
5121 #ifdef HAVE_WINDOW_SYSTEM
5122 xassert (FRAME_WINDOW_P (f
));
5127 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5129 xgcv
.foreground
= face
->foreground
;
5130 xgcv
.background
= face
->background
;
5131 #ifdef HAVE_X_WINDOWS
5132 xgcv
.graphics_exposures
= False
;
5134 /* The font of FACE may be null if we couldn't load it. */
5137 #ifdef HAVE_X_WINDOWS
5138 xgcv
.font
= face
->font
->fid
;
5141 xgcv
.font
= face
->font
;
5144 xgcv
.font
= face
->font
;
5150 #ifdef HAVE_X_WINDOWS
5153 xgcv
.fill_style
= FillOpaqueStippled
;
5154 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5155 mask
|= GCFillStyle
| GCStipple
;
5158 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5161 #endif /* HAVE_WINDOW_SYSTEM */
5165 /***********************************************************************
5167 ***********************************************************************/
5169 /* Return a new face cache for frame F. */
5171 static struct face_cache
*
5175 struct face_cache
*c
;
5178 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5179 bzero (c
, sizeof *c
);
5180 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5181 c
->buckets
= (struct face
**) xmalloc (size
);
5182 bzero (c
->buckets
, size
);
5184 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5186 c
->menu_face_changed_p
= menu_face_changed_default
;
5191 /* Clear out all graphics contexts for all realized faces, except for
5192 the basic faces. This should be done from time to time just to avoid
5193 keeping too many graphics contexts that are no longer needed. */
5197 struct face_cache
*c
;
5199 if (c
&& FRAME_WINDOW_P (c
->f
))
5201 #ifdef HAVE_WINDOW_SYSTEM
5203 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5205 struct face
*face
= c
->faces_by_id
[i
];
5206 if (face
&& face
->gc
)
5208 x_free_gc (c
->f
, face
->gc
);
5212 #endif /* HAVE_WINDOW_SYSTEM */
5217 /* Free all realized faces in face cache C, including basic faces. C
5218 may be null. If faces are freed, make sure the frame's current
5219 matrix is marked invalid, so that a display caused by an expose
5220 event doesn't try to use faces we destroyed. */
5223 free_realized_faces (c
)
5224 struct face_cache
*c
;
5229 struct frame
*f
= c
->f
;
5231 /* We must block input here because we can't process X events
5232 safely while only some faces are freed, or when the frame's
5233 current matrix still references freed faces. */
5236 for (i
= 0; i
< c
->used
; ++i
)
5238 free_realized_face (f
, c
->faces_by_id
[i
]);
5239 c
->faces_by_id
[i
] = NULL
;
5243 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5244 bzero (c
->buckets
, size
);
5246 /* Must do a thorough redisplay the next time. Mark current
5247 matrices as invalid because they will reference faces freed
5248 above. This function is also called when a frame is
5249 destroyed. In this case, the root window of F is nil. */
5250 if (WINDOWP (f
->root_window
))
5252 clear_current_matrices (f
);
5253 ++windows_or_buffers_changed
;
5261 /* Free all realized faces that are using FONTSET on frame F. */
5264 free_realized_faces_for_fontset (f
, fontset
)
5268 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5272 /* We must block input here because we can't process X events safely
5273 while only some faces are freed, or when the frame's current
5274 matrix still references freed faces. */
5277 for (i
= 0; i
< cache
->used
; i
++)
5279 face
= cache
->faces_by_id
[i
];
5281 && face
->fontset
== fontset
)
5283 uncache_face (cache
, face
);
5284 free_realized_face (f
, face
);
5288 /* Must do a thorough redisplay the next time. Mark current
5289 matrices as invalid because they will reference faces freed
5290 above. This function is also called when a frame is destroyed.
5291 In this case, the root window of F is nil. */
5292 if (WINDOWP (f
->root_window
))
5294 clear_current_matrices (f
);
5295 ++windows_or_buffers_changed
;
5302 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5303 This is done after attributes of a named face have been changed,
5304 because we can't tell which realized faces depend on that face. */
5307 free_all_realized_faces (frame
)
5313 FOR_EACH_FRAME (rest
, frame
)
5314 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5317 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5321 /* Free face cache C and faces in it, including their X resources. */
5325 struct face_cache
*c
;
5329 free_realized_faces (c
);
5331 xfree (c
->faces_by_id
);
5337 /* Cache realized face FACE in face cache C. HASH is the hash value
5338 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5339 FACE), insert the new face to the beginning of the collision list
5340 of the face hash table of C. Otherwise, add the new face to the
5341 end of the collision list. This way, lookup_face can quickly find
5342 that a requested face is not cached. */
5345 cache_face (c
, face
, hash
)
5346 struct face_cache
*c
;
5350 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5354 if (face
->ascii_face
!= face
)
5356 struct face
*last
= c
->buckets
[i
];
5367 c
->buckets
[i
] = face
;
5368 face
->prev
= face
->next
= NULL
;
5374 face
->next
= c
->buckets
[i
];
5376 face
->next
->prev
= face
;
5377 c
->buckets
[i
] = face
;
5380 /* Find a free slot in C->faces_by_id and use the index of the free
5381 slot as FACE->id. */
5382 for (i
= 0; i
< c
->used
; ++i
)
5383 if (c
->faces_by_id
[i
] == NULL
)
5387 /* Maybe enlarge C->faces_by_id. */
5388 if (i
== c
->used
&& c
->used
== c
->size
)
5390 int new_size
= 2 * c
->size
;
5391 int sz
= new_size
* sizeof *c
->faces_by_id
;
5392 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5397 /* Check that FACE got a unique id. */
5402 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5403 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5409 #endif /* GLYPH_DEBUG */
5411 c
->faces_by_id
[i
] = face
;
5417 /* Remove face FACE from cache C. */
5420 uncache_face (c
, face
)
5421 struct face_cache
*c
;
5424 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5427 face
->prev
->next
= face
->next
;
5429 c
->buckets
[i
] = face
->next
;
5432 face
->next
->prev
= face
->prev
;
5434 c
->faces_by_id
[face
->id
] = NULL
;
5435 if (face
->id
== c
->used
)
5440 /* Look up a realized face with face attributes ATTR in the face cache
5441 of frame F. The face will be used to display ASCII characters.
5442 Value is the ID of the face found. If no suitable face is found,
5443 realize a new one. */
5446 lookup_face (f
, attr
)
5450 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5455 xassert (cache
!= NULL
);
5456 check_lface_attrs (attr
);
5458 /* Look up ATTR in the face cache. */
5459 hash
= lface_hash (attr
);
5460 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5462 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5464 if (face
->ascii_face
!= face
)
5466 /* There's no more ASCII face. */
5470 if (face
->hash
== hash
5471 && lface_equal_p (face
->lface
, attr
))
5475 /* If not found, realize a new face. */
5477 face
= realize_face (cache
, attr
, -1);
5480 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5481 #endif /* GLYPH_DEBUG */
5487 /* Look up a realized face that has the same attributes as BASE_FACE
5488 except for the font in the face cache of frame F. If FONT_ID is
5489 not negative, it is an ID number of an already opened font that is
5490 used by the face. If FONT_ID is negative, the face has no font.
5491 Value is the ID of the face found. If no suitable face is found,
5492 realize a new one. */
5495 lookup_non_ascii_face (f
, font_id
, base_face
)
5498 struct face
*base_face
;
5500 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5505 xassert (cache
!= NULL
);
5506 base_face
= base_face
->ascii_face
;
5507 hash
= lface_hash (base_face
->lface
);
5508 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5510 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5512 if (face
->ascii_face
== face
)
5514 if (face
->ascii_face
== base_face
5515 && face
->font_info_id
== font_id
)
5519 /* If not found, realize a new face. */
5521 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5524 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5525 #endif /* GLYPH_DEBUG */
5531 /* Return the face id of the realized face for named face SYMBOL on
5532 frame F suitable for displaying ASCII characters. Value is -1 if
5533 the face couldn't be determined, which might happen if the default
5534 face isn't realized and cannot be realized. */
5537 lookup_named_face (f
, symbol
)
5541 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5542 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5543 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5545 if (default_face
== NULL
)
5547 if (!realize_basic_faces (f
))
5549 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5552 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5553 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5554 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5555 return lookup_face (f
, attrs
);
5559 /* Return the ID of the realized ASCII face of Lisp face with ID
5560 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5563 ascii_face_of_lisp_face (f
, lface_id
)
5569 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5571 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5572 face_id
= lookup_named_face (f
, face_name
);
5581 /* Return a face for charset ASCII that is like the face with id
5582 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5583 STEPS < 0 means larger. Value is the id of the face. */
5586 smaller_face (f
, face_id
, steps
)
5590 #ifdef HAVE_WINDOW_SYSTEM
5592 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5593 int pt
, last_pt
, last_height
;
5596 struct face
*new_face
;
5598 /* If not called for an X frame, just return the original face. */
5599 if (FRAME_TERMCAP_P (f
))
5602 /* Try in increments of 1/2 pt. */
5603 delta
= steps
< 0 ? 5 : -5;
5604 steps
= abs (steps
);
5606 face
= FACE_FROM_ID (f
, face_id
);
5607 bcopy (face
->lface
, attrs
, sizeof attrs
);
5608 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5609 new_face_id
= face_id
;
5610 last_height
= FONT_HEIGHT (face
->font
);
5614 /* Give up if we cannot find a font within 10pt. */
5615 && abs (last_pt
- pt
) < 100)
5617 /* Look up a face for a slightly smaller/larger font. */
5619 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5620 new_face_id
= lookup_face (f
, attrs
);
5621 new_face
= FACE_FROM_ID (f
, new_face_id
);
5623 /* If height changes, count that as one step. */
5624 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5625 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5628 last_height
= FONT_HEIGHT (new_face
->font
);
5635 #else /* not HAVE_WINDOW_SYSTEM */
5639 #endif /* not HAVE_WINDOW_SYSTEM */
5643 /* Return a face for charset ASCII that is like the face with id
5644 FACE_ID on frame F, but has height HEIGHT. */
5647 face_with_height (f
, face_id
, height
)
5652 #ifdef HAVE_WINDOW_SYSTEM
5654 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5656 if (FRAME_TERMCAP_P (f
)
5660 face
= FACE_FROM_ID (f
, face_id
);
5661 bcopy (face
->lface
, attrs
, sizeof attrs
);
5662 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5663 face_id
= lookup_face (f
, attrs
);
5664 #endif /* HAVE_WINDOW_SYSTEM */
5670 /* Return the face id of the realized face for named face SYMBOL on
5671 frame F suitable for displaying ASCII characters, and use
5672 attributes of the face FACE_ID for attributes that aren't
5673 completely specified by SYMBOL. This is like lookup_named_face,
5674 except that the default attributes come from FACE_ID, not from the
5675 default face. FACE_ID is assumed to be already realized. */
5678 lookup_derived_face (f
, symbol
, face_id
)
5683 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5684 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5685 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5690 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5691 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5692 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5693 return lookup_face (f
, attrs
);
5696 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5697 Sface_attributes_as_vector
, 1, 1, 0,
5698 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5703 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5705 merge_face_vector_with_property (XFRAME (selected_frame
),
5706 XVECTOR (lface
)->contents
,
5713 /***********************************************************************
5715 ***********************************************************************/
5717 DEFUN ("internal-set-font-selection-order",
5718 Finternal_set_font_selection_order
,
5719 Sinternal_set_font_selection_order
, 1, 1, 0,
5720 doc
: /* Set font selection order for face font selection to ORDER.
5721 ORDER must be a list of length 4 containing the symbols `:width',
5722 `:height', `:weight', and `:slant'. Face attributes appearing
5723 first in ORDER are matched first, e.g. if `:height' appears before
5724 `:weight' in ORDER, font selection first tries to find a font with
5725 a suitable height, and then tries to match the font weight.
5732 int indices
[DIM (font_sort_order
)];
5735 bzero (indices
, sizeof indices
);
5739 CONSP (list
) && i
< DIM (indices
);
5740 list
= XCDR (list
), ++i
)
5742 Lisp_Object attr
= XCAR (list
);
5745 if (EQ (attr
, QCwidth
))
5747 else if (EQ (attr
, QCheight
))
5748 xlfd
= XLFD_POINT_SIZE
;
5749 else if (EQ (attr
, QCweight
))
5751 else if (EQ (attr
, QCslant
))
5756 if (indices
[i
] != 0)
5761 if (!NILP (list
) || i
!= DIM (indices
))
5762 signal_error ("Invalid font sort order", order
);
5763 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5764 if (indices
[i
] == 0)
5765 signal_error ("Invalid font sort order", order
);
5767 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5769 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5770 free_all_realized_faces (Qnil
);
5777 DEFUN ("internal-set-alternative-font-family-alist",
5778 Finternal_set_alternative_font_family_alist
,
5779 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5780 doc
: /* Define alternative font families to try in face font selection.
5781 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5782 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5783 be found. Value is ALIST. */)
5788 Vface_alternative_font_family_alist
= alist
;
5789 free_all_realized_faces (Qnil
);
5794 DEFUN ("internal-set-alternative-font-registry-alist",
5795 Finternal_set_alternative_font_registry_alist
,
5796 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5797 doc
: /* Define alternative font registries to try in face font selection.
5798 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5799 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5800 be found. Value is ALIST. */)
5805 Vface_alternative_font_registry_alist
= alist
;
5806 free_all_realized_faces (Qnil
);
5811 #ifdef HAVE_WINDOW_SYSTEM
5813 /* Value is non-zero if FONT is the name of a scalable font. The
5814 X11R6 XLFD spec says that point size, pixel size, and average width
5815 are zero for scalable fonts. Intlfonts contain at least one
5816 scalable font ("*-muleindian-1") for which this isn't true, so we
5817 just test average width. */
5820 font_scalable_p (font
)
5821 struct font_name
*font
;
5823 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5824 return (*s
== '0' && *(s
+ 1) == '\0')
5826 /* Windows implementation of XLFD is slightly broken for backward
5827 compatibility with previous broken versions, so test for
5828 wildcards as well as 0. */
5835 /* Ignore the difference of font point size less than this value. */
5837 #define FONT_POINT_SIZE_QUANTUM 5
5839 /* Value is non-zero if FONT1 is a better match for font attributes
5840 VALUES than FONT2. VALUES is an array of face attribute values in
5841 font sort order. COMPARE_PT_P zero means don't compare point
5842 sizes. AVGWIDTH, if not zero, is a specified font average width
5846 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5848 struct font_name
*font1
, *font2
;
5849 int compare_pt_p
, avgwidth
;
5853 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5855 int xlfd_idx
= font_sort_order
[i
];
5857 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5861 if (xlfd_idx
== XLFD_POINT_SIZE
)
5863 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
5864 / font1
->resizing_ratio
));
5865 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
5866 / font2
->resizing_ratio
));
5867 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5872 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5873 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5876 if (delta1
> delta2
)
5878 else if (delta1
< delta2
)
5882 /* The difference may be equal because, e.g., the face
5883 specifies `italic' but we have only `regular' and
5884 `oblique'. Prefer `oblique' in this case. */
5885 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5886 && font1
->numeric
[xlfd_idx
] > values
[i
]
5887 && font2
->numeric
[xlfd_idx
] < values
[i
])
5895 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5896 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5897 if (delta1
> delta2
)
5899 else if (delta1
< delta2
)
5903 return font1
->registry_priority
< font2
->registry_priority
;
5907 /* Value is non-zero if FONT is an exact match for face attributes in
5908 SPECIFIED. SPECIFIED is an array of face attribute values in font
5909 sort order. AVGWIDTH, if non-zero, is an average width to compare
5913 exact_face_match_p (specified
, font
, avgwidth
)
5915 struct font_name
*font
;
5920 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5921 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5924 return (i
== DIM (font_sort_order
)
5926 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5930 /* Value is the name of a scaled font, generated from scalable font
5931 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5932 Value is allocated from heap. */
5935 build_scalable_font_name (f
, font
, specified_pt
)
5937 struct font_name
*font
;
5940 char point_size
[20], pixel_size
[20];
5942 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5945 /* If scalable font is for a specific resolution, compute
5946 the point size we must specify from the resolution of
5947 the display and the specified resolution of the font. */
5948 if (font
->numeric
[XLFD_RESY
] != 0)
5950 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5951 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5956 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5958 /* We may need a font of the different size. */
5959 pixel_value
*= font
->resizing_ratio
;
5961 /* Set pixel size. */
5962 sprintf (pixel_size
, "%d", pixel_value
);
5963 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5964 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5966 /* We don't have to change POINT_SIZE, RESX, and RESY of the font
5969 /* Set point size of the font. */
5970 sprintf (point_size
, "%d", (int) pt
);
5971 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5972 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5974 /* If font doesn't specify its resolution, use the
5975 resolution of the display. */
5976 if (font
->numeric
[XLFD_RESY
] == 0)
5979 sprintf (buffer
, "%d", (int) resy
);
5980 font
->fields
[XLFD_RESY
] = buffer
;
5981 font
->numeric
[XLFD_RESY
] = resy
;
5984 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5987 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5988 sprintf (buffer
, "%d", resx
);
5989 font
->fields
[XLFD_RESX
] = buffer
;
5990 font
->numeric
[XLFD_RESX
] = resx
;
5994 return build_font_name (font
);
5998 /* Value is non-zero if we are allowed to use scalable font FONT. We
5999 can't run a Lisp function here since this function may be called
6000 with input blocked. */
6003 may_use_scalable_font_p (font
)
6006 if (EQ (Vscalable_fonts_allowed
, Qt
))
6008 else if (CONSP (Vscalable_fonts_allowed
))
6010 Lisp_Object tail
, regexp
;
6012 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
6014 regexp
= XCAR (tail
);
6015 if (STRINGP (regexp
)
6016 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6026 /* Return the name of the best matching font for face attributes ATTRS
6027 in the array of font_name structures FONTS which contains NFONTS
6028 elements. WIDTH_RATIO is a factor with which to multiply average
6029 widths if ATTRS specifies such a width.
6031 Value is a font name which is allocated from the heap. FONTS is
6032 freed by this function. */
6035 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
6038 struct font_name
*fonts
;
6043 struct font_name
*best
;
6046 int exact_p
, avgwidth
;
6051 /* Make specified font attributes available in `specified',
6052 indexed by sort order. */
6053 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6055 int xlfd_idx
= font_sort_order
[i
];
6057 if (xlfd_idx
== XLFD_SWIDTH
)
6058 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6059 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6060 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6061 else if (xlfd_idx
== XLFD_WEIGHT
)
6062 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6063 else if (xlfd_idx
== XLFD_SLANT
)
6064 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6069 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6071 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6075 /* Start with the first non-scalable font in the list. */
6076 for (i
= 0; i
< nfonts
; ++i
)
6077 if (!font_scalable_p (fonts
+ i
))
6080 /* Find the best match among the non-scalable fonts. */
6085 for (i
= 1; i
< nfonts
; ++i
)
6086 if (!font_scalable_p (fonts
+ i
)
6087 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6091 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6100 /* Unless we found an exact match among non-scalable fonts, see if
6101 we can find a better match among scalable fonts. */
6104 /* A scalable font is better if
6106 1. its weight, slant, swidth attributes are better, or.
6108 2. the best non-scalable font doesn't have the required
6109 point size, and the scalable fonts weight, slant, swidth
6112 int non_scalable_has_exact_height_p
;
6114 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6115 non_scalable_has_exact_height_p
= 1;
6117 non_scalable_has_exact_height_p
= 0;
6119 for (i
= 0; i
< nfonts
; ++i
)
6120 if (font_scalable_p (fonts
+ i
))
6123 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6124 || (!non_scalable_has_exact_height_p
6125 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6130 if (font_scalable_p (best
))
6131 font_name
= build_scalable_font_name (f
, best
, pt
);
6133 font_name
= build_font_name (best
);
6135 /* Free font_name structures. */
6136 free_font_names (fonts
, nfonts
);
6142 /* Get a list of matching fonts on frame F, considering FAMILY
6143 and alternative font families from Vface_alternative_font_registry_alist.
6145 FAMILY is the font family whose alternatives are considered.
6147 REGISTRY, if a string, specifies a font registry and encoding to
6148 match. A value of nil means include fonts of any registry and
6151 Return in *FONTS a pointer to a vector of font_name structures for
6152 the fonts matched. Value is the number of fonts found. */
6155 try_alternative_families (f
, family
, registry
, fonts
)
6157 Lisp_Object family
, registry
;
6158 struct font_name
**fonts
;
6163 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6166 /* Try alternative font families. */
6167 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6170 for (alter
= XCDR (alter
);
6171 CONSP (alter
) && nfonts
== 0;
6172 alter
= XCDR (alter
))
6174 if (STRINGP (XCAR (alter
)))
6175 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6179 /* Try scalable fonts before giving up. */
6180 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6182 int count
= BINDING_STACK_SIZE ();
6183 specbind (Qscalable_fonts_allowed
, Qt
);
6184 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6185 unbind_to (count
, Qnil
);
6192 /* Get a list of matching fonts on frame F.
6194 PATTERN, if a string, specifies a font name pattern to match while
6195 ignoring FAMILY and REGISTRY.
6197 FAMILY, if a list, specifies a list of font families to try.
6199 REGISTRY, if a list, specifies a list of font registries and
6202 Return in *FONTS a pointer to a vector of font_name structures for
6203 the fonts matched. Value is the number of fonts found. */
6206 try_font_list (f
, pattern
, family
, registry
, fonts
)
6208 Lisp_Object pattern
, family
, registry
;
6209 struct font_name
**fonts
;
6213 if (STRINGP (pattern
))
6214 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6220 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6222 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6223 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6225 /* Try font family of the default face or "fixed". */
6226 if (nfonts
== 0 && !NILP (family
))
6228 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6230 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6232 family
= build_string ("fixed");
6233 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6236 /* Try any family with the given registry. */
6237 if (nfonts
== 0 && !NILP (family
))
6238 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6245 /* Return the fontset id of the base fontset name or alias name given
6246 by the fontset attribute of ATTRS. Value is -1 if the fontset
6247 attribute of ATTRS doesn't name a fontset. */
6250 face_fontset (attrs
)
6256 name
= attrs
[LFACE_FONTSET_INDEX
];
6257 if (!STRINGP (name
))
6259 return fs_query_fontset (name
, 0);
6263 /* Choose a name of font to use on frame F to display characters with
6264 Lisp face attributes specified by ATTRS. The font name is
6265 determined by the font-related attributes in ATTRS and FONT-SPEC
6268 When we are choosing a font for ASCII characters, FONT-SPEC is
6269 always nil. Otherwise FONT-SPEC is a list
6270 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6271 or a string specifying a font name pattern.
6273 Value is the font name which is allocated from the heap and must be
6274 freed by the caller. */
6277 choose_face_font (f
, attrs
, font_spec
)
6280 Lisp_Object font_spec
;
6282 Lisp_Object pattern
, family
, adstyle
, registry
;
6283 char *font_name
= NULL
;
6284 struct font_name
*fonts
;
6287 /* If we are choosing an ASCII font and a font name is explicitly
6288 specified in ATTRS, return it. */
6290 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6291 return xstrdup (XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6294 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6297 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6299 if (VECTORP (font_spec
))
6302 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6303 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6304 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6305 registry
= AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
);
6307 else if (STRINGP (font_spec
))
6309 pattern
= font_spec
;
6318 registry
= build_string ("iso8859-1");
6321 /* Get a list of fonts matching that pattern and choose the
6322 best match for the specified face attributes from it. */
6323 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6324 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
));
6328 #endif /* HAVE_WINDOW_SYSTEM */
6332 /***********************************************************************
6334 ***********************************************************************/
6336 /* Realize basic faces on frame F. Value is zero if frame parameters
6337 of F don't contain enough information needed to realize the default
6341 realize_basic_faces (f
)
6345 int count
= BINDING_STACK_SIZE ();
6347 /* Block input here so that we won't be surprised by an X expose
6348 event, for instance, without having the faces set up. */
6350 specbind (Qscalable_fonts_allowed
, Qt
);
6352 if (realize_default_face (f
))
6354 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6355 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6356 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6357 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6358 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6359 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6360 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6361 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6362 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6363 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6365 /* Reflect changes in the `menu' face in menu bars. */
6366 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6368 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6369 #ifdef USE_X_TOOLKIT
6370 x_update_menu_appearance (f
);
6377 unbind_to (count
, Qnil
);
6383 /* Realize the default face on frame F. If the face is not fully
6384 specified, make it fully-specified. Attributes of the default face
6385 that are not explicitly specified are taken from frame parameters. */
6388 realize_default_face (f
)
6391 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6393 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6394 Lisp_Object frame_font
;
6397 /* If the `default' face is not yet known, create it. */
6398 lface
= lface_from_face_name (f
, Qdefault
, 0);
6402 XSETFRAME (frame
, f
);
6403 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6406 #ifdef HAVE_WINDOW_SYSTEM
6407 if (FRAME_WINDOW_P (f
))
6409 /* Set frame_font to the value of the `font' frame parameter. */
6410 frame_font
= Fassq (Qfont
, f
->param_alist
);
6411 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6412 frame_font
= XCDR (frame_font
);
6413 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6415 #endif /* HAVE_WINDOW_SYSTEM */
6417 if (!FRAME_WINDOW_P (f
))
6419 LFACE_FAMILY (lface
) = build_string ("default");
6420 LFACE_SWIDTH (lface
) = Qnormal
;
6421 LFACE_HEIGHT (lface
) = make_number (1);
6422 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6423 LFACE_WEIGHT (lface
) = Qnormal
;
6424 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6425 LFACE_SLANT (lface
) = Qnormal
;
6426 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6429 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6430 LFACE_UNDERLINE (lface
) = Qnil
;
6432 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6433 LFACE_OVERLINE (lface
) = Qnil
;
6435 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6436 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6438 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6439 LFACE_BOX (lface
) = Qnil
;
6441 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6442 LFACE_INVERSE (lface
) = Qnil
;
6444 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6446 /* This function is called so early that colors are not yet
6447 set in the frame parameter list. */
6448 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6450 if (CONSP (color
) && STRINGP (XCDR (color
)))
6451 LFACE_FOREGROUND (lface
) = XCDR (color
);
6452 else if (FRAME_WINDOW_P (f
))
6454 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6455 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6460 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6462 /* This function is called so early that colors are not yet
6463 set in the frame parameter list. */
6464 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6465 if (CONSP (color
) && STRINGP (XCDR (color
)))
6466 LFACE_BACKGROUND (lface
) = XCDR (color
);
6467 else if (FRAME_WINDOW_P (f
))
6469 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6470 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6475 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6476 LFACE_STIPPLE (lface
) = Qnil
;
6478 /* Realize the face; it must be fully-specified now. */
6479 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6480 check_lface (lface
);
6481 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6482 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6487 /* Realize basic faces other than the default face in face cache C.
6488 SYMBOL is the face name, ID is the face id the realized face must
6489 have. The default face must have been realized already. */
6492 realize_named_face (f
, symbol
, id
)
6497 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6498 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6499 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6500 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6501 struct face
*new_face
;
6503 /* The default face must exist and be fully specified. */
6504 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6505 check_lface_attrs (attrs
);
6506 xassert (lface_fully_specified_p (attrs
));
6508 /* If SYMBOL isn't know as a face, create it. */
6512 XSETFRAME (frame
, f
);
6513 lface
= Finternal_make_lisp_face (symbol
, frame
);
6516 /* Merge SYMBOL's face with the default face. */
6517 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6518 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6520 /* Realize the face. */
6521 new_face
= realize_face (c
, attrs
, id
);
6525 /* Realize the fully-specified face with attributes ATTRS in face
6526 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6527 non-negative, it is an ID of face to remove before caching the new
6528 face. Value is a pointer to the newly created realized face. */
6530 static struct face
*
6531 realize_face (cache
, attrs
, former_face_id
)
6532 struct face_cache
*cache
;
6538 /* LFACE must be fully specified. */
6539 xassert (cache
!= NULL
);
6540 check_lface_attrs (attrs
);
6542 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6544 /* Remove the former face. */
6545 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6546 uncache_face (cache
, former_face
);
6547 free_realized_face (cache
->f
, former_face
);
6550 if (FRAME_WINDOW_P (cache
->f
))
6551 face
= realize_x_face (cache
, attrs
);
6552 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6553 face
= realize_tty_face (cache
, attrs
);
6557 /* Insert the new face. */
6558 cache_face (cache
, face
, lface_hash (attrs
));
6563 /* Realize the fully-specified face that has the same attributes as
6564 BASE_FACE except for the font on frame F. If FONT_ID is not
6565 negative, it is an ID number of an already opened font that should
6566 be used by the face. If FONT_ID is negative, the face has no font,
6567 i.e., characters are displayed by empty boxes. */
6569 static struct face
*
6570 realize_non_ascii_face (f
, font_id
, base_face
)
6573 struct face
*base_face
;
6575 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6577 struct font_info
*font_info
;
6579 face
= (struct face
*) xmalloc (sizeof *face
);
6583 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6584 face
->colors_copied_bitwise_p
= 1;
6586 face
->font_info_id
= font_id
;
6589 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6590 face
->font
= font_info
->font
;
6591 face
->font_name
= font_info
->full_name
;
6596 face
->font_name
= NULL
;
6601 cache_face (cache
, face
, face
->hash
);
6607 /* Realize the fully-specified face with attributes ATTRS in face
6608 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6609 the new face doesn't share font with the default face, a fontname
6610 is allocated from the heap and set in `font_name' of the new face,
6611 but it is not yet loaded here. Value is a pointer to the newly
6612 created realized face. */
6614 static struct face
*
6615 realize_x_face (cache
, attrs
)
6616 struct face_cache
*cache
;
6619 #ifdef HAVE_WINDOW_SYSTEM
6620 struct face
*face
, *default_face
;
6622 Lisp_Object stipple
, overline
, strike_through
, box
;
6624 xassert (FRAME_WINDOW_P (cache
->f
));
6626 /* Allocate a new realized face. */
6627 face
= make_realized_face (attrs
);
6628 face
->ascii_face
= face
;
6632 /* Determine the font to use. Most of the time, the font will be
6633 the same as the font of the default face, so try that first. */
6634 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6636 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6638 face
->font
= default_face
->font
;
6639 face
->font_info_id
= default_face
->font_info_id
;
6640 face
->font_name
= default_face
->font_name
;
6642 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6646 /* If the face attribute ATTRS specifies a fontset, use it as
6647 the base of a new realized fontset. Otherwise, use the same
6648 base fontset as of the default face. The base determines
6649 registry and encoding of a font. It may also determine
6650 foundry and family. The other fields of font name pattern
6651 are constructed from ATTRS. */
6652 int fontset
= face_fontset (attrs
);
6654 /* If we are realizing the default face, ATTRS should specify a
6655 fontset. In other words, if FONTSET is -1, we are not
6656 realizing the default face, thus the default face should have
6657 already been realized. */
6659 fontset
= default_face
->fontset
;
6662 face
->font
= NULL
; /* to force realize_face to load font */
6665 /* Load the font if it is specified in ATTRS. This fixes
6666 changing frame font on the Mac. */
6667 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6669 struct font_info
*font_info
=
6670 FS_LOAD_FONT (f
, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6672 face
->font
= font_info
->font
;
6676 load_face_font (f
, face
);
6677 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6680 /* Load colors, and set remaining attributes. */
6682 load_face_colors (f
, face
, attrs
);
6685 box
= attrs
[LFACE_BOX_INDEX
];
6688 /* A simple box of line width 1 drawn in color given by
6690 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6692 face
->box
= FACE_SIMPLE_BOX
;
6693 face
->box_line_width
= 1;
6695 else if (INTEGERP (box
))
6697 /* Simple box of specified line width in foreground color of the
6699 xassert (XINT (box
) != 0);
6700 face
->box
= FACE_SIMPLE_BOX
;
6701 face
->box_line_width
= XINT (box
);
6702 face
->box_color
= face
->foreground
;
6703 face
->box_color_defaulted_p
= 1;
6705 else if (CONSP (box
))
6707 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6708 being one of `raised' or `sunken'. */
6709 face
->box
= FACE_SIMPLE_BOX
;
6710 face
->box_color
= face
->foreground
;
6711 face
->box_color_defaulted_p
= 1;
6712 face
->box_line_width
= 1;
6716 Lisp_Object keyword
, value
;
6718 keyword
= XCAR (box
);
6726 if (EQ (keyword
, QCline_width
))
6728 if (INTEGERP (value
) && XINT (value
) != 0)
6729 face
->box_line_width
= XINT (value
);
6731 else if (EQ (keyword
, QCcolor
))
6733 if (STRINGP (value
))
6735 face
->box_color
= load_color (f
, face
, value
,
6737 face
->use_box_color_for_shadows_p
= 1;
6740 else if (EQ (keyword
, QCstyle
))
6742 if (EQ (value
, Qreleased_button
))
6743 face
->box
= FACE_RAISED_BOX
;
6744 else if (EQ (value
, Qpressed_button
))
6745 face
->box
= FACE_SUNKEN_BOX
;
6750 /* Text underline, overline, strike-through. */
6752 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6754 /* Use default color (same as foreground color). */
6755 face
->underline_p
= 1;
6756 face
->underline_defaulted_p
= 1;
6757 face
->underline_color
= 0;
6759 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6761 /* Use specified color. */
6762 face
->underline_p
= 1;
6763 face
->underline_defaulted_p
= 0;
6764 face
->underline_color
6765 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6766 LFACE_UNDERLINE_INDEX
);
6768 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6770 face
->underline_p
= 0;
6771 face
->underline_defaulted_p
= 0;
6772 face
->underline_color
= 0;
6775 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6776 if (STRINGP (overline
))
6778 face
->overline_color
6779 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6780 LFACE_OVERLINE_INDEX
);
6781 face
->overline_p
= 1;
6783 else if (EQ (overline
, Qt
))
6785 face
->overline_color
= face
->foreground
;
6786 face
->overline_color_defaulted_p
= 1;
6787 face
->overline_p
= 1;
6790 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6791 if (STRINGP (strike_through
))
6793 face
->strike_through_color
6794 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6795 LFACE_STRIKE_THROUGH_INDEX
);
6796 face
->strike_through_p
= 1;
6798 else if (EQ (strike_through
, Qt
))
6800 face
->strike_through_color
= face
->foreground
;
6801 face
->strike_through_color_defaulted_p
= 1;
6802 face
->strike_through_p
= 1;
6805 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6806 if (!NILP (stipple
))
6807 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6809 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6811 #endif /* HAVE_WINDOW_SYSTEM */
6815 /* Map a specified color of face FACE on frame F to a tty color index.
6816 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6817 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6818 default foreground/background colors. */
6821 map_tty_color (f
, face
, idx
, defaulted
)
6824 enum lface_attribute_index idx
;
6827 Lisp_Object frame
, color
, def
;
6828 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6829 unsigned long default_pixel
, default_other_pixel
, pixel
;
6831 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6835 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6836 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6840 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6841 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6844 XSETFRAME (frame
, f
);
6845 color
= face
->lface
[idx
];
6848 && XSTRING (color
)->size
6849 && CONSP (Vtty_defined_color_alist
)
6850 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6853 /* Associations in tty-defined-color-alist are of the form
6854 (NAME INDEX R G B). We need the INDEX part. */
6855 pixel
= XINT (XCAR (XCDR (def
)));
6858 if (pixel
== default_pixel
&& STRINGP (color
))
6860 pixel
= load_color (f
, face
, color
, idx
);
6862 #if defined (MSDOS) || defined (WINDOWSNT)
6863 /* If the foreground of the default face is the default color,
6864 use the foreground color defined by the frame. */
6866 if (FRAME_MSDOS_P (f
))
6869 if (pixel
== default_pixel
6870 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6873 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6875 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6876 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6879 else if (pixel
== default_other_pixel
)
6882 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6884 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6885 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6891 #endif /* MSDOS or WINDOWSNT */
6895 face
->foreground
= pixel
;
6897 face
->background
= pixel
;
6901 /* Realize the fully-specified face with attributes ATTRS in face
6902 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6903 Value is a pointer to the newly created realized face. */
6905 static struct face
*
6906 realize_tty_face (cache
, attrs
)
6907 struct face_cache
*cache
;
6912 int face_colors_defaulted
= 0;
6913 struct frame
*f
= cache
->f
;
6915 /* Frame must be a termcap frame. */
6916 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6918 /* Allocate a new realized face. */
6919 face
= make_realized_face (attrs
);
6920 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6922 /* Map face attributes to TTY appearances. We map slant to
6923 dimmed text because we want italic text to appear differently
6924 and because dimmed text is probably used infrequently. */
6925 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6926 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6928 if (weight
> XLFD_WEIGHT_MEDIUM
)
6929 face
->tty_bold_p
= 1;
6930 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6931 face
->tty_dim_p
= 1;
6932 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6933 face
->tty_underline_p
= 1;
6934 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6935 face
->tty_reverse_p
= 1;
6937 /* Map color names to color indices. */
6938 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6939 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6941 /* Swap colors if face is inverse-video. If the colors are taken
6942 from the frame colors, they are already inverted, since the
6943 frame-creation function calls x-handle-reverse-video. */
6944 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6946 unsigned long tem
= face
->foreground
;
6947 face
->foreground
= face
->background
;
6948 face
->background
= tem
;
6951 if (tty_suppress_bold_inverse_default_colors_p
6953 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6954 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6955 face
->tty_bold_p
= 0;
6961 DEFUN ("tty-suppress-bold-inverse-default-colors",
6962 Ftty_suppress_bold_inverse_default_colors
,
6963 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6964 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6965 SUPPRESS non-nil means suppress it.
6966 This affects bold faces on TTYs whose foreground is the default background
6967 color of the display and whose background is the default foreground color.
6968 For such faces, the bold face attribute is ignored if this variable
6971 Lisp_Object suppress
;
6973 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6974 ++face_change_count
;
6980 /***********************************************************************
6982 ***********************************************************************/
6984 /* Return the ID of the face to use to display character CH with face
6985 property PROP on frame F in current_buffer. */
6988 compute_char_face (f
, ch
, prop
)
6995 if (NILP (current_buffer
->enable_multibyte_characters
))
7000 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7001 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7005 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7006 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7007 bcopy (face
->lface
, attrs
, sizeof attrs
);
7008 merge_face_vector_with_property (f
, attrs
, prop
);
7009 face_id
= lookup_face (f
, attrs
);
7010 if (! ASCII_CHAR_P (ch
))
7012 face
= FACE_FROM_ID (f
, face_id
);
7013 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7020 /* Return the face ID associated with buffer position POS for
7021 displaying ASCII characters. Return in *ENDPTR the position at
7022 which a different face is needed, as far as text properties and
7023 overlays are concerned. W is a window displaying current_buffer.
7025 REGION_BEG, REGION_END delimit the region, so it can be
7028 LIMIT is a position not to scan beyond. That is to limit the time
7029 this function can take.
7031 If MOUSE is non-zero, use the character's mouse-face, not its face.
7033 The face returned is suitable for displaying ASCII characters. */
7036 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7037 endptr
, limit
, mouse
)
7040 int region_beg
, region_end
;
7045 struct frame
*f
= XFRAME (w
->frame
);
7046 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7047 Lisp_Object prop
, position
;
7049 Lisp_Object
*overlay_vec
;
7052 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7053 Lisp_Object limit1
, end
;
7054 struct face
*default_face
;
7056 /* W must display the current buffer. We could write this function
7057 to use the frame and buffer of W, but right now it doesn't. */
7058 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7060 XSETFRAME (frame
, f
);
7061 XSETFASTINT (position
, pos
);
7064 if (pos
< region_beg
&& region_beg
< endpos
)
7065 endpos
= region_beg
;
7067 /* Get the `face' or `mouse_face' text property at POS, and
7068 determine the next position at which the property changes. */
7069 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7070 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7071 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7073 endpos
= XINT (end
);
7075 /* Look at properties from overlays. */
7080 /* First try with room for 40 overlays. */
7082 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7083 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7084 &next_overlay
, NULL
, 0);
7086 /* If there are more than 40, make enough space for all, and try
7088 if (noverlays
> len
)
7091 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7092 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7093 &next_overlay
, NULL
, 0);
7096 if (next_overlay
< endpos
)
7097 endpos
= next_overlay
;
7102 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7104 /* Optimize common cases where we can use the default face. */
7107 && !(pos
>= region_beg
&& pos
< region_end
))
7108 return DEFAULT_FACE_ID
;
7110 /* Begin with attributes from the default face. */
7111 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7113 /* Merge in attributes specified via text properties. */
7115 merge_face_vector_with_property (f
, attrs
, prop
);
7117 /* Now merge the overlay data. */
7118 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7119 for (i
= 0; i
< noverlays
; i
++)
7124 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7126 merge_face_vector_with_property (f
, attrs
, prop
);
7128 oend
= OVERLAY_END (overlay_vec
[i
]);
7129 oendpos
= OVERLAY_POSITION (oend
);
7130 if (oendpos
< endpos
)
7134 /* If in the region, merge in the region face. */
7135 if (pos
>= region_beg
&& pos
< region_end
)
7137 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7138 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7140 if (region_end
< endpos
)
7141 endpos
= region_end
;
7146 /* Look up a realized face with the given face attributes,
7147 or realize a new one for ASCII characters. */
7148 return lookup_face (f
, attrs
);
7152 /* Compute the face at character position POS in Lisp string STRING on
7153 window W, for ASCII characters.
7155 If STRING is an overlay string, it comes from position BUFPOS in
7156 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7157 not an overlay string. W must display the current buffer.
7158 REGION_BEG and REGION_END give the start and end positions of the
7159 region; both are -1 if no region is visible.
7161 BASE_FACE_ID is the id of a face to merge with. For strings coming
7162 from overlays or the `display' property it is the face at BUFPOS.
7164 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7166 Set *ENDPTR to the next position where to check for faces in
7167 STRING; -1 if the face is constant from POS to the end of the
7170 Value is the id of the face to use. The face returned is suitable
7171 for displaying ASCII characters. */
7174 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7175 region_end
, endptr
, base_face_id
, mouse_p
)
7179 int region_beg
, region_end
;
7181 enum face_id base_face_id
;
7184 Lisp_Object prop
, position
, end
, limit
;
7185 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7186 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7187 struct face
*base_face
;
7188 int multibyte_p
= STRING_MULTIBYTE (string
);
7189 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7191 /* Get the value of the face property at the current position within
7192 STRING. Value is nil if there is no face property. */
7193 XSETFASTINT (position
, pos
);
7194 prop
= Fget_text_property (position
, prop_name
, string
);
7196 /* Get the next position at which to check for faces. Value of end
7197 is nil if face is constant all the way to the end of the string.
7198 Otherwise it is a string position where to check faces next.
7199 Limit is the maximum position up to which to check for property
7200 changes in Fnext_single_property_change. Strings are usually
7201 short, so set the limit to the end of the string. */
7202 XSETFASTINT (limit
, XSTRING (string
)->size
);
7203 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7205 *endptr
= XFASTINT (end
);
7209 base_face
= FACE_FROM_ID (f
, base_face_id
);
7210 xassert (base_face
);
7212 /* Optimize the default case that there is no face property and we
7213 are not in the region. */
7215 && (base_face_id
!= DEFAULT_FACE_ID
7216 /* BUFPOS <= 0 means STRING is not an overlay string, so
7217 that the region doesn't have to be taken into account. */
7219 || bufpos
< region_beg
7220 || bufpos
>= region_end
)
7222 /* We can't realize faces for different charsets differently
7223 if we don't have fonts, so we can stop here if not working
7224 on a window-system frame. */
7225 || !FRAME_WINDOW_P (f
)
7226 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7227 return base_face
->id
;
7229 /* Begin with attributes from the base face. */
7230 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7232 /* Merge in attributes specified via text properties. */
7234 merge_face_vector_with_property (f
, attrs
, prop
);
7236 /* If in the region, merge in the region face. */
7238 && bufpos
>= region_beg
7239 && bufpos
< region_end
)
7241 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7242 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7245 /* Look up a realized face with the given face attributes,
7246 or realize a new one for ASCII characters. */
7247 return lookup_face (f
, attrs
);
7252 /***********************************************************************
7254 ***********************************************************************/
7258 /* Print the contents of the realized face FACE to stderr. */
7261 dump_realized_face (face
)
7264 fprintf (stderr
, "ID: %d\n", face
->id
);
7265 #ifdef HAVE_X_WINDOWS
7266 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7268 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7270 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7271 fprintf (stderr
, "background: 0x%lx (%s)\n",
7273 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7274 fprintf (stderr
, "font_name: %s (%s)\n",
7276 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7277 #ifdef HAVE_X_WINDOWS
7278 fprintf (stderr
, "font = %p\n", face
->font
);
7280 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7281 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7282 fprintf (stderr
, "underline: %d (%s)\n",
7284 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7285 fprintf (stderr
, "hash: %d\n", face
->hash
);
7289 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7297 fprintf (stderr
, "font selection order: ");
7298 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7299 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7300 fprintf (stderr
, "\n");
7302 fprintf (stderr
, "alternative fonts: ");
7303 debug_print (Vface_alternative_font_family_alist
);
7304 fprintf (stderr
, "\n");
7306 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7307 Fdump_face (make_number (i
));
7313 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7315 error ("Not a valid face");
7316 dump_realized_face (face
);
7323 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7324 0, 0, 0, doc
: /* */)
7327 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7328 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7329 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7333 #endif /* GLYPH_DEBUG != 0 */
7337 /***********************************************************************
7339 ***********************************************************************/
7344 Qface
= intern ("face");
7346 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7347 staticpro (&Qbitmap_spec_p
);
7348 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7349 staticpro (&Qframe_update_face_colors
);
7351 /* Lisp face attribute keywords. */
7352 QCfamily
= intern (":family");
7353 staticpro (&QCfamily
);
7354 QCheight
= intern (":height");
7355 staticpro (&QCheight
);
7356 QCweight
= intern (":weight");
7357 staticpro (&QCweight
);
7358 QCslant
= intern (":slant");
7359 staticpro (&QCslant
);
7360 QCunderline
= intern (":underline");
7361 staticpro (&QCunderline
);
7362 QCinverse_video
= intern (":inverse-video");
7363 staticpro (&QCinverse_video
);
7364 QCreverse_video
= intern (":reverse-video");
7365 staticpro (&QCreverse_video
);
7366 QCforeground
= intern (":foreground");
7367 staticpro (&QCforeground
);
7368 QCbackground
= intern (":background");
7369 staticpro (&QCbackground
);
7370 QCstipple
= intern (":stipple");;
7371 staticpro (&QCstipple
);
7372 QCwidth
= intern (":width");
7373 staticpro (&QCwidth
);
7374 QCfont
= intern (":font");
7375 staticpro (&QCfont
);
7376 QCfontset
= intern (":fontset");
7377 staticpro (&QCfontset
);
7378 QCbold
= intern (":bold");
7379 staticpro (&QCbold
);
7380 QCitalic
= intern (":italic");
7381 staticpro (&QCitalic
);
7382 QCoverline
= intern (":overline");
7383 staticpro (&QCoverline
);
7384 QCstrike_through
= intern (":strike-through");
7385 staticpro (&QCstrike_through
);
7386 QCbox
= intern (":box");
7388 QCinherit
= intern (":inherit");
7389 staticpro (&QCinherit
);
7391 /* Symbols used for Lisp face attribute values. */
7392 QCcolor
= intern (":color");
7393 staticpro (&QCcolor
);
7394 QCline_width
= intern (":line-width");
7395 staticpro (&QCline_width
);
7396 QCstyle
= intern (":style");
7397 staticpro (&QCstyle
);
7398 Qreleased_button
= intern ("released-button");
7399 staticpro (&Qreleased_button
);
7400 Qpressed_button
= intern ("pressed-button");
7401 staticpro (&Qpressed_button
);
7402 Qnormal
= intern ("normal");
7403 staticpro (&Qnormal
);
7404 Qultra_light
= intern ("ultra-light");
7405 staticpro (&Qultra_light
);
7406 Qextra_light
= intern ("extra-light");
7407 staticpro (&Qextra_light
);
7408 Qlight
= intern ("light");
7409 staticpro (&Qlight
);
7410 Qsemi_light
= intern ("semi-light");
7411 staticpro (&Qsemi_light
);
7412 Qsemi_bold
= intern ("semi-bold");
7413 staticpro (&Qsemi_bold
);
7414 Qbold
= intern ("bold");
7416 Qextra_bold
= intern ("extra-bold");
7417 staticpro (&Qextra_bold
);
7418 Qultra_bold
= intern ("ultra-bold");
7419 staticpro (&Qultra_bold
);
7420 Qoblique
= intern ("oblique");
7421 staticpro (&Qoblique
);
7422 Qitalic
= intern ("italic");
7423 staticpro (&Qitalic
);
7424 Qreverse_oblique
= intern ("reverse-oblique");
7425 staticpro (&Qreverse_oblique
);
7426 Qreverse_italic
= intern ("reverse-italic");
7427 staticpro (&Qreverse_italic
);
7428 Qultra_condensed
= intern ("ultra-condensed");
7429 staticpro (&Qultra_condensed
);
7430 Qextra_condensed
= intern ("extra-condensed");
7431 staticpro (&Qextra_condensed
);
7432 Qcondensed
= intern ("condensed");
7433 staticpro (&Qcondensed
);
7434 Qsemi_condensed
= intern ("semi-condensed");
7435 staticpro (&Qsemi_condensed
);
7436 Qsemi_expanded
= intern ("semi-expanded");
7437 staticpro (&Qsemi_expanded
);
7438 Qexpanded
= intern ("expanded");
7439 staticpro (&Qexpanded
);
7440 Qextra_expanded
= intern ("extra-expanded");
7441 staticpro (&Qextra_expanded
);
7442 Qultra_expanded
= intern ("ultra-expanded");
7443 staticpro (&Qultra_expanded
);
7444 Qbackground_color
= intern ("background-color");
7445 staticpro (&Qbackground_color
);
7446 Qforeground_color
= intern ("foreground-color");
7447 staticpro (&Qforeground_color
);
7448 Qunspecified
= intern ("unspecified");
7449 staticpro (&Qunspecified
);
7451 Qface_alias
= intern ("face-alias");
7452 staticpro (&Qface_alias
);
7453 Qdefault
= intern ("default");
7454 staticpro (&Qdefault
);
7455 Qtool_bar
= intern ("tool-bar");
7456 staticpro (&Qtool_bar
);
7457 Qregion
= intern ("region");
7458 staticpro (&Qregion
);
7459 Qfringe
= intern ("fringe");
7460 staticpro (&Qfringe
);
7461 Qheader_line
= intern ("header-line");
7462 staticpro (&Qheader_line
);
7463 Qscroll_bar
= intern ("scroll-bar");
7464 staticpro (&Qscroll_bar
);
7465 Qmenu
= intern ("menu");
7467 Qcursor
= intern ("cursor");
7468 staticpro (&Qcursor
);
7469 Qborder
= intern ("border");
7470 staticpro (&Qborder
);
7471 Qmouse
= intern ("mouse");
7472 staticpro (&Qmouse
);
7473 Qmode_line_inactive
= intern ("mode-line-inactive");
7474 staticpro (&Qmode_line_inactive
);
7475 Qtty_color_desc
= intern ("tty-color-desc");
7476 staticpro (&Qtty_color_desc
);
7477 Qtty_color_by_index
= intern ("tty-color-by-index");
7478 staticpro (&Qtty_color_by_index
);
7479 Qtty_color_alist
= intern ("tty-color-alist");
7480 staticpro (&Qtty_color_alist
);
7481 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7482 staticpro (&Qscalable_fonts_allowed
);
7484 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7485 staticpro (&Vparam_value_alist
);
7486 Vface_alternative_font_family_alist
= Qnil
;
7487 staticpro (&Vface_alternative_font_family_alist
);
7488 Vface_alternative_font_registry_alist
= Qnil
;
7489 staticpro (&Vface_alternative_font_registry_alist
);
7491 defsubr (&Sinternal_make_lisp_face
);
7492 defsubr (&Sinternal_lisp_face_p
);
7493 defsubr (&Sinternal_set_lisp_face_attribute
);
7494 #ifdef HAVE_WINDOW_SYSTEM
7495 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7497 defsubr (&Scolor_gray_p
);
7498 defsubr (&Scolor_supported_p
);
7499 defsubr (&Sface_attribute_relative_p
);
7500 defsubr (&Smerge_face_attribute
);
7501 defsubr (&Sinternal_get_lisp_face_attribute
);
7502 defsubr (&Sinternal_lisp_face_attribute_values
);
7503 defsubr (&Sinternal_lisp_face_equal_p
);
7504 defsubr (&Sinternal_lisp_face_empty_p
);
7505 defsubr (&Sinternal_copy_lisp_face
);
7506 defsubr (&Sinternal_merge_in_global_face
);
7507 defsubr (&Sface_font
);
7508 defsubr (&Sframe_face_alist
);
7509 defsubr (&Sinternal_set_font_selection_order
);
7510 defsubr (&Sinternal_set_alternative_font_family_alist
);
7511 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7512 defsubr (&Sface_attributes_as_vector
);
7514 defsubr (&Sdump_face
);
7515 defsubr (&Sshow_face_resources
);
7516 #endif /* GLYPH_DEBUG */
7517 defsubr (&Sclear_face_cache
);
7518 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7520 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7521 defsubr (&Sdump_colors
);
7524 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7525 doc
: /* *Limit for font matching.
7526 If an integer > 0, font matching functions won't load more than
7527 that number of fonts when searching for a matching font. */);
7528 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7530 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7531 doc
: /* List of global face definitions (for internal use only.) */);
7532 Vface_new_frame_defaults
= Qnil
;
7534 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7535 doc
: /* *Default stipple pattern used on monochrome displays.
7536 This stipple pattern is used on monochrome displays
7537 instead of shades of gray for a face background color.
7538 See `set-face-stipple' for possible values for this variable. */);
7539 Vface_default_stipple
= build_string ("gray3");
7541 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7542 doc
: /* An alist of defined terminal colors and their RGB values. */);
7543 Vtty_defined_color_alist
= Qnil
;
7545 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7546 doc
: /* Allowed scalable fonts.
7547 A value of nil means don't allow any scalable fonts.
7548 A value of t means allow any scalable font.
7549 Otherwise, value must be a list of regular expressions. A font may be
7550 scaled if its name matches a regular expression in the list.
7551 Note that if value is nil, a scalable font might still be used, if no
7552 other font of the appropriate family and registry is available. */);
7553 Vscalable_fonts_allowed
= Qnil
;
7555 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7556 doc
: /* List of ignored fonts.
7557 Each element is a regular expression that matches names of fonts to
7559 Vface_ignored_fonts
= Qnil
;
7561 DEFVAR_LISP ("face-resizing-fonts", &Vface_resizing_fonts
,
7562 doc
: /* Alist of fonts vs the resizing factors.
7563 Each element is a cons (FONT-NAME-PATTERN . RESIZING-RATIO), where
7564 FONT-NAME-PATTERN is a regular expression matching a font name, and
7565 RESIZING-RATIO is a floating point number to specify how much larger
7566 \(or smaller) font we should use. For instance, if a face requests
7567 a font of 10 point, we actually use a font of 10 * RESIZING-FACE points. */);
7569 #ifdef HAVE_WINDOW_SYSTEM
7570 defsubr (&Sbitmap_spec_p
);
7571 defsubr (&Sx_list_fonts
);
7572 defsubr (&Sinternal_face_x_get_resource
);
7573 defsubr (&Sx_family_fonts
);
7574 defsubr (&Sx_font_family_list
);
7575 #endif /* HAVE_WINDOW_SYSTEM */