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 rescaling factor. */
418 Lisp_Object Vface_font_rescale_alist
;
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_font_rescale_alist,
1886 the value is the corresponding rescale ratio. Otherwise, the
1888 double rescale_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
);
2127 split_font_name_into_vector (fontname
)
2128 Lisp_Object fontname
;
2130 struct font_name font
;
2134 font
.name
= LSTRDUPA (fontname
);
2135 if (! split_font_name (NULL
, &font
, 0))
2137 vec
= Fmake_vector (make_number (XLFD_LAST
), Qnil
);
2138 for (i
= 0; i
< XLFD_LAST
; i
++)
2139 if (font
.fields
[i
][0] != '*')
2140 ASET (vec
, i
, build_string (font
.fields
[i
]));
2145 build_font_name_from_vector (vec
)
2148 struct font_name font
;
2149 Lisp_Object fontname
;
2153 for (i
= 0; i
< XLFD_LAST
; i
++)
2155 font
.fields
[i
] = (NILP (AREF (vec
, i
))
2156 ? "*" : (char *) XSTRING (AREF (vec
, i
))->data
);
2157 if ((i
== XLFD_FAMILY
|| i
== XLFD_REGISTRY
)
2158 && (p
= strchr (font
.fields
[i
], '-')))
2160 char *p1
= STRDUPA (font
.fields
[i
]);
2162 p1
[p
- font
.fields
[i
]] = '\0';
2163 if (i
== XLFD_FAMILY
)
2165 font
.fields
[XLFD_FOUNDRY
] = p1
;
2166 font
.fields
[XLFD_FAMILY
] = p
+ 1;
2170 font
.fields
[XLFD_REGISTRY
] = p1
;
2171 font
.fields
[XLFD_ENCODING
] = p
+ 1;
2177 p
= build_font_name (&font
);
2178 fontname
= build_string (p
);
2183 #ifdef HAVE_WINDOW_SYSTEM
2185 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2189 struct font_name
*font
;
2191 /* Function split_font_name converts fields to lower-case, so there
2192 is no need to use tolower here. */
2193 return *font
->fields
[XLFD_SPACING
] != 'p';
2197 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2199 The actual height of the font when displayed on F depends on the
2200 resolution of both the font and frame. For example, a 10pt font
2201 designed for a 100dpi display will display larger than 10pt on a
2202 75dpi display. (It's not unusual to use fonts not designed for the
2203 display one is using. For example, some intlfonts are available in
2204 72dpi versions, only.)
2206 Value is the real point size of FONT on frame F, or 0 if it cannot
2210 xlfd_point_size (f
, font
)
2212 struct font_name
*font
;
2214 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2215 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2219 if (*pixel_field
== '[')
2221 /* The pixel size field is `[A B C D]' which specifies
2222 a transformation matrix.
2228 by which all glyphs of the font are transformed. The spec
2229 says that s scalar value N for the pixel size is equivalent
2230 to A = N * resx/resy, B = C = 0, D = N. */
2231 char *start
= pixel_field
+ 1, *end
;
2235 for (i
= 0; i
< 4; ++i
)
2237 matrix
[i
] = strtod (start
, &end
);
2244 pixel
= atoi (pixel_field
);
2249 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2255 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2256 of frame F. This function is used to guess a point size of font
2257 when only the pixel height of the font is available. */
2260 pixel_point_size (f
, pixel
)
2264 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2268 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2269 point size of one dot. */
2270 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2271 int_pt
= real_pt
+ 0.5;
2277 /* Return a rescaling ratio of a font of NAME. */
2280 font_rescale_ratio (char *name
)
2282 Lisp_Object tail
, elt
;
2284 for (tail
= Vface_font_rescale_alist
; CONSP (tail
); tail
= XCDR (tail
))
2287 if (STRINGP (XCAR (elt
)) && FLOATP (XCDR (elt
))
2288 && fast_c_string_match_ignore_case (XCAR (elt
), name
) >= 0)
2289 return XFLOAT_DATA (XCDR (elt
));
2295 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2296 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2297 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2298 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2299 zero if the font name doesn't have the format we expect. The
2300 expected format is a font name that starts with a `-' and has
2301 XLFD_LAST fields separated by `-'. */
2304 split_font_name (f
, font
, numeric_p
)
2306 struct font_name
*font
;
2311 double rescale_ratio
;
2314 /* This must be done before splitting the font name. */
2315 rescale_ratio
= font_rescale_ratio (font
->name
);
2317 if (*font
->name
== '-')
2319 char *p
= xstrlwr (font
->name
) + 1;
2321 while (i
< XLFD_LAST
)
2323 font
->fields
[i
] = p
;
2326 /* Pixel and point size may be of the form `[....]'. For
2327 BNF, see XLFD spec, chapter 4. Negative values are
2328 indicated by tilde characters which we replace with
2329 `-' characters, here. */
2331 && (i
- 1 == XLFD_PIXEL_SIZE
2332 || i
- 1 == XLFD_POINT_SIZE
))
2337 for (++p
; *p
&& *p
!= ']'; ++p
)
2341 /* Check that the matrix contains 4 floating point
2343 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2346 if (strtod (start
, &end
) == 0 && start
== end
)
2353 while (*p
&& *p
!= '-')
2363 success_p
= i
== XLFD_LAST
;
2365 /* If requested, and font name was in the expected format,
2366 compute numeric values for some fields. */
2367 if (numeric_p
&& success_p
)
2369 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2370 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2371 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2372 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2373 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2374 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2375 font
->rescale_ratio
= rescale_ratio
;
2378 /* Initialize it to zero. It will be overridden by font_list while
2379 trying alternate registries. */
2380 font
->registry_priority
= 0;
2386 /* Build an XLFD font name from font name fields in FONT. Value is a
2387 pointer to the font name, which is allocated via xmalloc. */
2390 build_font_name (font
)
2391 struct font_name
*font
;
2395 char *font_name
= (char *) xmalloc (size
);
2396 int total_length
= 0;
2398 for (i
= 0; i
< XLFD_LAST
; ++i
)
2400 /* Add 1 because of the leading `-'. */
2401 int len
= strlen (font
->fields
[i
]) + 1;
2403 /* Reallocate font_name if necessary. Add 1 for the final
2405 if (total_length
+ len
+ 1 >= size
)
2407 int new_size
= max (2 * size
, size
+ len
+ 1);
2408 int sz
= new_size
* sizeof *font_name
;
2409 font_name
= (char *) xrealloc (font_name
, sz
);
2413 font_name
[total_length
] = '-';
2414 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2415 total_length
+= len
;
2418 font_name
[total_length
] = 0;
2423 /* Free an array FONTS of N font_name structures. This frees FONTS
2424 itself and all `name' fields in its elements. */
2427 free_font_names (fonts
, n
)
2428 struct font_name
*fonts
;
2432 xfree (fonts
[--n
].name
);
2437 /* Sort vector FONTS of font_name structures which contains NFONTS
2438 elements using qsort and comparison function CMPFN. F is the frame
2439 on which the fonts will be used. The global variable font_frame
2440 is temporarily set to F to make it available in CMPFN. */
2443 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2445 struct font_name
*fonts
;
2447 int (*cmpfn
) P_ ((const void *, const void *));
2450 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2455 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2456 display in x_display_list. FONTS is a pointer to a vector of
2457 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2458 alternative patterns from Valternate_fontname_alist if no fonts are
2459 found matching PATTERN.
2461 For all fonts found, set FONTS[i].name to the name of the font,
2462 allocated via xmalloc, and split font names into fields. Ignore
2463 fonts that we can't parse. Value is the number of fonts found. */
2466 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2469 struct font_name
*fonts
;
2470 int nfonts
, try_alternatives_p
;
2474 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2475 better to do it the other way around. */
2477 Lisp_Object lpattern
, tem
;
2479 lpattern
= build_string (pattern
);
2481 /* Get the list of fonts matching PATTERN. */
2484 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2487 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2490 /* Make a copy of the font names we got from X, and
2491 split them into fields. */
2493 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2495 Lisp_Object elt
, tail
;
2496 char *name
= XSTRING (XCAR (tem
))->data
;
2498 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2499 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2503 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2512 /* Make a copy of the font name. */
2513 fonts
[n
].name
= xstrdup (name
);
2515 if (split_font_name (f
, fonts
+ n
, 1))
2517 if (font_scalable_p (fonts
+ n
)
2518 && !may_use_scalable_font_p (name
))
2521 xfree (fonts
[n
].name
);
2527 xfree (fonts
[n
].name
);
2530 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2531 if (n
== 0 && try_alternatives_p
)
2533 Lisp_Object list
= Valternate_fontname_alist
;
2535 while (CONSP (list
))
2537 Lisp_Object entry
= XCAR (list
);
2539 && STRINGP (XCAR (entry
))
2540 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2547 Lisp_Object patterns
= XCAR (list
);
2550 while (CONSP (patterns
)
2551 /* If list is screwed up, give up. */
2552 && (name
= XCAR (patterns
),
2554 /* Ignore patterns equal to PATTERN because we tried that
2555 already with no success. */
2556 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2557 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2560 patterns
= XCDR (patterns
);
2568 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2569 using comparison function CMPFN. Value is the number of fonts
2570 found. If value is non-zero, *FONTS is set to a vector of
2571 font_name structures allocated from the heap containing matching
2572 fonts. Each element of *FONTS contains a name member that is also
2573 allocated from the heap. Font names in these structures are split
2574 into fields. Use free_font_names to free such an array. */
2577 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2580 int (*cmpfn
) P_ ((const void *, const void *));
2581 struct font_name
**fonts
;
2585 /* Get the list of fonts matching pattern. 100 should suffice. */
2586 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2587 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2588 nfonts
= XFASTINT (Vfont_list_limit
);
2590 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2591 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2593 /* Sort the resulting array and return it in *FONTS. If no
2594 fonts were found, make sure to set *FONTS to null. */
2596 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2607 /* Compare two font_name structures *A and *B. Value is analogous to
2608 strcmp. Sort order is given by the global variable
2609 font_sort_order. Font names are sorted so that, everything else
2610 being equal, fonts with a resolution closer to that of the frame on
2611 which they are used are listed first. The global variable
2612 font_frame is the frame on which we operate. */
2615 cmp_font_names (a
, b
)
2618 struct font_name
*x
= (struct font_name
*) a
;
2619 struct font_name
*y
= (struct font_name
*) b
;
2622 /* All strings have been converted to lower-case by split_font_name,
2623 so we can use strcmp here. */
2624 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2629 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2631 int j
= font_sort_order
[i
];
2632 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2637 /* Everything else being equal, we prefer fonts with an
2638 y-resolution closer to that of the frame. */
2639 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2640 int x_resy
= x
->numeric
[XLFD_RESY
];
2641 int y_resy
= y
->numeric
[XLFD_RESY
];
2642 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2650 /* Get a sorted list of fonts matching PATTERN. If PATTERN is nil,
2651 list fonts matching FAMILY and REGISTRY. FAMILY is a family name
2652 string or nil. REGISTRY is a registry name string. Set *FONTS to
2653 a vector of font_name structures allocated from the heap containing
2654 the fonts found. Value is the number of fonts found. */
2657 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2659 Lisp_Object pattern
, family
, registry
;
2660 struct font_name
**fonts
;
2662 char *pattern_str
, *family_str
, *registry_str
;
2666 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2667 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2669 pattern_str
= (char *) alloca (strlen (family_str
)
2670 + strlen (registry_str
)
2672 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2673 strcat (pattern_str
, family_str
);
2674 strcat (pattern_str
, "-*-");
2675 strcat (pattern_str
, registry_str
);
2676 if (!index (registry_str
, '-'))
2678 if (registry_str
[strlen (registry_str
) - 1] == '*')
2679 strcat (pattern_str
, "-*");
2681 strcat (pattern_str
, "*-*");
2685 pattern_str
= (char *) XSTRING (pattern
)->data
;
2687 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2691 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2692 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2693 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2696 static struct font_name
*
2697 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2698 struct font_name
*fonts1
, *fonts2
;
2699 int nfonts1
, nfonts2
;
2701 int new_nfonts
= nfonts1
+ nfonts2
;
2702 struct font_name
*new_fonts
;
2704 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2705 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2706 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2713 /* Get a sorted list of fonts of family FAMILY on frame F.
2715 If PATTERN is non-nil, list fonts matching that pattern.
2717 If REGISTRY is non-nil, it is a list of registry (and encoding)
2718 names. Return fonts with those registries and the alternative
2719 registries from Vface_alternative_font_registry_alist.
2721 If REGISTRY is nil return fonts of any registry.
2723 Set *FONTS to a vector of font_name structures allocated from the
2724 heap containing the fonts found. Value is the number of fonts
2728 font_list (f
, pattern
, family
, registry
, fonts
)
2730 Lisp_Object pattern
, family
, registry
;
2731 struct font_name
**fonts
;
2737 if (NILP (registry
))
2738 return font_list_1 (f
, pattern
, family
, registry
, fonts
);
2740 for (reg_prio
= 0, nfonts
= 0; CONSP (registry
); registry
= XCDR (registry
))
2742 Lisp_Object elt
, alter
;
2744 struct font_name
*fonts2
;
2746 elt
= XCAR (registry
);
2747 alter
= Fassoc (elt
, Vface_alternative_font_registry_alist
);
2749 alter
= Fcons (elt
, Qnil
);
2750 for (; CONSP (alter
); alter
= XCDR (alter
), reg_prio
++)
2752 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
), &fonts2
);
2756 for (i
= 0; i
< nfonts2
; i
++)
2757 fonts2
[i
].registry_priority
= reg_prio
;
2759 *fonts
= concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
);
2771 /* Remove elements from LIST whose cars are `equal'. Called from
2772 x-family-fonts and x-font-family-list to remove duplicate font
2776 remove_duplicates (list
)
2779 Lisp_Object tail
= list
;
2781 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2783 Lisp_Object next
= XCDR (tail
);
2784 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2785 XSETCDR (tail
, XCDR (next
));
2792 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2793 doc
: /* Return a list of available fonts of family FAMILY on FRAME.
2794 If FAMILY is omitted or nil, list all families.
2795 Otherwise, FAMILY must be a string, possibly containing wildcards
2797 If FRAME is omitted or nil, use the selected frame.
2798 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT
2799 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].
2800 FAMILY is the font family name. POINT-SIZE is the size of the
2801 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the
2802 width, weight and slant of the font. These symbols are the same as for
2803 face attributes. FIXED-P is non-nil if the font is fixed-pitch.
2804 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string
2805 giving the registry and encoding of the font.
2806 The result list is sorted according to the current setting of
2807 the face font sort order. */)
2809 Lisp_Object family
, frame
;
2811 struct frame
*f
= check_x_frame (frame
);
2812 struct font_name
*fonts
;
2815 struct gcpro gcpro1
;
2818 CHECK_STRING (family
);
2822 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2823 for (i
= nfonts
- 1; i
>= 0; --i
)
2825 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2828 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2829 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2830 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2831 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2832 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2833 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2834 tem
= build_font_name (fonts
+ i
);
2835 ASET (v
, 6, build_string (tem
));
2836 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2837 fonts
[i
].fields
[XLFD_ENCODING
]);
2838 ASET (v
, 7, build_string (tem
));
2841 result
= Fcons (v
, result
);
2844 remove_duplicates (result
);
2845 free_font_names (fonts
, nfonts
);
2851 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2853 doc
: /* Return a list of available font families on FRAME.
2854 If FRAME is omitted or nil, use the selected frame.
2855 Value is a list of conses (FAMILY . FIXED-P) where FAMILY
2856 is a font family, and FIXED-P is non-nil if fonts of that family
2857 are fixed-pitch. */)
2861 struct frame
*f
= check_x_frame (frame
);
2863 struct font_name
*fonts
;
2865 struct gcpro gcpro1
;
2866 int count
= specpdl_ptr
- specpdl
;
2869 /* Let's consider all fonts. Increase the limit for matching
2870 fonts until we have them all. */
2873 specbind (intern ("font-list-limit"), make_number (limit
));
2874 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2876 if (nfonts
== limit
)
2878 free_font_names (fonts
, nfonts
);
2887 for (i
= nfonts
- 1; i
>= 0; --i
)
2888 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2889 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2892 remove_duplicates (result
);
2893 free_font_names (fonts
, nfonts
);
2895 return unbind_to (count
, result
);
2899 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2900 doc
: /* Return a list of the names of available fonts matching PATTERN.
2901 If optional arguments FACE and FRAME are specified, return only fonts
2902 the same size as FACE on FRAME.
2903 PATTERN is a string, perhaps with wildcard characters;
2904 the * character matches any substring, and
2905 the ? character matches any single character.
2906 PATTERN is case-insensitive.
2907 FACE is a face name--a symbol.
2909 The return value is a list of strings, suitable as arguments to
2912 Fonts Emacs can't use may or may not be excluded
2913 even if they match PATTERN and FACE.
2914 The optional fourth argument MAXIMUM sets a limit on how many
2915 fonts to match. The first MAXIMUM fonts are reported.
2916 The optional fifth argument WIDTH, if specified, is a number of columns
2917 occupied by a character of a font. In that case, return only fonts
2918 the WIDTH times as wide as FACE on FRAME. */)
2919 (pattern
, face
, frame
, maximum
, width
)
2920 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2927 CHECK_STRING (pattern
);
2933 CHECK_NATNUM (maximum
);
2934 maxnames
= XINT (maximum
);
2938 CHECK_NUMBER (width
);
2940 /* We can't simply call check_x_frame because this function may be
2941 called before any frame is created. */
2942 f
= frame_or_selected_frame (frame
, 2);
2943 if (!FRAME_WINDOW_P (f
))
2945 /* Perhaps we have not yet created any frame. */
2950 /* Determine the width standard for comparison with the fonts we find. */
2956 /* This is of limited utility since it works with character
2957 widths. Keep it for compatibility. --gerd. */
2958 int face_id
= lookup_named_face (f
, face
);
2959 struct face
*face
= (face_id
< 0
2961 : FACE_FROM_ID (f
, face_id
));
2963 if (face
&& face
->font
)
2964 size
= FONT_WIDTH (face
->font
);
2966 size
= FONT_WIDTH (FRAME_FONT (f
));
2969 size
*= XINT (width
);
2973 Lisp_Object args
[2];
2975 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2977 /* We don't have to check fontsets. */
2979 args
[1] = list_fontsets (f
, pattern
, size
);
2980 return Fnconc (2, args
);
2984 #endif /* HAVE_WINDOW_SYSTEM */
2988 /***********************************************************************
2990 ***********************************************************************/
2992 /* Access face attributes of face LFACE, a Lisp vector. */
2994 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2995 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2996 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2997 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2998 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2999 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
3000 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
3001 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
3002 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
3003 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
3004 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
3005 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
3006 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
3007 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
3008 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
3009 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
3010 #define LFACE_FONTSET(LFACE) AREF ((LFACE), LFACE_FONTSET_INDEX)
3012 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
3013 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
3015 #define LFACEP(LFACE) \
3017 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
3018 && EQ (AREF (LFACE, 0), Qface))
3023 /* Check consistency of Lisp face attribute vector ATTRS. */
3026 check_lface_attrs (attrs
)
3029 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
3030 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
3031 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
3032 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
3033 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
3034 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
3035 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
3036 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
3037 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
3038 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
3039 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
3040 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
3041 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
3042 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
3043 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
3044 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
3045 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
3046 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
3047 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
3048 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
3049 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3050 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
3051 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
3052 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
3053 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
3054 || STRINGP (attrs
[LFACE_BOX_INDEX
])
3055 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
3056 || CONSP (attrs
[LFACE_BOX_INDEX
]));
3057 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
3058 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
3059 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
3060 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
3061 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
3062 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
3063 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
3064 || NILP (attrs
[LFACE_INHERIT_INDEX
])
3065 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
3066 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
3067 #ifdef HAVE_WINDOW_SYSTEM
3068 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
3069 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
3070 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
3071 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
3072 || NILP (attrs
[LFACE_FONT_INDEX
])
3073 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
3074 xassert (UNSPECIFIEDP (attrs
[LFACE_FONTSET_INDEX
])
3075 || STRINGP (attrs
[LFACE_FONTSET_INDEX
]));
3080 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
3088 xassert (LFACEP (lface
));
3089 check_lface_attrs (XVECTOR (lface
)->contents
);
3093 #else /* GLYPH_DEBUG == 0 */
3095 #define check_lface_attrs(attrs) (void) 0
3096 #define check_lface(lface) (void) 0
3098 #endif /* GLYPH_DEBUG == 0 */
3101 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3102 to make it a symvol. If FACE_NAME is an alias for another face,
3103 return that face's name. */
3106 resolve_face_name (face_name
)
3107 Lisp_Object face_name
;
3109 Lisp_Object aliased
;
3111 if (STRINGP (face_name
))
3112 face_name
= intern (XSTRING (face_name
)->data
);
3114 while (SYMBOLP (face_name
))
3116 aliased
= Fget (face_name
, Qface_alias
);
3120 face_name
= aliased
;
3127 /* Return the face definition of FACE_NAME on frame F. F null means
3128 return the definition for new frames. FACE_NAME may be a string or
3129 a symbol (apparently Emacs 20.2 allowed strings as face names in
3130 face text properties; Ediff uses that). If FACE_NAME is an alias
3131 for another face, return that face's definition. If SIGNAL_P is
3132 non-zero, signal an error if FACE_NAME is not a valid face name.
3133 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3136 static INLINE Lisp_Object
3137 lface_from_face_name (f
, face_name
, signal_p
)
3139 Lisp_Object face_name
;
3144 face_name
= resolve_face_name (face_name
);
3147 lface
= assq_no_quit (face_name
, f
->face_alist
);
3149 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3152 lface
= XCDR (lface
);
3154 signal_error ("Invalid face", face_name
);
3156 check_lface (lface
);
3161 /* Get face attributes of face FACE_NAME from frame-local faces on
3162 frame F. Store the resulting attributes in ATTRS which must point
3163 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3164 is non-zero, signal an error if FACE_NAME does not name a face.
3165 Otherwise, value is zero if FACE_NAME is not a face. */
3168 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3170 Lisp_Object face_name
;
3177 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3180 bcopy (XVECTOR (lface
)->contents
, attrs
,
3181 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3191 /* Non-zero if all attributes in face attribute vector ATTRS are
3192 specified, i.e. are non-nil. */
3195 lface_fully_specified_p (attrs
)
3200 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3201 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3202 && i
!= LFACE_AVGWIDTH_INDEX
)
3203 if (UNSPECIFIEDP (attrs
[i
]))
3206 return i
== LFACE_VECTOR_SIZE
;
3209 #ifdef HAVE_WINDOW_SYSTEM
3211 /* Set font-related attributes of Lisp face LFACE from the fullname of
3212 the font opened by FONTNAME. If FORCE_P is zero, set only
3213 unspecified attributes of LFACE. The exception is `font'
3214 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3216 If FONTNAME is not available on frame F,
3217 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3218 If the fullname is not in a valid XLFD format,
3219 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3220 in LFACE and return 1.
3221 Otherwise, return 1.
3223 Currently this function is always called with both FORCE_P and
3224 MAIL_FAIL_P non-zero. */
3227 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3230 Lisp_Object fontname
;
3231 int force_p
, may_fail_p
;
3233 struct font_name font
;
3238 char *font_name
= XSTRING (fontname
)->data
;
3239 struct font_info
*font_info
;
3241 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3242 fontset
= fs_query_fontset (fontname
, 0);
3244 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3245 else if (fontset
== 0)
3252 /* Check if FONT_NAME is surely available on the system. Usually
3253 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3254 returns quickly. But, even if FONT_NAME is not yet cached,
3255 caching it now is not futail because we anyway load the font
3258 font_info
= FS_LOAD_FONT (f
, font_name
);
3268 font
.name
= STRDUPA (font_info
->full_name
);
3269 have_xlfd_p
= split_font_name (f
, &font
, 1);
3271 /* Set attributes only if unspecified, otherwise face defaults for
3272 new frames would never take effect. If we couldn't get a font
3273 name conforming to XLFD, set normal values. */
3275 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3280 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3281 + strlen (font
.fields
[XLFD_FOUNDRY
])
3283 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3284 font
.fields
[XLFD_FAMILY
]);
3285 val
= build_string (buffer
);
3288 val
= build_string ("*");
3289 LFACE_FAMILY (lface
) = val
;
3292 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3295 pt
= xlfd_point_size (f
, &font
);
3297 pt
= pixel_point_size (f
, font_info
->height
* 10);
3299 LFACE_HEIGHT (lface
) = make_number (pt
);
3302 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3303 LFACE_SWIDTH (lface
)
3304 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3306 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3307 LFACE_AVGWIDTH (lface
)
3309 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3312 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3313 LFACE_WEIGHT (lface
)
3314 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3316 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3318 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3322 LFACE_FONT (lface
) = build_string (font_info
->full_name
);
3323 LFACE_FONTSET (lface
) = fontset_name (fontset
);
3326 LFACE_FONT (lface
) = fontname
;
3330 #endif /* HAVE_WINDOW_SYSTEM */
3333 /* Merges the face height FROM with the face height TO, and returns the
3334 merged height. If FROM is an invalid height, then INVALID is
3335 returned instead. FROM and TO may be either absolute face heights or
3336 `relative' heights; the returned value is always an absolute height
3337 unless both FROM and TO are relative. GCPRO is a lisp value that
3338 will be protected from garbage-collection if this function makes a
3342 merge_face_heights (from
, to
, invalid
, gcpro
)
3343 Lisp_Object from
, to
, invalid
, gcpro
;
3345 Lisp_Object result
= invalid
;
3347 if (INTEGERP (from
))
3348 /* FROM is absolute, just use it as is. */
3350 else if (FLOATP (from
))
3351 /* FROM is a scale, use it to adjust TO. */
3354 /* relative X absolute => absolute */
3355 result
= make_number ((EMACS_INT
)(XFLOAT_DATA (from
) * XINT (to
)));
3356 else if (FLOATP (to
))
3357 /* relative X relative => relative */
3358 result
= make_float (XFLOAT_DATA (from
) * XFLOAT_DATA (to
));
3360 else if (FUNCTIONP (from
))
3361 /* FROM is a function, which use to adjust TO. */
3363 /* Call function with current height as argument.
3364 From is the new height. */
3365 Lisp_Object args
[2];
3366 struct gcpro gcpro1
;
3372 result
= safe_call (2, args
);
3376 /* Ensure that if TO was absolute, so is the result. */
3377 if (INTEGERP (to
) && !INTEGERP (result
))
3385 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3386 store the resulting attributes in TO, which must be already be
3387 completely specified and contain only absolute attributes. Every
3388 specified attribute of FROM overrides the corresponding attribute of
3389 TO; relative attributes in FROM are merged with the absolute value in
3390 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3391 face inheritance; it should be Qnil when called from other places. */
3394 merge_face_vectors (f
, from
, to
, cycle_check
)
3396 Lisp_Object
*from
, *to
;
3397 Lisp_Object cycle_check
;
3401 /* If FROM inherits from some other faces, merge their attributes into
3402 TO before merging FROM's direct attributes. Note that an :inherit
3403 attribute of `unspecified' is the same as one of nil; we never
3404 merge :inherit attributes, so nil is more correct, but lots of
3405 other code uses `unspecified' as a generic value for face attributes. */
3406 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3407 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3408 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3410 /* If TO specifies a :font attribute, and FROM specifies some
3411 font-related attribute, we need to clear TO's :font attribute
3412 (because it will be inconsistent with whatever FROM specifies, and
3413 FROM takes precedence). */
3414 if (!NILP (to
[LFACE_FONT_INDEX
])
3415 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3416 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3417 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3418 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3419 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3420 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3421 to
[LFACE_FONT_INDEX
] = Qnil
;
3423 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3424 if (!UNSPECIFIEDP (from
[i
]))
3426 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3427 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3432 /* TO is always an absolute face, which should inherit from nothing.
3433 We blindly copy the :inherit attribute above and fix it up here. */
3434 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3438 /* Checks the `cycle check' variable CHECK to see if it indicates that
3439 EL is part of a cycle; CHECK must be either Qnil or a value returned
3440 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3441 elements after which a cycle might be suspected; after that many
3442 elements, this macro begins consing in order to keep more precise
3445 Returns nil if a cycle was detected, otherwise a new value for CHECK
3448 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3449 the caller should make sure that's ok. */
3451 #define CYCLE_CHECK(check, el, suspicious) \
3454 : (INTEGERP (check) \
3455 ? (XFASTINT (check) < (suspicious) \
3456 ? make_number (XFASTINT (check) + 1) \
3457 : Fcons (el, Qnil)) \
3458 : (!NILP (Fmemq ((el), (check))) \
3460 : Fcons ((el), (check)))))
3463 /* Merge face attributes from the face on frame F whose name is
3464 INHERITS, into the vector of face attributes TO; INHERITS may also be
3465 a list of face names, in which case they are applied in order.
3466 CYCLE_CHECK is used to detect loops in face inheritance.
3467 Returns true if any of the inherited attributes are `font-related'. */
3470 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3472 Lisp_Object inherit
;
3474 Lisp_Object cycle_check
;
3476 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3477 /* Inherit from the named face INHERIT. */
3481 /* Make sure we're not in an inheritance loop. */
3482 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3483 if (NILP (cycle_check
))
3484 /* Cycle detected, ignore any further inheritance. */
3487 lface
= lface_from_face_name (f
, inherit
, 0);
3489 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3491 else if (CONSP (inherit
))
3492 /* Handle a list of inherited faces by calling ourselves recursively
3493 on each element. Note that we only do so for symbol elements, so
3494 it's not possible to infinitely recurse. */
3496 while (CONSP (inherit
))
3498 if (SYMBOLP (XCAR (inherit
)))
3499 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3501 /* Check for a circular inheritance list. */
3502 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3503 if (NILP (cycle_check
))
3504 /* Cycle detected. */
3507 inherit
= XCDR (inherit
);
3513 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3514 is a face property, determine the resulting face attributes on
3515 frame F, and store them in TO. PROP may be a single face
3516 specification or a list of such specifications. Each face
3517 specification can be
3519 1. A symbol or string naming a Lisp face.
3521 2. A property list of the form (KEYWORD VALUE ...) where each
3522 KEYWORD is a face attribute name, and value is an appropriate value
3525 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3526 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3527 for compatibility with 20.2.
3529 Face specifications earlier in lists take precedence over later
3533 merge_face_vector_with_property (f
, to
, prop
)
3540 Lisp_Object first
= XCAR (prop
);
3542 if (EQ (first
, Qforeground_color
)
3543 || EQ (first
, Qbackground_color
))
3545 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3546 . COLOR). COLOR must be a string. */
3547 Lisp_Object color_name
= XCDR (prop
);
3548 Lisp_Object color
= first
;
3550 if (STRINGP (color_name
))
3552 if (EQ (color
, Qforeground_color
))
3553 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3555 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3558 add_to_log ("Invalid face color", color_name
, Qnil
);
3560 else if (SYMBOLP (first
)
3561 && *XSYMBOL (first
)->name
->data
== ':')
3563 /* Assume this is the property list form. */
3564 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3566 Lisp_Object keyword
= XCAR (prop
);
3567 Lisp_Object value
= XCAR (XCDR (prop
));
3569 if (EQ (keyword
, QCfamily
))
3571 if (STRINGP (value
))
3572 to
[LFACE_FAMILY_INDEX
] = value
;
3574 add_to_log ("Invalid face font family", value
, Qnil
);
3576 else if (EQ (keyword
, QCheight
))
3578 Lisp_Object new_height
=
3579 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3582 if (NILP (new_height
))
3583 add_to_log ("Invalid face font height", value
, Qnil
);
3585 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3587 else if (EQ (keyword
, QCweight
))
3590 && face_numeric_weight (value
) >= 0)
3591 to
[LFACE_WEIGHT_INDEX
] = value
;
3593 add_to_log ("Invalid face weight", value
, Qnil
);
3595 else if (EQ (keyword
, QCslant
))
3598 && face_numeric_slant (value
) >= 0)
3599 to
[LFACE_SLANT_INDEX
] = value
;
3601 add_to_log ("Invalid face slant", value
, Qnil
);
3603 else if (EQ (keyword
, QCunderline
))
3608 to
[LFACE_UNDERLINE_INDEX
] = value
;
3610 add_to_log ("Invalid face underline", value
, Qnil
);
3612 else if (EQ (keyword
, QCoverline
))
3617 to
[LFACE_OVERLINE_INDEX
] = value
;
3619 add_to_log ("Invalid face overline", value
, Qnil
);
3621 else if (EQ (keyword
, QCstrike_through
))
3626 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3628 add_to_log ("Invalid face strike-through", value
, Qnil
);
3630 else if (EQ (keyword
, QCbox
))
3633 value
= make_number (1);
3634 if (INTEGERP (value
)
3638 to
[LFACE_BOX_INDEX
] = value
;
3640 add_to_log ("Invalid face box", value
, Qnil
);
3642 else if (EQ (keyword
, QCinverse_video
)
3643 || EQ (keyword
, QCreverse_video
))
3645 if (EQ (value
, Qt
) || NILP (value
))
3646 to
[LFACE_INVERSE_INDEX
] = value
;
3648 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3650 else if (EQ (keyword
, QCforeground
))
3652 if (STRINGP (value
))
3653 to
[LFACE_FOREGROUND_INDEX
] = value
;
3655 add_to_log ("Invalid face foreground", value
, Qnil
);
3657 else if (EQ (keyword
, QCbackground
))
3659 if (STRINGP (value
))
3660 to
[LFACE_BACKGROUND_INDEX
] = value
;
3662 add_to_log ("Invalid face background", value
, Qnil
);
3664 else if (EQ (keyword
, QCstipple
))
3666 #ifdef HAVE_X_WINDOWS
3667 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3668 if (!NILP (pixmap_p
))
3669 to
[LFACE_STIPPLE_INDEX
] = value
;
3671 add_to_log ("Invalid face stipple", value
, Qnil
);
3674 else if (EQ (keyword
, QCwidth
))
3677 && face_numeric_swidth (value
) >= 0)
3678 to
[LFACE_SWIDTH_INDEX
] = value
;
3680 add_to_log ("Invalid face width", value
, Qnil
);
3682 else if (EQ (keyword
, QCinherit
))
3684 if (SYMBOLP (value
))
3685 to
[LFACE_INHERIT_INDEX
] = value
;
3689 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3690 if (!SYMBOLP (XCAR (tail
)))
3693 to
[LFACE_INHERIT_INDEX
] = value
;
3695 add_to_log ("Invalid face inherit", value
, Qnil
);
3699 add_to_log ("Invalid attribute %s in face property",
3702 prop
= XCDR (XCDR (prop
));
3707 /* This is a list of face specs. Specifications at the
3708 beginning of the list take precedence over later
3709 specifications, so we have to merge starting with the
3710 last specification. */
3711 Lisp_Object next
= XCDR (prop
);
3713 merge_face_vector_with_property (f
, to
, next
);
3714 merge_face_vector_with_property (f
, to
, first
);
3719 /* PROP ought to be a face name. */
3720 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3722 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3724 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3729 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3730 Sinternal_make_lisp_face
, 1, 2, 0,
3731 doc
: /* Make FACE, a symbol, a Lisp face with all attributes nil.
3732 If FACE was not known as a face before, create a new one.
3733 If optional argument FRAME is specified, make a frame-local face
3734 for that frame. Otherwise operate on the global face definition.
3735 Value is a vector of face attributes. */)
3737 Lisp_Object face
, frame
;
3739 Lisp_Object global_lface
, lface
;
3743 CHECK_SYMBOL (face
);
3744 global_lface
= lface_from_face_name (NULL
, face
, 0);
3748 CHECK_LIVE_FRAME (frame
);
3750 lface
= lface_from_face_name (f
, face
, 0);
3753 f
= NULL
, lface
= Qnil
;
3755 /* Add a global definition if there is none. */
3756 if (NILP (global_lface
))
3758 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3760 AREF (global_lface
, 0) = Qface
;
3761 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3762 Vface_new_frame_defaults
);
3764 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3765 face id to Lisp face is given by the vector lface_id_to_name.
3766 The mapping from Lisp face to Lisp face id is given by the
3767 property `face' of the Lisp face name. */
3768 if (next_lface_id
== lface_id_to_name_size
)
3770 int new_size
= max (50, 2 * lface_id_to_name_size
);
3771 int sz
= new_size
* sizeof *lface_id_to_name
;
3772 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3773 lface_id_to_name_size
= new_size
;
3776 lface_id_to_name
[next_lface_id
] = face
;
3777 Fput (face
, Qface
, make_number (next_lface_id
));
3781 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3782 AREF (global_lface
, i
) = Qunspecified
;
3784 /* Add a frame-local definition. */
3789 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3791 AREF (lface
, 0) = Qface
;
3792 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3795 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3796 AREF (lface
, i
) = Qunspecified
;
3799 lface
= global_lface
;
3801 /* Changing a named face means that all realized faces depending on
3802 that face are invalid. Since we cannot tell which realized faces
3803 depend on the face, make sure they are all removed. This is done
3804 by incrementing face_change_count. The next call to
3805 init_iterator will then free realized faces. */
3806 ++face_change_count
;
3807 ++windows_or_buffers_changed
;
3809 xassert (LFACEP (lface
));
3810 check_lface (lface
);
3815 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3816 Sinternal_lisp_face_p
, 1, 2, 0,
3817 doc
: /* Return non-nil if FACE names a face.
3818 If optional second parameter FRAME is non-nil, check for the
3819 existence of a frame-local face with name FACE on that frame.
3820 Otherwise check for the existence of a global face. */)
3822 Lisp_Object face
, frame
;
3828 CHECK_LIVE_FRAME (frame
);
3829 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3832 lface
= lface_from_face_name (NULL
, face
, 0);
3838 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3839 Sinternal_copy_lisp_face
, 4, 4, 0,
3840 doc
: /* Copy face FROM to TO.
3841 If FRAME it t, copy the global face definition of FROM to the
3842 global face definition of TO. Otherwise, copy the frame-local
3843 definition of FROM on FRAME to the frame-local definition of TO
3844 on NEW-FRAME, or FRAME if NEW-FRAME is nil.
3847 (from
, to
, frame
, new_frame
)
3848 Lisp_Object from
, to
, frame
, new_frame
;
3850 Lisp_Object lface
, copy
;
3852 CHECK_SYMBOL (from
);
3854 if (NILP (new_frame
))
3859 /* Copy global definition of FROM. We don't make copies of
3860 strings etc. because 20.2 didn't do it either. */
3861 lface
= lface_from_face_name (NULL
, from
, 1);
3862 copy
= Finternal_make_lisp_face (to
, Qnil
);
3866 /* Copy frame-local definition of FROM. */
3867 CHECK_LIVE_FRAME (frame
);
3868 CHECK_LIVE_FRAME (new_frame
);
3869 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3870 copy
= Finternal_make_lisp_face (to
, new_frame
);
3873 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3874 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3876 /* Changing a named face means that all realized faces depending on
3877 that face are invalid. Since we cannot tell which realized faces
3878 depend on the face, make sure they are all removed. This is done
3879 by incrementing face_change_count. The next call to
3880 init_iterator will then free realized faces. */
3881 ++face_change_count
;
3882 ++windows_or_buffers_changed
;
3888 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3889 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3890 doc
: /* Set attribute ATTR of FACE to VALUE.
3891 FRAME being a frame means change the face on that frame.
3892 FRAME nil means change the face of the selected frame.
3893 FRAME t means change the default for new frames.
3894 FRAME 0 means change the face on all frames, and change the default
3896 (face
, attr
, value
, frame
)
3897 Lisp_Object face
, attr
, value
, frame
;
3900 Lisp_Object old_value
= Qnil
;
3901 /* Set 1 if ATTR is QCfont. */
3902 int font_attr_p
= 0;
3903 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3904 int font_related_attr_p
= 0;
3906 CHECK_SYMBOL (face
);
3907 CHECK_SYMBOL (attr
);
3909 face
= resolve_face_name (face
);
3911 /* If FRAME is 0, change face on all frames, and change the
3912 default for new frames. */
3913 if (INTEGERP (frame
) && XINT (frame
) == 0)
3916 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3917 FOR_EACH_FRAME (tail
, frame
)
3918 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3922 /* Set lface to the Lisp attribute vector of FACE. */
3924 lface
= lface_from_face_name (NULL
, face
, 1);
3928 frame
= selected_frame
;
3930 CHECK_LIVE_FRAME (frame
);
3931 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3933 /* If a frame-local face doesn't exist yet, create one. */
3935 lface
= Finternal_make_lisp_face (face
, frame
);
3938 if (EQ (attr
, QCfamily
))
3940 if (!UNSPECIFIEDP (value
))
3942 CHECK_STRING (value
);
3943 if (XSTRING (value
)->size
== 0)
3944 signal_error ("Invalid face family", value
);
3946 old_value
= LFACE_FAMILY (lface
);
3947 LFACE_FAMILY (lface
) = value
;
3948 font_related_attr_p
= 1;
3950 else if (EQ (attr
, QCheight
))
3952 if (!UNSPECIFIEDP (value
))
3956 test
= (EQ (face
, Qdefault
)
3958 /* The default face must have an absolute size,
3959 otherwise, we do a test merge with a random
3960 height to see if VALUE's ok. */
3961 : merge_face_heights (value
, make_number (10), Qnil
, Qnil
));
3963 if (!INTEGERP (test
) || XINT (test
) <= 0)
3964 signal_error ("Invalid face height", value
);
3967 old_value
= LFACE_HEIGHT (lface
);
3968 LFACE_HEIGHT (lface
) = value
;
3969 font_related_attr_p
= 1;
3971 else if (EQ (attr
, QCweight
))
3973 if (!UNSPECIFIEDP (value
))
3975 CHECK_SYMBOL (value
);
3976 if (face_numeric_weight (value
) < 0)
3977 signal_error ("Invalid face weight", value
);
3979 old_value
= LFACE_WEIGHT (lface
);
3980 LFACE_WEIGHT (lface
) = value
;
3981 font_related_attr_p
= 1;
3983 else if (EQ (attr
, QCslant
))
3985 if (!UNSPECIFIEDP (value
))
3987 CHECK_SYMBOL (value
);
3988 if (face_numeric_slant (value
) < 0)
3989 signal_error ("Invalid face slant", value
);
3991 old_value
= LFACE_SLANT (lface
);
3992 LFACE_SLANT (lface
) = value
;
3993 font_related_attr_p
= 1;
3995 else if (EQ (attr
, QCunderline
))
3997 if (!UNSPECIFIEDP (value
))
3998 if ((SYMBOLP (value
)
4000 && !EQ (value
, Qnil
))
4001 /* Underline color. */
4003 && XSTRING (value
)->size
== 0))
4004 signal_error ("Invalid face underline", value
);
4006 old_value
= LFACE_UNDERLINE (lface
);
4007 LFACE_UNDERLINE (lface
) = value
;
4009 else if (EQ (attr
, QCoverline
))
4011 if (!UNSPECIFIEDP (value
))
4012 if ((SYMBOLP (value
)
4014 && !EQ (value
, Qnil
))
4015 /* Overline color. */
4017 && XSTRING (value
)->size
== 0))
4018 signal_error ("Invalid face overline", value
);
4020 old_value
= LFACE_OVERLINE (lface
);
4021 LFACE_OVERLINE (lface
) = value
;
4023 else if (EQ (attr
, QCstrike_through
))
4025 if (!UNSPECIFIEDP (value
))
4026 if ((SYMBOLP (value
)
4028 && !EQ (value
, Qnil
))
4029 /* Strike-through color. */
4031 && XSTRING (value
)->size
== 0))
4032 signal_error ("Invalid face strike-through", value
);
4034 old_value
= LFACE_STRIKE_THROUGH (lface
);
4035 LFACE_STRIKE_THROUGH (lface
) = value
;
4037 else if (EQ (attr
, QCbox
))
4041 /* Allow t meaning a simple box of width 1 in foreground color
4044 value
= make_number (1);
4046 if (UNSPECIFIEDP (value
))
4048 else if (NILP (value
))
4050 else if (INTEGERP (value
))
4051 valid_p
= XINT (value
) != 0;
4052 else if (STRINGP (value
))
4053 valid_p
= XSTRING (value
)->size
> 0;
4054 else if (CONSP (value
))
4070 if (EQ (k
, QCline_width
))
4072 if (!INTEGERP (v
) || XINT (v
) == 0)
4075 else if (EQ (k
, QCcolor
))
4077 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
4080 else if (EQ (k
, QCstyle
))
4082 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
4089 valid_p
= NILP (tem
);
4095 signal_error ("Invalid face box", value
);
4097 old_value
= LFACE_BOX (lface
);
4098 LFACE_BOX (lface
) = value
;
4100 else if (EQ (attr
, QCinverse_video
)
4101 || EQ (attr
, QCreverse_video
))
4103 if (!UNSPECIFIEDP (value
))
4105 CHECK_SYMBOL (value
);
4106 if (!EQ (value
, Qt
) && !NILP (value
))
4107 signal_error ("Invalid inverse-video face attribute value", value
);
4109 old_value
= LFACE_INVERSE (lface
);
4110 LFACE_INVERSE (lface
) = value
;
4112 else if (EQ (attr
, QCforeground
))
4114 if (!UNSPECIFIEDP (value
))
4116 /* Don't check for valid color names here because it depends
4117 on the frame (display) whether the color will be valid
4118 when the face is realized. */
4119 CHECK_STRING (value
);
4120 if (XSTRING (value
)->size
== 0)
4121 signal_error ("Empty foreground color value", value
);
4123 old_value
= LFACE_FOREGROUND (lface
);
4124 LFACE_FOREGROUND (lface
) = value
;
4126 else if (EQ (attr
, QCbackground
))
4128 if (!UNSPECIFIEDP (value
))
4130 /* Don't check for valid color names here because it depends
4131 on the frame (display) whether the color will be valid
4132 when the face is realized. */
4133 CHECK_STRING (value
);
4134 if (XSTRING (value
)->size
== 0)
4135 signal_error ("Empty background color value", value
);
4137 old_value
= LFACE_BACKGROUND (lface
);
4138 LFACE_BACKGROUND (lface
) = value
;
4140 else if (EQ (attr
, QCstipple
))
4142 #ifdef HAVE_X_WINDOWS
4143 if (!UNSPECIFIEDP (value
)
4145 && NILP (Fbitmap_spec_p (value
)))
4146 signal_error ("Invalid stipple attribute", value
);
4147 old_value
= LFACE_STIPPLE (lface
);
4148 LFACE_STIPPLE (lface
) = value
;
4149 #endif /* HAVE_X_WINDOWS */
4151 else if (EQ (attr
, QCwidth
))
4153 if (!UNSPECIFIEDP (value
))
4155 CHECK_SYMBOL (value
);
4156 if (face_numeric_swidth (value
) < 0)
4157 signal_error ("Invalid face width", value
);
4159 old_value
= LFACE_SWIDTH (lface
);
4160 LFACE_SWIDTH (lface
) = value
;
4161 font_related_attr_p
= 1;
4163 else if (EQ (attr
, QCfont
) || EQ (attr
, QCfontset
))
4165 #ifdef HAVE_WINDOW_SYSTEM
4166 if (FRAME_WINDOW_P (XFRAME (frame
)))
4168 /* Set font-related attributes of the Lisp face from an XLFD
4173 CHECK_STRING (value
);
4175 f
= SELECTED_FRAME ();
4177 f
= check_x_frame (frame
);
4179 /* VALUE may be a fontset name or an alias of fontset. In
4180 such a case, use the base fontset name. */
4181 tmp
= Fquery_fontset (value
, Qnil
);
4184 else if (EQ (attr
, QCfontset
))
4185 signal_error ("Invalid fontset name", value
);
4187 if (EQ (attr
, QCfont
))
4189 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4190 signal_error ("Invalid font or fontset name", value
);
4193 LFACE_FONTSET (lface
) = value
;
4197 #endif /* HAVE_WINDOW_SYSTEM */
4199 else if (EQ (attr
, QCinherit
))
4202 if (SYMBOLP (value
))
4205 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4206 if (!SYMBOLP (XCAR (tail
)))
4209 LFACE_INHERIT (lface
) = value
;
4211 signal_error ("Invalid face inheritance", value
);
4213 else if (EQ (attr
, QCbold
))
4215 old_value
= LFACE_WEIGHT (lface
);
4216 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4217 font_related_attr_p
= 1;
4219 else if (EQ (attr
, QCitalic
))
4221 old_value
= LFACE_SLANT (lface
);
4222 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4223 font_related_attr_p
= 1;
4226 signal_error ("Invalid face attribute name", attr
);
4228 if (font_related_attr_p
4229 && !UNSPECIFIEDP (value
))
4230 /* If a font-related attribute other than QCfont is specified, the
4231 original `font' attribute nor that of default face is useless
4232 to determine a new font. Thus, we set it to nil so that font
4233 selection mechanism doesn't use it. */
4234 LFACE_FONT (lface
) = Qnil
;
4236 /* Changing a named face means that all realized faces depending on
4237 that face are invalid. Since we cannot tell which realized faces
4238 depend on the face, make sure they are all removed. This is done
4239 by incrementing face_change_count. The next call to
4240 init_iterator will then free realized faces. */
4242 && (EQ (attr
, QCfont
)
4243 || EQ (attr
, QCfontset
)
4244 || NILP (Fequal (old_value
, value
))))
4246 ++face_change_count
;
4247 ++windows_or_buffers_changed
;
4250 if (!UNSPECIFIEDP (value
)
4251 && NILP (Fequal (old_value
, value
)))
4257 if (EQ (face
, Qdefault
))
4259 #ifdef HAVE_WINDOW_SYSTEM
4260 /* Changed font-related attributes of the `default' face are
4261 reflected in changed `font' frame parameters. */
4263 && (font_related_attr_p
|| font_attr_p
)
4264 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4265 set_font_frame_param (frame
, lface
);
4267 #endif /* HAVE_WINDOW_SYSTEM */
4269 if (EQ (attr
, QCforeground
))
4270 param
= Qforeground_color
;
4271 else if (EQ (attr
, QCbackground
))
4272 param
= Qbackground_color
;
4274 #ifdef HAVE_WINDOW_SYSTEM
4276 else if (EQ (face
, Qscroll_bar
))
4278 /* Changing the colors of `scroll-bar' sets frame parameters
4279 `scroll-bar-foreground' and `scroll-bar-background'. */
4280 if (EQ (attr
, QCforeground
))
4281 param
= Qscroll_bar_foreground
;
4282 else if (EQ (attr
, QCbackground
))
4283 param
= Qscroll_bar_background
;
4285 #endif /* not WINDOWSNT */
4286 else if (EQ (face
, Qborder
))
4288 /* Changing background color of `border' sets frame parameter
4290 if (EQ (attr
, QCbackground
))
4291 param
= Qborder_color
;
4293 else if (EQ (face
, Qcursor
))
4295 /* Changing background color of `cursor' sets frame parameter
4297 if (EQ (attr
, QCbackground
))
4298 param
= Qcursor_color
;
4300 else if (EQ (face
, Qmouse
))
4302 /* Changing background color of `mouse' sets frame parameter
4304 if (EQ (attr
, QCbackground
))
4305 param
= Qmouse_color
;
4307 #endif /* HAVE_WINDOW_SYSTEM */
4308 else if (EQ (face
, Qmenu
))
4310 /* Indicate that we have to update the menu bar when
4311 realizing faces on FRAME. FRAME t change the
4312 default for new frames. We do this by setting
4313 setting the flag in new face caches */
4316 struct frame
*f
= XFRAME (frame
);
4317 if (FRAME_FACE_CACHE (f
) == NULL
)
4318 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4319 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4322 menu_face_changed_default
= 1;
4328 /* Update `default-frame-alist', which is used for new frames. */
4330 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4333 /* Update the current frame's parameters. */
4336 cons
= XCAR (Vparam_value_alist
);
4337 XSETCAR (cons
, param
);
4338 XSETCDR (cons
, value
);
4339 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4348 #ifdef HAVE_WINDOW_SYSTEM
4350 /* Set the `font' frame parameter of FRAME determined from `default'
4351 face attributes LFACE. If a font name is explicitely
4352 specfied in LFACE, use it as is. Otherwise, determine a font name
4353 from the other font-related atrributes of LFACE. In that case, if
4354 there's no matching font, signals an error. */
4357 set_font_frame_param (frame
, lface
)
4358 Lisp_Object frame
, lface
;
4360 struct frame
*f
= XFRAME (frame
);
4362 if (FRAME_WINDOW_P (f
))
4364 Lisp_Object font_name
;
4367 if (STRINGP (LFACE_FONT (lface
)))
4368 font_name
= LFACE_FONT (lface
);
4371 /* Choose a font name that reflects LFACE's attributes and has
4372 the registry and encoding pattern specified in the default
4373 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4374 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, Qnil
);
4376 error ("No font matches the specified attribute");
4377 font_name
= build_string (font
);
4381 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4386 /* Update the corresponding face when frame parameter PARAM on frame F
4387 has been assigned the value NEW_VALUE. */
4390 update_face_from_frame_parameter (f
, param
, new_value
)
4392 Lisp_Object param
, new_value
;
4396 /* If there are no faces yet, give up. This is the case when called
4397 from Fx_create_frame, and we do the necessary things later in
4398 face-set-after-frame-defaults. */
4399 if (NILP (f
->face_alist
))
4402 /* Changing a named face means that all realized faces depending on
4403 that face are invalid. Since we cannot tell which realized faces
4404 depend on the face, make sure they are all removed. This is done
4405 by incrementing face_change_count. The next call to
4406 init_iterator will then free realized faces. */
4407 ++face_change_count
;
4408 ++windows_or_buffers_changed
;
4410 if (EQ (param
, Qforeground_color
))
4412 lface
= lface_from_face_name (f
, Qdefault
, 1);
4413 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4414 ? new_value
: Qunspecified
);
4415 realize_basic_faces (f
);
4417 else if (EQ (param
, Qbackground_color
))
4421 /* Changing the background color might change the background
4422 mode, so that we have to load new defface specs. Call
4423 frame-update-face-colors to do that. */
4424 XSETFRAME (frame
, f
);
4425 call1 (Qframe_update_face_colors
, frame
);
4427 lface
= lface_from_face_name (f
, Qdefault
, 1);
4428 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4429 ? new_value
: Qunspecified
);
4430 realize_basic_faces (f
);
4432 if (EQ (param
, Qborder_color
))
4434 lface
= lface_from_face_name (f
, Qborder
, 1);
4435 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4436 ? new_value
: Qunspecified
);
4438 else if (EQ (param
, Qcursor_color
))
4440 lface
= lface_from_face_name (f
, Qcursor
, 1);
4441 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4442 ? new_value
: Qunspecified
);
4444 else if (EQ (param
, Qmouse_color
))
4446 lface
= lface_from_face_name (f
, Qmouse
, 1);
4447 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4448 ? new_value
: Qunspecified
);
4453 /* Get the value of X resource RESOURCE, class CLASS for the display
4454 of frame FRAME. This is here because ordinary `x-get-resource'
4455 doesn't take a frame argument. */
4457 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4458 Sinternal_face_x_get_resource
, 3, 3, 0, doc
: /* */)
4459 (resource
, class, frame
)
4460 Lisp_Object resource
, class, frame
;
4462 Lisp_Object value
= Qnil
;
4465 CHECK_STRING (resource
);
4466 CHECK_STRING (class);
4467 CHECK_LIVE_FRAME (frame
);
4469 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4470 resource
, class, Qnil
, Qnil
);
4472 #endif /* not macintosh */
4473 #endif /* not WINDOWSNT */
4478 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4479 If VALUE is "on" or "true", return t. If VALUE is "off" or
4480 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4481 error; if SIGNAL_P is zero, return 0. */
4484 face_boolean_x_resource_value (value
, signal_p
)
4488 Lisp_Object result
= make_number (0);
4490 xassert (STRINGP (value
));
4492 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4493 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4495 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4496 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4498 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4499 result
= Qunspecified
;
4501 signal_error ("Invalid face attribute value from X resource", value
);
4507 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4508 Finternal_set_lisp_face_attribute_from_resource
,
4509 Sinternal_set_lisp_face_attribute_from_resource
,
4510 3, 4, 0, doc
: /* */)
4511 (face
, attr
, value
, frame
)
4512 Lisp_Object face
, attr
, value
, frame
;
4514 CHECK_SYMBOL (face
);
4515 CHECK_SYMBOL (attr
);
4516 CHECK_STRING (value
);
4518 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4519 value
= Qunspecified
;
4520 else if (EQ (attr
, QCheight
))
4522 value
= Fstring_to_number (value
, make_number (10));
4523 if (XINT (value
) <= 0)
4524 signal_error ("Invalid face height from X resource", value
);
4526 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4527 value
= face_boolean_x_resource_value (value
, 1);
4528 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4529 value
= intern (XSTRING (value
)->data
);
4530 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4531 value
= face_boolean_x_resource_value (value
, 1);
4532 else if (EQ (attr
, QCunderline
)
4533 || EQ (attr
, QCoverline
)
4534 || EQ (attr
, QCstrike_through
))
4536 Lisp_Object boolean_value
;
4538 /* If the result of face_boolean_x_resource_value is t or nil,
4539 VALUE does NOT specify a color. */
4540 boolean_value
= face_boolean_x_resource_value (value
, 0);
4541 if (SYMBOLP (boolean_value
))
4542 value
= boolean_value
;
4544 else if (EQ (attr
, QCbox
))
4545 value
= Fcar (Fread_from_string (value
, Qnil
, Qnil
));
4547 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4550 #endif /* HAVE_WINDOW_SYSTEM */
4553 /***********************************************************************
4555 ***********************************************************************/
4557 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4559 /* Make menus on frame F appear as specified by the `menu' face. */
4562 x_update_menu_appearance (f
)
4565 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4569 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4573 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4574 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4575 char *myname
= XSTRING (Vx_resource_name
)->data
;
4578 const char *popup_path
= "popup_menu";
4580 const char *popup_path
= "menu.popup";
4583 if (STRINGP (LFACE_FOREGROUND (lface
)))
4585 sprintf (line
, "%s.%s*foreground: %s",
4587 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4588 XrmPutLineResource (&rdb
, line
);
4589 sprintf (line
, "%s.pane.menubar*foreground: %s",
4590 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4591 XrmPutLineResource (&rdb
, line
);
4595 if (STRINGP (LFACE_BACKGROUND (lface
)))
4597 sprintf (line
, "%s.%s*background: %s",
4599 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4600 XrmPutLineResource (&rdb
, line
);
4601 sprintf (line
, "%s.pane.menubar*background: %s",
4602 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4603 XrmPutLineResource (&rdb
, line
);
4608 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4609 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4610 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4611 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4612 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4613 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4616 const char *suffix
= "List";
4618 const char *suffix
= "";
4620 sprintf (line
, "%s.pane.menubar*font%s: %s",
4621 myname
, suffix
, face
->font_name
);
4622 XrmPutLineResource (&rdb
, line
);
4623 sprintf (line
, "%s.%s*font%s: %s",
4624 myname
, popup_path
, suffix
, face
->font_name
);
4625 XrmPutLineResource (&rdb
, line
);
4629 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4630 free_frame_menubar (f
);
4634 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4637 DEFUN ("face-attribute-relative-p", Fface_attribute_relative_p
,
4638 Sface_attribute_relative_p
,
4640 doc
: /* Return non-nil if face ATTRIBUTE VALUE is relative. */)
4642 Lisp_Object attribute
, value
;
4644 if (EQ (value
, Qunspecified
))
4646 else if (EQ (attribute
, QCheight
))
4647 return INTEGERP (value
) ? Qnil
: Qt
;
4652 DEFUN ("merge-face-attribute", Fmerge_face_attribute
, Smerge_face_attribute
,
4654 doc
: /* Return face ATTRIBUTE VALUE1 merged with VALUE2.
4655 If VALUE1 or VALUE2 are absolute (see `face-attribute-relative-p'), then
4656 the result will be absolute, otherwise it will be relative. */)
4657 (attribute
, value1
, value2
)
4658 Lisp_Object attribute
, value1
, value2
;
4660 if (EQ (value1
, Qunspecified
))
4662 else if (EQ (attribute
, QCheight
))
4663 return merge_face_heights (value1
, value2
, value1
, Qnil
);
4669 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4670 Sinternal_get_lisp_face_attribute
,
4672 doc
: /* Return face attribute KEYWORD of face SYMBOL.
4673 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid
4674 face attribute name, signal an error.
4675 If the optional argument FRAME is given, report on face FACE in that
4676 frame. If FRAME is t, report on the defaults for face FACE (for new
4677 frames). If FRAME is omitted or nil, use the selected frame. */)
4678 (symbol
, keyword
, frame
)
4679 Lisp_Object symbol
, keyword
, frame
;
4681 Lisp_Object lface
, value
= Qnil
;
4683 CHECK_SYMBOL (symbol
);
4684 CHECK_SYMBOL (keyword
);
4687 lface
= lface_from_face_name (NULL
, symbol
, 1);
4691 frame
= selected_frame
;
4692 CHECK_LIVE_FRAME (frame
);
4693 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4696 if (EQ (keyword
, QCfamily
))
4697 value
= LFACE_FAMILY (lface
);
4698 else if (EQ (keyword
, QCheight
))
4699 value
= LFACE_HEIGHT (lface
);
4700 else if (EQ (keyword
, QCweight
))
4701 value
= LFACE_WEIGHT (lface
);
4702 else if (EQ (keyword
, QCslant
))
4703 value
= LFACE_SLANT (lface
);
4704 else if (EQ (keyword
, QCunderline
))
4705 value
= LFACE_UNDERLINE (lface
);
4706 else if (EQ (keyword
, QCoverline
))
4707 value
= LFACE_OVERLINE (lface
);
4708 else if (EQ (keyword
, QCstrike_through
))
4709 value
= LFACE_STRIKE_THROUGH (lface
);
4710 else if (EQ (keyword
, QCbox
))
4711 value
= LFACE_BOX (lface
);
4712 else if (EQ (keyword
, QCinverse_video
)
4713 || EQ (keyword
, QCreverse_video
))
4714 value
= LFACE_INVERSE (lface
);
4715 else if (EQ (keyword
, QCforeground
))
4716 value
= LFACE_FOREGROUND (lface
);
4717 else if (EQ (keyword
, QCbackground
))
4718 value
= LFACE_BACKGROUND (lface
);
4719 else if (EQ (keyword
, QCstipple
))
4720 value
= LFACE_STIPPLE (lface
);
4721 else if (EQ (keyword
, QCwidth
))
4722 value
= LFACE_SWIDTH (lface
);
4723 else if (EQ (keyword
, QCinherit
))
4724 value
= LFACE_INHERIT (lface
);
4725 else if (EQ (keyword
, QCfont
))
4726 value
= LFACE_FONT (lface
);
4727 else if (EQ (keyword
, QCfontset
))
4728 value
= LFACE_FONTSET (lface
);
4730 signal_error ("Invalid face attribute name", keyword
);
4736 DEFUN ("internal-lisp-face-attribute-values",
4737 Finternal_lisp_face_attribute_values
,
4738 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4739 doc
: /* Return a list of valid discrete values for face attribute ATTR.
4740 Value is nil if ATTR doesn't have a discrete set of valid values. */)
4744 Lisp_Object result
= Qnil
;
4746 CHECK_SYMBOL (attr
);
4748 if (EQ (attr
, QCweight
)
4749 || EQ (attr
, QCslant
)
4750 || EQ (attr
, QCwidth
))
4752 /* Extract permissible symbols from tables. */
4753 struct table_entry
*table
;
4756 if (EQ (attr
, QCweight
))
4757 table
= weight_table
, dim
= DIM (weight_table
);
4758 else if (EQ (attr
, QCslant
))
4759 table
= slant_table
, dim
= DIM (slant_table
);
4761 table
= swidth_table
, dim
= DIM (swidth_table
);
4763 for (i
= 0; i
< dim
; ++i
)
4765 Lisp_Object symbol
= *table
[i
].symbol
;
4766 Lisp_Object tail
= result
;
4769 && !EQ (XCAR (tail
), symbol
))
4773 result
= Fcons (symbol
, result
);
4776 else if (EQ (attr
, QCunderline
))
4777 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4778 else if (EQ (attr
, QCoverline
))
4779 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4780 else if (EQ (attr
, QCstrike_through
))
4781 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4782 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4783 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4789 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4790 Sinternal_merge_in_global_face
, 2, 2, 0,
4791 doc
: /* Add attributes from frame-default definition of FACE to FACE on FRAME.
4792 Default face attributes override any local face attributes. */)
4794 Lisp_Object face
, frame
;
4797 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4799 CHECK_LIVE_FRAME (frame
);
4800 global_lface
= lface_from_face_name (NULL
, face
, 1);
4801 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4802 if (NILP (local_lface
))
4803 local_lface
= Finternal_make_lisp_face (face
, frame
);
4805 /* Make every specified global attribute override the local one.
4806 BEWARE!! This is only used from `face-set-after-frame-default' where
4807 the local frame is defined from default specs in `face-defface-spec'
4808 and those should be overridden by global settings. Hence the strange
4809 "global before local" priority. */
4810 lvec
= XVECTOR (local_lface
)->contents
;
4811 gvec
= XVECTOR (global_lface
)->contents
;
4812 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4813 if (! UNSPECIFIEDP (gvec
[i
]))
4820 /* The following function is implemented for compatibility with 20.2.
4821 The function is used in x-resolve-fonts when it is asked to
4822 return fonts with the same size as the font of a face. This is
4823 done in fontset.el. */
4825 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4826 doc
: /* Return the font name of face FACE, or nil if it is unspecified.
4827 If the optional argument FRAME is given, report on face FACE in that frame.
4828 If FRAME is t, report on the defaults for face FACE (for new frames).
4829 The font default for a face is either nil, or a list
4830 of the form (bold), (italic) or (bold italic).
4831 If FRAME is omitted or nil, use the selected frame. */)
4833 Lisp_Object face
, frame
;
4837 Lisp_Object result
= Qnil
;
4838 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4840 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4841 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4842 result
= Fcons (Qbold
, result
);
4844 if (!UNSPECIFIEDP (LFACE_SLANT (lface
))
4845 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4846 result
= Fcons (Qitalic
, result
);
4852 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4853 int face_id
= lookup_named_face (f
, face
);
4854 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4855 return face
? build_string (face
->font_name
) : Qnil
;
4860 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4861 all attributes are `equal'. Tries to be fast because this function
4862 is called quite often. */
4865 lface_equal_p (v1
, v2
)
4866 Lisp_Object
*v1
, *v2
;
4870 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4872 Lisp_Object a
= v1
[i
];
4873 Lisp_Object b
= v2
[i
];
4875 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4876 and the other is specified. */
4877 equal_p
= XTYPE (a
) == XTYPE (b
);
4886 equal_p
= ((STRING_BYTES (XSTRING (a
))
4887 == STRING_BYTES (XSTRING (b
)))
4888 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4889 STRING_BYTES (XSTRING (a
))) == 0);
4898 equal_p
= !NILP (Fequal (a
, b
));
4908 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4909 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4910 doc
: /* True if FACE1 and FACE2 are equal.
4911 If the optional argument FRAME is given, report on face FACE in that frame.
4912 If FRAME is t, report on the defaults for face FACE (for new frames).
4913 If FRAME is omitted or nil, use the selected frame. */)
4914 (face1
, face2
, frame
)
4915 Lisp_Object face1
, face2
, frame
;
4919 Lisp_Object lface1
, lface2
;
4924 /* Don't use check_x_frame here because this function is called
4925 before X frames exist. At that time, if FRAME is nil,
4926 selected_frame will be used which is the frame dumped with
4927 Emacs. That frame is not an X frame. */
4928 f
= frame_or_selected_frame (frame
, 2);
4930 lface1
= lface_from_face_name (NULL
, face1
, 1);
4931 lface2
= lface_from_face_name (NULL
, face2
, 1);
4932 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4933 XVECTOR (lface2
)->contents
);
4934 return equal_p
? Qt
: Qnil
;
4938 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4939 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4940 doc
: /* True if FACE has no attribute specified.
4941 If the optional argument FRAME is given, report on face FACE in that frame.
4942 If FRAME is t, report on the defaults for face FACE (for new frames).
4943 If FRAME is omitted or nil, use the selected frame. */)
4945 Lisp_Object face
, frame
;
4952 frame
= selected_frame
;
4953 CHECK_LIVE_FRAME (frame
);
4957 lface
= lface_from_face_name (NULL
, face
, 1);
4959 lface
= lface_from_face_name (f
, face
, 1);
4961 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4962 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4965 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4969 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4971 doc
: /* Return an alist of frame-local faces defined on FRAME.
4972 For internal use only. */)
4976 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4977 return f
->face_alist
;
4981 /* Return a hash code for Lisp string STRING with case ignored. Used
4982 below in computing a hash value for a Lisp face. */
4984 static INLINE
unsigned
4985 hash_string_case_insensitive (string
)
4990 xassert (STRINGP (string
));
4991 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4992 hash
= (hash
<< 1) ^ tolower (*s
);
4997 /* Return a hash code for face attribute vector V. */
4999 static INLINE
unsigned
5003 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
5004 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
5005 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
5006 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
5007 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
5008 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
5009 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
5013 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
5014 considering charsets/registries). They do if they specify the same
5015 family, point size, weight, width, slant, font, and fontset. Both
5016 LFACE1 and LFACE2 must be fully-specified. */
5019 lface_same_font_attributes_p (lface1
, lface2
)
5020 Lisp_Object
*lface1
, *lface2
;
5022 xassert (lface_fully_specified_p (lface1
)
5023 && lface_fully_specified_p (lface2
));
5024 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
5025 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
5026 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
5027 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
5028 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
5029 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
5030 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
5031 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
5032 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
5033 && STRINGP (lface2
[LFACE_FONT_INDEX
])
5034 && ! xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
5035 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
)))
5036 && (EQ (lface1
[LFACE_FONTSET_INDEX
], lface2
[LFACE_FONTSET_INDEX
])
5037 || (STRINGP (lface1
[LFACE_FONTSET_INDEX
])
5038 && STRINGP (lface2
[LFACE_FONTSET_INDEX
])
5039 && ! xstricmp (XSTRING (lface1
[LFACE_FONTSET_INDEX
])->data
,
5040 XSTRING (lface2
[LFACE_FONTSET_INDEX
])->data
)))
5046 /***********************************************************************
5048 ***********************************************************************/
5050 /* Allocate and return a new realized face for Lisp face attribute
5053 static struct face
*
5054 make_realized_face (attr
)
5057 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
5058 bzero (face
, sizeof *face
);
5059 face
->ascii_face
= face
;
5060 bcopy (attr
, face
->lface
, sizeof face
->lface
);
5065 /* Free realized face FACE, including its X resources. FACE may
5069 free_realized_face (f
, face
)
5075 #ifdef HAVE_WINDOW_SYSTEM
5076 if (FRAME_WINDOW_P (f
))
5078 /* Free fontset of FACE if it is ASCII face. */
5079 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
5080 free_face_fontset (f
, face
);
5083 x_free_gc (f
, face
->gc
);
5087 free_face_colors (f
, face
);
5088 x_destroy_bitmap (f
, face
->stipple
);
5090 #endif /* HAVE_WINDOW_SYSTEM */
5097 /* Prepare face FACE for subsequent display on frame F. This
5098 allocated GCs if they haven't been allocated yet or have been freed
5099 by clearing the face cache. */
5102 prepare_face_for_display (f
, face
)
5106 #ifdef HAVE_WINDOW_SYSTEM
5107 xassert (FRAME_WINDOW_P (f
));
5112 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5114 xgcv
.foreground
= face
->foreground
;
5115 xgcv
.background
= face
->background
;
5116 #ifdef HAVE_X_WINDOWS
5117 xgcv
.graphics_exposures
= False
;
5119 /* The font of FACE may be null if we couldn't load it. */
5122 #ifdef HAVE_X_WINDOWS
5123 xgcv
.font
= face
->font
->fid
;
5126 xgcv
.font
= face
->font
;
5129 xgcv
.font
= face
->font
;
5135 #ifdef HAVE_X_WINDOWS
5138 xgcv
.fill_style
= FillOpaqueStippled
;
5139 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5140 mask
|= GCFillStyle
| GCStipple
;
5143 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5146 #endif /* HAVE_WINDOW_SYSTEM */
5150 /***********************************************************************
5152 ***********************************************************************/
5154 /* Return a new face cache for frame F. */
5156 static struct face_cache
*
5160 struct face_cache
*c
;
5163 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5164 bzero (c
, sizeof *c
);
5165 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5166 c
->buckets
= (struct face
**) xmalloc (size
);
5167 bzero (c
->buckets
, size
);
5169 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5171 c
->menu_face_changed_p
= menu_face_changed_default
;
5176 /* Clear out all graphics contexts for all realized faces, except for
5177 the basic faces. This should be done from time to time just to avoid
5178 keeping too many graphics contexts that are no longer needed. */
5182 struct face_cache
*c
;
5184 if (c
&& FRAME_WINDOW_P (c
->f
))
5186 #ifdef HAVE_WINDOW_SYSTEM
5188 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5190 struct face
*face
= c
->faces_by_id
[i
];
5191 if (face
&& face
->gc
)
5193 x_free_gc (c
->f
, face
->gc
);
5197 #endif /* HAVE_WINDOW_SYSTEM */
5202 /* Free all realized faces in face cache C, including basic faces. C
5203 may be null. If faces are freed, make sure the frame's current
5204 matrix is marked invalid, so that a display caused by an expose
5205 event doesn't try to use faces we destroyed. */
5208 free_realized_faces (c
)
5209 struct face_cache
*c
;
5214 struct frame
*f
= c
->f
;
5216 /* We must block input here because we can't process X events
5217 safely while only some faces are freed, or when the frame's
5218 current matrix still references freed faces. */
5221 for (i
= 0; i
< c
->used
; ++i
)
5223 free_realized_face (f
, c
->faces_by_id
[i
]);
5224 c
->faces_by_id
[i
] = NULL
;
5228 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5229 bzero (c
->buckets
, size
);
5231 /* Must do a thorough redisplay the next time. Mark current
5232 matrices as invalid because they will reference faces freed
5233 above. This function is also called when a frame is
5234 destroyed. In this case, the root window of F is nil. */
5235 if (WINDOWP (f
->root_window
))
5237 clear_current_matrices (f
);
5238 ++windows_or_buffers_changed
;
5246 /* Free all realized faces that are using FONTSET on frame F. */
5249 free_realized_faces_for_fontset (f
, fontset
)
5253 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5257 /* We must block input here because we can't process X events safely
5258 while only some faces are freed, or when the frame's current
5259 matrix still references freed faces. */
5262 for (i
= 0; i
< cache
->used
; i
++)
5264 face
= cache
->faces_by_id
[i
];
5266 && face
->fontset
== fontset
)
5268 uncache_face (cache
, face
);
5269 free_realized_face (f
, face
);
5273 /* Must do a thorough redisplay the next time. Mark current
5274 matrices as invalid because they will reference faces freed
5275 above. This function is also called when a frame is destroyed.
5276 In this case, the root window of F is nil. */
5277 if (WINDOWP (f
->root_window
))
5279 clear_current_matrices (f
);
5280 ++windows_or_buffers_changed
;
5287 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5288 This is done after attributes of a named face have been changed,
5289 because we can't tell which realized faces depend on that face. */
5292 free_all_realized_faces (frame
)
5298 FOR_EACH_FRAME (rest
, frame
)
5299 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5302 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5306 /* Free face cache C and faces in it, including their X resources. */
5310 struct face_cache
*c
;
5314 free_realized_faces (c
);
5316 xfree (c
->faces_by_id
);
5322 /* Cache realized face FACE in face cache C. HASH is the hash value
5323 of FACE. If FACE is for ASCII characters (i.e. FACE->ascii_face ==
5324 FACE), insert the new face to the beginning of the collision list
5325 of the face hash table of C. Otherwise, add the new face to the
5326 end of the collision list. This way, lookup_face can quickly find
5327 that a requested face is not cached. */
5330 cache_face (c
, face
, hash
)
5331 struct face_cache
*c
;
5335 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5339 if (face
->ascii_face
!= face
)
5341 struct face
*last
= c
->buckets
[i
];
5352 c
->buckets
[i
] = face
;
5353 face
->prev
= face
->next
= NULL
;
5359 face
->next
= c
->buckets
[i
];
5361 face
->next
->prev
= face
;
5362 c
->buckets
[i
] = face
;
5365 /* Find a free slot in C->faces_by_id and use the index of the free
5366 slot as FACE->id. */
5367 for (i
= 0; i
< c
->used
; ++i
)
5368 if (c
->faces_by_id
[i
] == NULL
)
5372 /* Maybe enlarge C->faces_by_id. */
5373 if (i
== c
->used
&& c
->used
== c
->size
)
5375 int new_size
= 2 * c
->size
;
5376 int sz
= new_size
* sizeof *c
->faces_by_id
;
5377 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5382 /* Check that FACE got a unique id. */
5387 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5388 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5394 #endif /* GLYPH_DEBUG */
5396 c
->faces_by_id
[i
] = face
;
5402 /* Remove face FACE from cache C. */
5405 uncache_face (c
, face
)
5406 struct face_cache
*c
;
5409 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5412 face
->prev
->next
= face
->next
;
5414 c
->buckets
[i
] = face
->next
;
5417 face
->next
->prev
= face
->prev
;
5419 c
->faces_by_id
[face
->id
] = NULL
;
5420 if (face
->id
== c
->used
)
5425 /* Look up a realized face with face attributes ATTR in the face cache
5426 of frame F. The face will be used to display ASCII characters.
5427 Value is the ID of the face found. If no suitable face is found,
5428 realize a new one. */
5431 lookup_face (f
, attr
)
5435 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5440 xassert (cache
!= NULL
);
5441 check_lface_attrs (attr
);
5443 /* Look up ATTR in the face cache. */
5444 hash
= lface_hash (attr
);
5445 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5447 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5449 if (face
->ascii_face
!= face
)
5451 /* There's no more ASCII face. */
5455 if (face
->hash
== hash
5456 && lface_equal_p (face
->lface
, attr
))
5460 /* If not found, realize a new face. */
5462 face
= realize_face (cache
, attr
, -1);
5465 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5466 #endif /* GLYPH_DEBUG */
5472 /* Look up a realized face that has the same attributes as BASE_FACE
5473 except for the font in the face cache of frame F. If FONT_ID is
5474 not negative, it is an ID number of an already opened font that is
5475 used by the face. If FONT_ID is negative, the face has no font.
5476 Value is the ID of the face found. If no suitable face is found,
5477 realize a new one. */
5480 lookup_non_ascii_face (f
, font_id
, base_face
)
5483 struct face
*base_face
;
5485 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5490 xassert (cache
!= NULL
);
5491 base_face
= base_face
->ascii_face
;
5492 hash
= lface_hash (base_face
->lface
);
5493 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5495 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5497 if (face
->ascii_face
== face
)
5499 if (face
->ascii_face
== base_face
5500 && face
->font_info_id
== font_id
)
5504 /* If not found, realize a new face. */
5506 face
= realize_non_ascii_face (f
, font_id
, base_face
);
5509 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5510 #endif /* GLYPH_DEBUG */
5516 /* Return the face id of the realized face for named face SYMBOL on
5517 frame F suitable for displaying ASCII characters. Value is -1 if
5518 the face couldn't be determined, which might happen if the default
5519 face isn't realized and cannot be realized. */
5522 lookup_named_face (f
, symbol
)
5526 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5527 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5528 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5530 if (default_face
== NULL
)
5532 if (!realize_basic_faces (f
))
5534 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5537 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5538 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5539 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5540 return lookup_face (f
, attrs
);
5544 /* Return the ID of the realized ASCII face of Lisp face with ID
5545 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5548 ascii_face_of_lisp_face (f
, lface_id
)
5554 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5556 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5557 face_id
= lookup_named_face (f
, face_name
);
5566 /* Return a face for charset ASCII that is like the face with id
5567 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5568 STEPS < 0 means larger. Value is the id of the face. */
5571 smaller_face (f
, face_id
, steps
)
5575 #ifdef HAVE_WINDOW_SYSTEM
5577 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5578 int pt
, last_pt
, last_height
;
5581 struct face
*new_face
;
5583 /* If not called for an X frame, just return the original face. */
5584 if (FRAME_TERMCAP_P (f
))
5587 /* Try in increments of 1/2 pt. */
5588 delta
= steps
< 0 ? 5 : -5;
5589 steps
= abs (steps
);
5591 face
= FACE_FROM_ID (f
, face_id
);
5592 bcopy (face
->lface
, attrs
, sizeof attrs
);
5593 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5594 new_face_id
= face_id
;
5595 last_height
= FONT_HEIGHT (face
->font
);
5599 /* Give up if we cannot find a font within 10pt. */
5600 && abs (last_pt
- pt
) < 100)
5602 /* Look up a face for a slightly smaller/larger font. */
5604 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5605 new_face_id
= lookup_face (f
, attrs
);
5606 new_face
= FACE_FROM_ID (f
, new_face_id
);
5608 /* If height changes, count that as one step. */
5609 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5610 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5613 last_height
= FONT_HEIGHT (new_face
->font
);
5620 #else /* not HAVE_WINDOW_SYSTEM */
5624 #endif /* not HAVE_WINDOW_SYSTEM */
5628 /* Return a face for charset ASCII that is like the face with id
5629 FACE_ID on frame F, but has height HEIGHT. */
5632 face_with_height (f
, face_id
, height
)
5637 #ifdef HAVE_WINDOW_SYSTEM
5639 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5641 if (FRAME_TERMCAP_P (f
)
5645 face
= FACE_FROM_ID (f
, face_id
);
5646 bcopy (face
->lface
, attrs
, sizeof attrs
);
5647 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5648 face_id
= lookup_face (f
, attrs
);
5649 #endif /* HAVE_WINDOW_SYSTEM */
5655 /* Return the face id of the realized face for named face SYMBOL on
5656 frame F suitable for displaying ASCII characters, and use
5657 attributes of the face FACE_ID for attributes that aren't
5658 completely specified by SYMBOL. This is like lookup_named_face,
5659 except that the default attributes come from FACE_ID, not from the
5660 default face. FACE_ID is assumed to be already realized. */
5663 lookup_derived_face (f
, symbol
, face_id
)
5668 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5669 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5670 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5675 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5676 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5677 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5678 return lookup_face (f
, attrs
);
5681 DEFUN ("face-attributes-as-vector", Fface_attributes_as_vector
,
5682 Sface_attributes_as_vector
, 1, 1, 0,
5683 doc
: /* Return a vector of face attributes corresponding to PLIST. */)
5688 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
5690 merge_face_vector_with_property (XFRAME (selected_frame
),
5691 XVECTOR (lface
)->contents
,
5698 /***********************************************************************
5700 ***********************************************************************/
5702 DEFUN ("internal-set-font-selection-order",
5703 Finternal_set_font_selection_order
,
5704 Sinternal_set_font_selection_order
, 1, 1, 0,
5705 doc
: /* Set font selection order for face font selection to ORDER.
5706 ORDER must be a list of length 4 containing the symbols `:width',
5707 `:height', `:weight', and `:slant'. Face attributes appearing
5708 first in ORDER are matched first, e.g. if `:height' appears before
5709 `:weight' in ORDER, font selection first tries to find a font with
5710 a suitable height, and then tries to match the font weight.
5717 int indices
[DIM (font_sort_order
)];
5720 bzero (indices
, sizeof indices
);
5724 CONSP (list
) && i
< DIM (indices
);
5725 list
= XCDR (list
), ++i
)
5727 Lisp_Object attr
= XCAR (list
);
5730 if (EQ (attr
, QCwidth
))
5732 else if (EQ (attr
, QCheight
))
5733 xlfd
= XLFD_POINT_SIZE
;
5734 else if (EQ (attr
, QCweight
))
5736 else if (EQ (attr
, QCslant
))
5741 if (indices
[i
] != 0)
5746 if (!NILP (list
) || i
!= DIM (indices
))
5747 signal_error ("Invalid font sort order", order
);
5748 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5749 if (indices
[i
] == 0)
5750 signal_error ("Invalid font sort order", order
);
5752 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5754 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5755 free_all_realized_faces (Qnil
);
5762 DEFUN ("internal-set-alternative-font-family-alist",
5763 Finternal_set_alternative_font_family_alist
,
5764 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5765 doc
: /* Define alternative font families to try in face font selection.
5766 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5767 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can
5768 be found. Value is ALIST. */)
5773 Vface_alternative_font_family_alist
= alist
;
5774 free_all_realized_faces (Qnil
);
5779 DEFUN ("internal-set-alternative-font-registry-alist",
5780 Finternal_set_alternative_font_registry_alist
,
5781 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5782 doc
: /* Define alternative font registries to try in face font selection.
5783 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.
5784 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can
5785 be found. Value is ALIST. */)
5790 Vface_alternative_font_registry_alist
= alist
;
5791 free_all_realized_faces (Qnil
);
5796 #ifdef HAVE_WINDOW_SYSTEM
5798 /* Value is non-zero if FONT is the name of a scalable font. The
5799 X11R6 XLFD spec says that point size, pixel size, and average width
5800 are zero for scalable fonts. Intlfonts contain at least one
5801 scalable font ("*-muleindian-1") for which this isn't true, so we
5802 just test average width. */
5805 font_scalable_p (font
)
5806 struct font_name
*font
;
5808 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5809 return (*s
== '0' && *(s
+ 1) == '\0')
5811 /* Windows implementation of XLFD is slightly broken for backward
5812 compatibility with previous broken versions, so test for
5813 wildcards as well as 0. */
5820 /* Ignore the difference of font point size less than this value. */
5822 #define FONT_POINT_SIZE_QUANTUM 5
5824 /* Value is non-zero if FONT1 is a better match for font attributes
5825 VALUES than FONT2. VALUES is an array of face attribute values in
5826 font sort order. COMPARE_PT_P zero means don't compare point
5827 sizes. AVGWIDTH, if not zero, is a specified font average width
5831 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5833 struct font_name
*font1
, *font2
;
5834 int compare_pt_p
, avgwidth
;
5838 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5840 int xlfd_idx
= font_sort_order
[i
];
5842 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5846 if (xlfd_idx
== XLFD_POINT_SIZE
)
5848 delta1
= abs (values
[i
] - (font1
->numeric
[xlfd_idx
]
5849 / font1
->rescale_ratio
));
5850 delta2
= abs (values
[i
] - (font2
->numeric
[xlfd_idx
]
5851 / font2
->rescale_ratio
));
5852 if (abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5857 delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5858 delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5861 if (delta1
> delta2
)
5863 else if (delta1
< delta2
)
5867 /* The difference may be equal because, e.g., the face
5868 specifies `italic' but we have only `regular' and
5869 `oblique'. Prefer `oblique' in this case. */
5870 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5871 && font1
->numeric
[xlfd_idx
] > values
[i
]
5872 && font2
->numeric
[xlfd_idx
] < values
[i
])
5880 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5881 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5882 if (delta1
> delta2
)
5884 else if (delta1
< delta2
)
5888 return font1
->registry_priority
< font2
->registry_priority
;
5892 /* Value is non-zero if FONT is an exact match for face attributes in
5893 SPECIFIED. SPECIFIED is an array of face attribute values in font
5894 sort order. AVGWIDTH, if non-zero, is an average width to compare
5898 exact_face_match_p (specified
, font
, avgwidth
)
5900 struct font_name
*font
;
5905 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5906 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5909 return (i
== DIM (font_sort_order
)
5911 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5915 /* Value is the name of a scaled font, generated from scalable font
5916 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5917 Value is allocated from heap. */
5920 build_scalable_font_name (f
, font
, specified_pt
)
5922 struct font_name
*font
;
5925 char point_size
[20], pixel_size
[20];
5927 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5930 /* If scalable font is for a specific resolution, compute
5931 the point size we must specify from the resolution of
5932 the display and the specified resolution of the font. */
5933 if (font
->numeric
[XLFD_RESY
] != 0)
5935 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5936 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5941 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5943 /* We may need a font of the different size. */
5944 pixel_value
*= font
->rescale_ratio
;
5946 /* We should keep POINT_SIZE 0. Otherwise, X server can't open a
5947 font of the specified PIXEL_SIZE. */
5949 /* Set point size of the font. */
5950 sprintf (point_size
, "%d", (int) pt
);
5951 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5952 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5955 /* Set pixel size. */
5956 sprintf (pixel_size
, "%d", pixel_value
);
5957 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5958 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5960 /* If font doesn't specify its resolution, use the
5961 resolution of the display. */
5962 if (font
->numeric
[XLFD_RESY
] == 0)
5965 sprintf (buffer
, "%d", (int) resy
);
5966 font
->fields
[XLFD_RESY
] = buffer
;
5967 font
->numeric
[XLFD_RESY
] = resy
;
5970 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5973 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5974 sprintf (buffer
, "%d", resx
);
5975 font
->fields
[XLFD_RESX
] = buffer
;
5976 font
->numeric
[XLFD_RESX
] = resx
;
5979 return build_font_name (font
);
5983 /* Value is non-zero if we are allowed to use scalable font FONT. We
5984 can't run a Lisp function here since this function may be called
5985 with input blocked. */
5988 may_use_scalable_font_p (font
)
5991 if (EQ (Vscalable_fonts_allowed
, Qt
))
5993 else if (CONSP (Vscalable_fonts_allowed
))
5995 Lisp_Object tail
, regexp
;
5997 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5999 regexp
= XCAR (tail
);
6000 if (STRINGP (regexp
)
6001 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
6011 /* Return the name of the best matching font for face attributes ATTRS
6012 in the array of font_name structures FONTS which contains NFONTS
6013 elements. WIDTH_RATIO is a factor with which to multiply average
6014 widths if ATTRS specifies such a width.
6016 Value is a font name which is allocated from the heap. FONTS is
6017 freed by this function. */
6020 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
6023 struct font_name
*fonts
;
6028 struct font_name
*best
;
6031 int exact_p
, avgwidth
;
6036 /* Make specified font attributes available in `specified',
6037 indexed by sort order. */
6038 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6040 int xlfd_idx
= font_sort_order
[i
];
6042 if (xlfd_idx
== XLFD_SWIDTH
)
6043 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
6044 else if (xlfd_idx
== XLFD_POINT_SIZE
)
6045 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
6046 else if (xlfd_idx
== XLFD_WEIGHT
)
6047 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6048 else if (xlfd_idx
== XLFD_SLANT
)
6049 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6054 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
6056 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
6060 /* Start with the first non-scalable font in the list. */
6061 for (i
= 0; i
< nfonts
; ++i
)
6062 if (!font_scalable_p (fonts
+ i
))
6065 /* Find the best match among the non-scalable fonts. */
6070 for (i
= 1; i
< nfonts
; ++i
)
6071 if (!font_scalable_p (fonts
+ i
)
6072 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
6076 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
6085 /* Unless we found an exact match among non-scalable fonts, see if
6086 we can find a better match among scalable fonts. */
6089 /* A scalable font is better if
6091 1. its weight, slant, swidth attributes are better, or.
6093 2. the best non-scalable font doesn't have the required
6094 point size, and the scalable fonts weight, slant, swidth
6097 int non_scalable_has_exact_height_p
;
6099 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
6100 non_scalable_has_exact_height_p
= 1;
6102 non_scalable_has_exact_height_p
= 0;
6104 for (i
= 0; i
< nfonts
; ++i
)
6105 if (font_scalable_p (fonts
+ i
))
6108 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
6109 || (!non_scalable_has_exact_height_p
6110 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
6115 if (font_scalable_p (best
))
6116 font_name
= build_scalable_font_name (f
, best
, pt
);
6118 font_name
= build_font_name (best
);
6120 /* Free font_name structures. */
6121 free_font_names (fonts
, nfonts
);
6127 /* Get a list of matching fonts on frame F, considering FAMILY
6128 and alternative font families from Vface_alternative_font_registry_alist.
6130 FAMILY is the font family whose alternatives are considered.
6132 REGISTRY, if a string, specifies a font registry and encoding to
6133 match. A value of nil means include fonts of any registry and
6136 Return in *FONTS a pointer to a vector of font_name structures for
6137 the fonts matched. Value is the number of fonts found. */
6140 try_alternative_families (f
, family
, registry
, fonts
)
6142 Lisp_Object family
, registry
;
6143 struct font_name
**fonts
;
6148 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6151 /* Try alternative font families. */
6152 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
6155 for (alter
= XCDR (alter
);
6156 CONSP (alter
) && nfonts
== 0;
6157 alter
= XCDR (alter
))
6159 if (STRINGP (XCAR (alter
)))
6160 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
6164 /* Try scalable fonts before giving up. */
6165 if (nfonts
== 0 && ! EQ (Vscalable_fonts_allowed
, Qt
))
6167 int count
= BINDING_STACK_SIZE ();
6168 specbind (Qscalable_fonts_allowed
, Qt
);
6169 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
6170 unbind_to (count
, Qnil
);
6177 /* Get a list of matching fonts on frame F.
6179 PATTERN, if a string, specifies a font name pattern to match while
6180 ignoring FAMILY and REGISTRY.
6182 FAMILY, if a list, specifies a list of font families to try.
6184 REGISTRY, if a list, specifies a list of font registries and
6187 Return in *FONTS a pointer to a vector of font_name structures for
6188 the fonts matched. Value is the number of fonts found. */
6191 try_font_list (f
, pattern
, family
, registry
, fonts
)
6193 Lisp_Object pattern
, family
, registry
;
6194 struct font_name
**fonts
;
6198 if (STRINGP (pattern
))
6199 nfonts
= font_list (f
, pattern
, Qnil
, Qnil
, fonts
);
6205 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6207 for (tail
= family
; ! nfonts
&& CONSP (tail
); tail
= XCDR (tail
))
6208 nfonts
= try_alternative_families (f
, XCAR (tail
), registry
, fonts
);
6210 /* Try font family of the default face or "fixed". */
6211 if (nfonts
== 0 && !NILP (family
))
6213 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6215 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
6217 family
= build_string ("fixed");
6218 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
6221 /* Try any family with the given registry. */
6222 if (nfonts
== 0 && !NILP (family
))
6223 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
6230 /* Return the fontset id of the base fontset name or alias name given
6231 by the fontset attribute of ATTRS. Value is -1 if the fontset
6232 attribute of ATTRS doesn't name a fontset. */
6235 face_fontset (attrs
)
6241 name
= attrs
[LFACE_FONTSET_INDEX
];
6242 if (!STRINGP (name
))
6244 return fs_query_fontset (name
, 0);
6248 /* Choose a name of font to use on frame F to display characters with
6249 Lisp face attributes specified by ATTRS. The font name is
6250 determined by the font-related attributes in ATTRS and FONT-SPEC
6253 When we are choosing a font for ASCII characters, FONT-SPEC is
6254 always nil. Otherwise FONT-SPEC is a list
6255 [ FAMILY WEIGHT SLANT SWIDTH ADSTYLE REGISTRY ]
6256 or a string specifying a font name pattern.
6258 Value is the font name which is allocated from the heap and must be
6259 freed by the caller. */
6262 choose_face_font (f
, attrs
, font_spec
)
6265 Lisp_Object font_spec
;
6267 Lisp_Object pattern
, family
, adstyle
, registry
;
6268 char *font_name
= NULL
;
6269 struct font_name
*fonts
;
6272 /* If we are choosing an ASCII font and a font name is explicitly
6273 specified in ATTRS, return it. */
6274 if (NILP (font_spec
) && STRINGP (attrs
[LFACE_FONT_INDEX
]))
6275 return xstrdup (XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6277 if (NILP (attrs
[LFACE_FAMILY_INDEX
]))
6280 family
= Fcons (attrs
[LFACE_FAMILY_INDEX
], Qnil
);
6282 /* Decide FAMILY, ADSTYLE, and REGISTRY from FONT_SPEC. But,
6283 ADSTYLE is not used in the font selector for the moment. */
6284 if (VECTORP (font_spec
))
6287 if (STRINGP (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
)))
6288 family
= Fcons (AREF (font_spec
, FONT_SPEC_FAMILY_INDEX
), family
);
6289 adstyle
= AREF (font_spec
, FONT_SPEC_ADSTYLE_INDEX
);
6290 registry
= Fcons (AREF (font_spec
, FONT_SPEC_REGISTRY_INDEX
), Qnil
);
6292 else if (STRINGP (font_spec
))
6294 pattern
= font_spec
;
6301 /* We are choosing an ASCII font. By default, use the registry
6302 name "iso8859-1". But, if the registry name of the ASCII
6303 font specified in the fontset of ATTRS is not "iso8859-1"
6304 (e.g "iso10646-1"), use also that name with higher
6306 int fontset
= face_fontset (attrs
);
6309 struct font_name font
;
6313 registry
= Fcons (build_string ("iso8859-1"), Qnil
);
6315 ascii
= fontset_ascii (fontset
);
6316 len
= STRING_BYTES (XSTRING (ascii
));
6318 || strcmp (XSTRING (ascii
)->data
+ len
- 9, "iso8859-1"))
6320 font
.name
= LSTRDUPA (ascii
);
6321 /* Check if the name is in XLFD. */
6322 if (split_font_name (f
, &font
, 0))
6324 font
.fields
[XLFD_ENCODING
][-1] = '-';
6325 registry
= Fcons (build_string (font
.fields
[XLFD_REGISTRY
]),
6331 /* Get a list of fonts matching that pattern and choose the
6332 best match for the specified face attributes from it. */
6333 nfonts
= try_font_list (f
, pattern
, family
, registry
, &fonts
);
6334 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, NILP (font_spec
));
6338 #endif /* HAVE_WINDOW_SYSTEM */
6342 /***********************************************************************
6344 ***********************************************************************/
6346 /* Realize basic faces on frame F. Value is zero if frame parameters
6347 of F don't contain enough information needed to realize the default
6351 realize_basic_faces (f
)
6355 int count
= BINDING_STACK_SIZE ();
6357 /* Block input here so that we won't be surprised by an X expose
6358 event, for instance, without having the faces set up. */
6360 specbind (Qscalable_fonts_allowed
, Qt
);
6362 if (realize_default_face (f
))
6364 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6365 realize_named_face (f
, Qmode_line_inactive
, MODE_LINE_INACTIVE_FACE_ID
);
6366 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6367 realize_named_face (f
, Qfringe
, FRINGE_FACE_ID
);
6368 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6369 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6370 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6371 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6372 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6373 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6375 /* Reflect changes in the `menu' face in menu bars. */
6376 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6378 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6379 #ifdef USE_X_TOOLKIT
6380 x_update_menu_appearance (f
);
6387 unbind_to (count
, Qnil
);
6393 /* Realize the default face on frame F. If the face is not fully
6394 specified, make it fully-specified. Attributes of the default face
6395 that are not explicitly specified are taken from frame parameters. */
6398 realize_default_face (f
)
6401 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6403 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6404 Lisp_Object frame_font
;
6407 /* If the `default' face is not yet known, create it. */
6408 lface
= lface_from_face_name (f
, Qdefault
, 0);
6412 XSETFRAME (frame
, f
);
6413 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6416 #ifdef HAVE_WINDOW_SYSTEM
6417 if (FRAME_WINDOW_P (f
))
6419 /* Set frame_font to the value of the `font' frame parameter. */
6420 frame_font
= Fassq (Qfont
, f
->param_alist
);
6421 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6422 frame_font
= XCDR (frame_font
);
6423 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6425 #endif /* HAVE_WINDOW_SYSTEM */
6427 if (!FRAME_WINDOW_P (f
))
6429 LFACE_FAMILY (lface
) = build_string ("default");
6430 LFACE_SWIDTH (lface
) = Qnormal
;
6431 LFACE_HEIGHT (lface
) = make_number (1);
6432 if (UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
6433 LFACE_WEIGHT (lface
) = Qnormal
;
6434 if (UNSPECIFIEDP (LFACE_SLANT (lface
)))
6435 LFACE_SLANT (lface
) = Qnormal
;
6436 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6439 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6440 LFACE_UNDERLINE (lface
) = Qnil
;
6442 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6443 LFACE_OVERLINE (lface
) = Qnil
;
6445 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6446 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6448 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6449 LFACE_BOX (lface
) = Qnil
;
6451 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6452 LFACE_INVERSE (lface
) = Qnil
;
6454 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6456 /* This function is called so early that colors are not yet
6457 set in the frame parameter list. */
6458 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6460 if (CONSP (color
) && STRINGP (XCDR (color
)))
6461 LFACE_FOREGROUND (lface
) = XCDR (color
);
6462 else if (FRAME_WINDOW_P (f
))
6464 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6465 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6470 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6472 /* This function is called so early that colors are not yet
6473 set in the frame parameter list. */
6474 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6475 if (CONSP (color
) && STRINGP (XCDR (color
)))
6476 LFACE_BACKGROUND (lface
) = XCDR (color
);
6477 else if (FRAME_WINDOW_P (f
))
6479 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6480 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6485 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6486 LFACE_STIPPLE (lface
) = Qnil
;
6488 /* Realize the face; it must be fully-specified now. */
6489 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6490 check_lface (lface
);
6491 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6492 face
= realize_face (c
, attrs
, DEFAULT_FACE_ID
);
6497 /* Realize basic faces other than the default face in face cache C.
6498 SYMBOL is the face name, ID is the face id the realized face must
6499 have. The default face must have been realized already. */
6502 realize_named_face (f
, symbol
, id
)
6507 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6508 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6509 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6510 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6511 struct face
*new_face
;
6513 /* The default face must exist and be fully specified. */
6514 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6515 check_lface_attrs (attrs
);
6516 xassert (lface_fully_specified_p (attrs
));
6518 /* If SYMBOL isn't know as a face, create it. */
6522 XSETFRAME (frame
, f
);
6523 lface
= Finternal_make_lisp_face (symbol
, frame
);
6526 /* Merge SYMBOL's face with the default face. */
6527 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6528 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6530 /* Realize the face. */
6531 new_face
= realize_face (c
, attrs
, id
);
6535 /* Realize the fully-specified face with attributes ATTRS in face
6536 cache CACHE for ASCII characters. If FORMER_FACE_ID is
6537 non-negative, it is an ID of face to remove before caching the new
6538 face. Value is a pointer to the newly created realized face. */
6540 static struct face
*
6541 realize_face (cache
, attrs
, former_face_id
)
6542 struct face_cache
*cache
;
6548 /* LFACE must be fully specified. */
6549 xassert (cache
!= NULL
);
6550 check_lface_attrs (attrs
);
6552 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6554 /* Remove the former face. */
6555 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6556 uncache_face (cache
, former_face
);
6557 free_realized_face (cache
->f
, former_face
);
6560 if (FRAME_WINDOW_P (cache
->f
))
6561 face
= realize_x_face (cache
, attrs
);
6562 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6563 face
= realize_tty_face (cache
, attrs
);
6567 /* Insert the new face. */
6568 cache_face (cache
, face
, lface_hash (attrs
));
6573 /* Realize the fully-specified face that has the same attributes as
6574 BASE_FACE except for the font on frame F. If FONT_ID is not
6575 negative, it is an ID number of an already opened font that should
6576 be used by the face. If FONT_ID is negative, the face has no font,
6577 i.e., characters are displayed by empty boxes. */
6579 static struct face
*
6580 realize_non_ascii_face (f
, font_id
, base_face
)
6583 struct face
*base_face
;
6585 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
6587 struct font_info
*font_info
;
6589 face
= (struct face
*) xmalloc (sizeof *face
);
6593 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6594 face
->colors_copied_bitwise_p
= 1;
6596 face
->font_info_id
= font_id
;
6599 font_info
= FONT_INFO_FROM_ID (f
, font_id
);
6600 face
->font
= font_info
->font
;
6601 face
->font_name
= font_info
->full_name
;
6606 face
->font_name
= NULL
;
6611 cache_face (cache
, face
, face
->hash
);
6617 /* Realize the fully-specified face with attributes ATTRS in face
6618 cache CACHE for ASCII characters. Do it for X frame CACHE->f. If
6619 the new face doesn't share font with the default face, a fontname
6620 is allocated from the heap and set in `font_name' of the new face,
6621 but it is not yet loaded here. Value is a pointer to the newly
6622 created realized face. */
6624 static struct face
*
6625 realize_x_face (cache
, attrs
)
6626 struct face_cache
*cache
;
6629 #ifdef HAVE_WINDOW_SYSTEM
6630 struct face
*face
, *default_face
;
6632 Lisp_Object stipple
, overline
, strike_through
, box
;
6634 xassert (FRAME_WINDOW_P (cache
->f
));
6636 /* Allocate a new realized face. */
6637 face
= make_realized_face (attrs
);
6638 face
->ascii_face
= face
;
6642 /* Determine the font to use. Most of the time, the font will be
6643 the same as the font of the default face, so try that first. */
6644 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6646 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6648 face
->font
= default_face
->font
;
6649 face
->font_info_id
= default_face
->font_info_id
;
6650 face
->font_name
= default_face
->font_name
;
6652 = make_fontset_for_ascii_face (f
, default_face
->fontset
, face
);
6656 /* If the face attribute ATTRS specifies a fontset, use it as
6657 the base of a new realized fontset. Otherwise, use the same
6658 base fontset as of the default face. The base determines
6659 registry and encoding of a font. It may also determine
6660 foundry and family. The other fields of font name pattern
6661 are constructed from ATTRS. */
6662 int fontset
= face_fontset (attrs
);
6664 /* If we are realizing the default face, ATTRS should specify a
6665 fontset. In other words, if FONTSET is -1, we are not
6666 realizing the default face, thus the default face should have
6667 already been realized. */
6669 fontset
= default_face
->fontset
;
6672 face
->font
= NULL
; /* to force realize_face to load font */
6675 /* Load the font if it is specified in ATTRS. This fixes
6676 changing frame font on the Mac. */
6677 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6679 struct font_info
*font_info
=
6680 FS_LOAD_FONT (f
, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
);
6682 face
->font
= font_info
->font
;
6686 load_face_font (f
, face
);
6687 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
, face
);
6690 /* Load colors, and set remaining attributes. */
6692 load_face_colors (f
, face
, attrs
);
6695 box
= attrs
[LFACE_BOX_INDEX
];
6698 /* A simple box of line width 1 drawn in color given by
6700 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6702 face
->box
= FACE_SIMPLE_BOX
;
6703 face
->box_line_width
= 1;
6705 else if (INTEGERP (box
))
6707 /* Simple box of specified line width in foreground color of the
6709 xassert (XINT (box
) != 0);
6710 face
->box
= FACE_SIMPLE_BOX
;
6711 face
->box_line_width
= XINT (box
);
6712 face
->box_color
= face
->foreground
;
6713 face
->box_color_defaulted_p
= 1;
6715 else if (CONSP (box
))
6717 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6718 being one of `raised' or `sunken'. */
6719 face
->box
= FACE_SIMPLE_BOX
;
6720 face
->box_color
= face
->foreground
;
6721 face
->box_color_defaulted_p
= 1;
6722 face
->box_line_width
= 1;
6726 Lisp_Object keyword
, value
;
6728 keyword
= XCAR (box
);
6736 if (EQ (keyword
, QCline_width
))
6738 if (INTEGERP (value
) && XINT (value
) != 0)
6739 face
->box_line_width
= XINT (value
);
6741 else if (EQ (keyword
, QCcolor
))
6743 if (STRINGP (value
))
6745 face
->box_color
= load_color (f
, face
, value
,
6747 face
->use_box_color_for_shadows_p
= 1;
6750 else if (EQ (keyword
, QCstyle
))
6752 if (EQ (value
, Qreleased_button
))
6753 face
->box
= FACE_RAISED_BOX
;
6754 else if (EQ (value
, Qpressed_button
))
6755 face
->box
= FACE_SUNKEN_BOX
;
6760 /* Text underline, overline, strike-through. */
6762 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6764 /* Use default color (same as foreground color). */
6765 face
->underline_p
= 1;
6766 face
->underline_defaulted_p
= 1;
6767 face
->underline_color
= 0;
6769 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6771 /* Use specified color. */
6772 face
->underline_p
= 1;
6773 face
->underline_defaulted_p
= 0;
6774 face
->underline_color
6775 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6776 LFACE_UNDERLINE_INDEX
);
6778 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6780 face
->underline_p
= 0;
6781 face
->underline_defaulted_p
= 0;
6782 face
->underline_color
= 0;
6785 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6786 if (STRINGP (overline
))
6788 face
->overline_color
6789 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6790 LFACE_OVERLINE_INDEX
);
6791 face
->overline_p
= 1;
6793 else if (EQ (overline
, Qt
))
6795 face
->overline_color
= face
->foreground
;
6796 face
->overline_color_defaulted_p
= 1;
6797 face
->overline_p
= 1;
6800 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6801 if (STRINGP (strike_through
))
6803 face
->strike_through_color
6804 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6805 LFACE_STRIKE_THROUGH_INDEX
);
6806 face
->strike_through_p
= 1;
6808 else if (EQ (strike_through
, Qt
))
6810 face
->strike_through_color
= face
->foreground
;
6811 face
->strike_through_color_defaulted_p
= 1;
6812 face
->strike_through_p
= 1;
6815 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6816 if (!NILP (stipple
))
6817 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6819 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6821 #endif /* HAVE_WINDOW_SYSTEM */
6825 /* Map a specified color of face FACE on frame F to a tty color index.
6826 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6827 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6828 default foreground/background colors. */
6831 map_tty_color (f
, face
, idx
, defaulted
)
6834 enum lface_attribute_index idx
;
6837 Lisp_Object frame
, color
, def
;
6838 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6839 unsigned long default_pixel
, default_other_pixel
, pixel
;
6841 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6845 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6846 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6850 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6851 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6854 XSETFRAME (frame
, f
);
6855 color
= face
->lface
[idx
];
6858 && XSTRING (color
)->size
6859 && CONSP (Vtty_defined_color_alist
)
6860 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6863 /* Associations in tty-defined-color-alist are of the form
6864 (NAME INDEX R G B). We need the INDEX part. */
6865 pixel
= XINT (XCAR (XCDR (def
)));
6868 if (pixel
== default_pixel
&& STRINGP (color
))
6870 pixel
= load_color (f
, face
, color
, idx
);
6872 #if defined (MSDOS) || defined (WINDOWSNT)
6873 /* If the foreground of the default face is the default color,
6874 use the foreground color defined by the frame. */
6876 if (FRAME_MSDOS_P (f
))
6879 if (pixel
== default_pixel
6880 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6883 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6885 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6886 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6889 else if (pixel
== default_other_pixel
)
6892 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6894 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6895 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6901 #endif /* MSDOS or WINDOWSNT */
6905 face
->foreground
= pixel
;
6907 face
->background
= pixel
;
6911 /* Realize the fully-specified face with attributes ATTRS in face
6912 cache CACHE for ASCII characters. Do it for TTY frame CACHE->f.
6913 Value is a pointer to the newly created realized face. */
6915 static struct face
*
6916 realize_tty_face (cache
, attrs
)
6917 struct face_cache
*cache
;
6922 int face_colors_defaulted
= 0;
6923 struct frame
*f
= cache
->f
;
6925 /* Frame must be a termcap frame. */
6926 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6928 /* Allocate a new realized face. */
6929 face
= make_realized_face (attrs
);
6930 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6932 /* Map face attributes to TTY appearances. We map slant to
6933 dimmed text because we want italic text to appear differently
6934 and because dimmed text is probably used infrequently. */
6935 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6936 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6938 if (weight
> XLFD_WEIGHT_MEDIUM
)
6939 face
->tty_bold_p
= 1;
6940 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6941 face
->tty_dim_p
= 1;
6942 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6943 face
->tty_underline_p
= 1;
6944 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6945 face
->tty_reverse_p
= 1;
6947 /* Map color names to color indices. */
6948 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6949 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6951 /* Swap colors if face is inverse-video. If the colors are taken
6952 from the frame colors, they are already inverted, since the
6953 frame-creation function calls x-handle-reverse-video. */
6954 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6956 unsigned long tem
= face
->foreground
;
6957 face
->foreground
= face
->background
;
6958 face
->background
= tem
;
6961 if (tty_suppress_bold_inverse_default_colors_p
6963 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6964 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6965 face
->tty_bold_p
= 0;
6971 DEFUN ("tty-suppress-bold-inverse-default-colors",
6972 Ftty_suppress_bold_inverse_default_colors
,
6973 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6974 doc
: /* Suppress/allow boldness of faces with inverse default colors.
6975 SUPPRESS non-nil means suppress it.
6976 This affects bold faces on TTYs whose foreground is the default background
6977 color of the display and whose background is the default foreground color.
6978 For such faces, the bold face attribute is ignored if this variable
6981 Lisp_Object suppress
;
6983 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6984 ++face_change_count
;
6990 /***********************************************************************
6992 ***********************************************************************/
6994 /* Return the ID of the face to use to display character CH with face
6995 property PROP on frame F in current_buffer. */
6998 compute_char_face (f
, ch
, prop
)
7005 if (NILP (current_buffer
->enable_multibyte_characters
))
7010 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7011 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7015 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7016 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7017 bcopy (face
->lface
, attrs
, sizeof attrs
);
7018 merge_face_vector_with_property (f
, attrs
, prop
);
7019 face_id
= lookup_face (f
, attrs
);
7020 if (! ASCII_CHAR_P (ch
))
7022 face
= FACE_FROM_ID (f
, face_id
);
7023 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
7030 /* Return the face ID associated with buffer position POS for
7031 displaying ASCII characters. Return in *ENDPTR the position at
7032 which a different face is needed, as far as text properties and
7033 overlays are concerned. W is a window displaying current_buffer.
7035 REGION_BEG, REGION_END delimit the region, so it can be
7038 LIMIT is a position not to scan beyond. That is to limit the time
7039 this function can take.
7041 If MOUSE is non-zero, use the character's mouse-face, not its face.
7043 The face returned is suitable for displaying ASCII characters. */
7046 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
7047 endptr
, limit
, mouse
)
7050 int region_beg
, region_end
;
7055 struct frame
*f
= XFRAME (w
->frame
);
7056 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7057 Lisp_Object prop
, position
;
7059 Lisp_Object
*overlay_vec
;
7062 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
7063 Lisp_Object limit1
, end
;
7064 struct face
*default_face
;
7066 /* W must display the current buffer. We could write this function
7067 to use the frame and buffer of W, but right now it doesn't. */
7068 /* xassert (XBUFFER (w->buffer) == current_buffer); */
7070 XSETFRAME (frame
, f
);
7071 XSETFASTINT (position
, pos
);
7074 if (pos
< region_beg
&& region_beg
< endpos
)
7075 endpos
= region_beg
;
7077 /* Get the `face' or `mouse_face' text property at POS, and
7078 determine the next position at which the property changes. */
7079 prop
= Fget_text_property (position
, propname
, w
->buffer
);
7080 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
7081 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
7083 endpos
= XINT (end
);
7085 /* Look at properties from overlays. */
7090 /* First try with room for 40 overlays. */
7092 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7093 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7094 &next_overlay
, NULL
, 0);
7096 /* If there are more than 40, make enough space for all, and try
7098 if (noverlays
> len
)
7101 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
7102 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
7103 &next_overlay
, NULL
, 0);
7106 if (next_overlay
< endpos
)
7107 endpos
= next_overlay
;
7112 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
7114 /* Optimize common cases where we can use the default face. */
7117 && !(pos
>= region_beg
&& pos
< region_end
))
7118 return DEFAULT_FACE_ID
;
7120 /* Begin with attributes from the default face. */
7121 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
7123 /* Merge in attributes specified via text properties. */
7125 merge_face_vector_with_property (f
, attrs
, prop
);
7127 /* Now merge the overlay data. */
7128 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
7129 for (i
= 0; i
< noverlays
; i
++)
7134 prop
= Foverlay_get (overlay_vec
[i
], propname
);
7136 merge_face_vector_with_property (f
, attrs
, prop
);
7138 oend
= OVERLAY_END (overlay_vec
[i
]);
7139 oendpos
= OVERLAY_POSITION (oend
);
7140 if (oendpos
< endpos
)
7144 /* If in the region, merge in the region face. */
7145 if (pos
>= region_beg
&& pos
< region_end
)
7147 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7148 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7150 if (region_end
< endpos
)
7151 endpos
= region_end
;
7156 /* Look up a realized face with the given face attributes,
7157 or realize a new one for ASCII characters. */
7158 return lookup_face (f
, attrs
);
7162 /* Compute the face at character position POS in Lisp string STRING on
7163 window W, for ASCII characters.
7165 If STRING is an overlay string, it comes from position BUFPOS in
7166 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
7167 not an overlay string. W must display the current buffer.
7168 REGION_BEG and REGION_END give the start and end positions of the
7169 region; both are -1 if no region is visible.
7171 BASE_FACE_ID is the id of a face to merge with. For strings coming
7172 from overlays or the `display' property it is the face at BUFPOS.
7174 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
7176 Set *ENDPTR to the next position where to check for faces in
7177 STRING; -1 if the face is constant from POS to the end of the
7180 Value is the id of the face to use. The face returned is suitable
7181 for displaying ASCII characters. */
7184 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
7185 region_end
, endptr
, base_face_id
, mouse_p
)
7189 int region_beg
, region_end
;
7191 enum face_id base_face_id
;
7194 Lisp_Object prop
, position
, end
, limit
;
7195 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
7196 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
7197 struct face
*base_face
;
7198 int multibyte_p
= STRING_MULTIBYTE (string
);
7199 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
7201 /* Get the value of the face property at the current position within
7202 STRING. Value is nil if there is no face property. */
7203 XSETFASTINT (position
, pos
);
7204 prop
= Fget_text_property (position
, prop_name
, string
);
7206 /* Get the next position at which to check for faces. Value of end
7207 is nil if face is constant all the way to the end of the string.
7208 Otherwise it is a string position where to check faces next.
7209 Limit is the maximum position up to which to check for property
7210 changes in Fnext_single_property_change. Strings are usually
7211 short, so set the limit to the end of the string. */
7212 XSETFASTINT (limit
, XSTRING (string
)->size
);
7213 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
7215 *endptr
= XFASTINT (end
);
7219 base_face
= FACE_FROM_ID (f
, base_face_id
);
7220 xassert (base_face
);
7222 /* Optimize the default case that there is no face property and we
7223 are not in the region. */
7225 && (base_face_id
!= DEFAULT_FACE_ID
7226 /* BUFPOS <= 0 means STRING is not an overlay string, so
7227 that the region doesn't have to be taken into account. */
7229 || bufpos
< region_beg
7230 || bufpos
>= region_end
)
7232 /* We can't realize faces for different charsets differently
7233 if we don't have fonts, so we can stop here if not working
7234 on a window-system frame. */
7235 || !FRAME_WINDOW_P (f
)
7236 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
7237 return base_face
->id
;
7239 /* Begin with attributes from the base face. */
7240 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
7242 /* Merge in attributes specified via text properties. */
7244 merge_face_vector_with_property (f
, attrs
, prop
);
7246 /* If in the region, merge in the region face. */
7248 && bufpos
>= region_beg
7249 && bufpos
< region_end
)
7251 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
7252 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
7255 /* Look up a realized face with the given face attributes,
7256 or realize a new one for ASCII characters. */
7257 return lookup_face (f
, attrs
);
7262 /***********************************************************************
7264 ***********************************************************************/
7268 /* Print the contents of the realized face FACE to stderr. */
7271 dump_realized_face (face
)
7274 fprintf (stderr
, "ID: %d\n", face
->id
);
7275 #ifdef HAVE_X_WINDOWS
7276 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
7278 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
7280 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
7281 fprintf (stderr
, "background: 0x%lx (%s)\n",
7283 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
7284 fprintf (stderr
, "font_name: %s (%s)\n",
7286 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
7287 #ifdef HAVE_X_WINDOWS
7288 fprintf (stderr
, "font = %p\n", face
->font
);
7290 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
7291 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
7292 fprintf (stderr
, "underline: %d (%s)\n",
7294 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
7295 fprintf (stderr
, "hash: %d\n", face
->hash
);
7299 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, doc
: /* */)
7307 fprintf (stderr
, "font selection order: ");
7308 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7309 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7310 fprintf (stderr
, "\n");
7312 fprintf (stderr
, "alternative fonts: ");
7313 debug_print (Vface_alternative_font_family_alist
);
7314 fprintf (stderr
, "\n");
7316 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7317 Fdump_face (make_number (i
));
7323 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7325 error ("Not a valid face");
7326 dump_realized_face (face
);
7333 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7334 0, 0, 0, doc
: /* */)
7337 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7338 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7339 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7343 #endif /* GLYPH_DEBUG != 0 */
7347 /***********************************************************************
7349 ***********************************************************************/
7354 Qface
= intern ("face");
7356 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7357 staticpro (&Qbitmap_spec_p
);
7358 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7359 staticpro (&Qframe_update_face_colors
);
7361 /* Lisp face attribute keywords. */
7362 QCfamily
= intern (":family");
7363 staticpro (&QCfamily
);
7364 QCheight
= intern (":height");
7365 staticpro (&QCheight
);
7366 QCweight
= intern (":weight");
7367 staticpro (&QCweight
);
7368 QCslant
= intern (":slant");
7369 staticpro (&QCslant
);
7370 QCunderline
= intern (":underline");
7371 staticpro (&QCunderline
);
7372 QCinverse_video
= intern (":inverse-video");
7373 staticpro (&QCinverse_video
);
7374 QCreverse_video
= intern (":reverse-video");
7375 staticpro (&QCreverse_video
);
7376 QCforeground
= intern (":foreground");
7377 staticpro (&QCforeground
);
7378 QCbackground
= intern (":background");
7379 staticpro (&QCbackground
);
7380 QCstipple
= intern (":stipple");;
7381 staticpro (&QCstipple
);
7382 QCwidth
= intern (":width");
7383 staticpro (&QCwidth
);
7384 QCfont
= intern (":font");
7385 staticpro (&QCfont
);
7386 QCfontset
= intern (":fontset");
7387 staticpro (&QCfontset
);
7388 QCbold
= intern (":bold");
7389 staticpro (&QCbold
);
7390 QCitalic
= intern (":italic");
7391 staticpro (&QCitalic
);
7392 QCoverline
= intern (":overline");
7393 staticpro (&QCoverline
);
7394 QCstrike_through
= intern (":strike-through");
7395 staticpro (&QCstrike_through
);
7396 QCbox
= intern (":box");
7398 QCinherit
= intern (":inherit");
7399 staticpro (&QCinherit
);
7401 /* Symbols used for Lisp face attribute values. */
7402 QCcolor
= intern (":color");
7403 staticpro (&QCcolor
);
7404 QCline_width
= intern (":line-width");
7405 staticpro (&QCline_width
);
7406 QCstyle
= intern (":style");
7407 staticpro (&QCstyle
);
7408 Qreleased_button
= intern ("released-button");
7409 staticpro (&Qreleased_button
);
7410 Qpressed_button
= intern ("pressed-button");
7411 staticpro (&Qpressed_button
);
7412 Qnormal
= intern ("normal");
7413 staticpro (&Qnormal
);
7414 Qultra_light
= intern ("ultra-light");
7415 staticpro (&Qultra_light
);
7416 Qextra_light
= intern ("extra-light");
7417 staticpro (&Qextra_light
);
7418 Qlight
= intern ("light");
7419 staticpro (&Qlight
);
7420 Qsemi_light
= intern ("semi-light");
7421 staticpro (&Qsemi_light
);
7422 Qsemi_bold
= intern ("semi-bold");
7423 staticpro (&Qsemi_bold
);
7424 Qbold
= intern ("bold");
7426 Qextra_bold
= intern ("extra-bold");
7427 staticpro (&Qextra_bold
);
7428 Qultra_bold
= intern ("ultra-bold");
7429 staticpro (&Qultra_bold
);
7430 Qoblique
= intern ("oblique");
7431 staticpro (&Qoblique
);
7432 Qitalic
= intern ("italic");
7433 staticpro (&Qitalic
);
7434 Qreverse_oblique
= intern ("reverse-oblique");
7435 staticpro (&Qreverse_oblique
);
7436 Qreverse_italic
= intern ("reverse-italic");
7437 staticpro (&Qreverse_italic
);
7438 Qultra_condensed
= intern ("ultra-condensed");
7439 staticpro (&Qultra_condensed
);
7440 Qextra_condensed
= intern ("extra-condensed");
7441 staticpro (&Qextra_condensed
);
7442 Qcondensed
= intern ("condensed");
7443 staticpro (&Qcondensed
);
7444 Qsemi_condensed
= intern ("semi-condensed");
7445 staticpro (&Qsemi_condensed
);
7446 Qsemi_expanded
= intern ("semi-expanded");
7447 staticpro (&Qsemi_expanded
);
7448 Qexpanded
= intern ("expanded");
7449 staticpro (&Qexpanded
);
7450 Qextra_expanded
= intern ("extra-expanded");
7451 staticpro (&Qextra_expanded
);
7452 Qultra_expanded
= intern ("ultra-expanded");
7453 staticpro (&Qultra_expanded
);
7454 Qbackground_color
= intern ("background-color");
7455 staticpro (&Qbackground_color
);
7456 Qforeground_color
= intern ("foreground-color");
7457 staticpro (&Qforeground_color
);
7458 Qunspecified
= intern ("unspecified");
7459 staticpro (&Qunspecified
);
7461 Qface_alias
= intern ("face-alias");
7462 staticpro (&Qface_alias
);
7463 Qdefault
= intern ("default");
7464 staticpro (&Qdefault
);
7465 Qtool_bar
= intern ("tool-bar");
7466 staticpro (&Qtool_bar
);
7467 Qregion
= intern ("region");
7468 staticpro (&Qregion
);
7469 Qfringe
= intern ("fringe");
7470 staticpro (&Qfringe
);
7471 Qheader_line
= intern ("header-line");
7472 staticpro (&Qheader_line
);
7473 Qscroll_bar
= intern ("scroll-bar");
7474 staticpro (&Qscroll_bar
);
7475 Qmenu
= intern ("menu");
7477 Qcursor
= intern ("cursor");
7478 staticpro (&Qcursor
);
7479 Qborder
= intern ("border");
7480 staticpro (&Qborder
);
7481 Qmouse
= intern ("mouse");
7482 staticpro (&Qmouse
);
7483 Qmode_line_inactive
= intern ("mode-line-inactive");
7484 staticpro (&Qmode_line_inactive
);
7485 Qtty_color_desc
= intern ("tty-color-desc");
7486 staticpro (&Qtty_color_desc
);
7487 Qtty_color_by_index
= intern ("tty-color-by-index");
7488 staticpro (&Qtty_color_by_index
);
7489 Qtty_color_alist
= intern ("tty-color-alist");
7490 staticpro (&Qtty_color_alist
);
7491 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7492 staticpro (&Qscalable_fonts_allowed
);
7494 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7495 staticpro (&Vparam_value_alist
);
7496 Vface_alternative_font_family_alist
= Qnil
;
7497 staticpro (&Vface_alternative_font_family_alist
);
7498 Vface_alternative_font_registry_alist
= Qnil
;
7499 staticpro (&Vface_alternative_font_registry_alist
);
7501 defsubr (&Sinternal_make_lisp_face
);
7502 defsubr (&Sinternal_lisp_face_p
);
7503 defsubr (&Sinternal_set_lisp_face_attribute
);
7504 #ifdef HAVE_WINDOW_SYSTEM
7505 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7507 defsubr (&Scolor_gray_p
);
7508 defsubr (&Scolor_supported_p
);
7509 defsubr (&Sface_attribute_relative_p
);
7510 defsubr (&Smerge_face_attribute
);
7511 defsubr (&Sinternal_get_lisp_face_attribute
);
7512 defsubr (&Sinternal_lisp_face_attribute_values
);
7513 defsubr (&Sinternal_lisp_face_equal_p
);
7514 defsubr (&Sinternal_lisp_face_empty_p
);
7515 defsubr (&Sinternal_copy_lisp_face
);
7516 defsubr (&Sinternal_merge_in_global_face
);
7517 defsubr (&Sface_font
);
7518 defsubr (&Sframe_face_alist
);
7519 defsubr (&Sinternal_set_font_selection_order
);
7520 defsubr (&Sinternal_set_alternative_font_family_alist
);
7521 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7522 defsubr (&Sface_attributes_as_vector
);
7524 defsubr (&Sdump_face
);
7525 defsubr (&Sshow_face_resources
);
7526 #endif /* GLYPH_DEBUG */
7527 defsubr (&Sclear_face_cache
);
7528 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7530 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7531 defsubr (&Sdump_colors
);
7534 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7535 doc
: /* *Limit for font matching.
7536 If an integer > 0, font matching functions won't load more than
7537 that number of fonts when searching for a matching font. */);
7538 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7540 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7541 doc
: /* List of global face definitions (for internal use only.) */);
7542 Vface_new_frame_defaults
= Qnil
;
7544 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7545 doc
: /* *Default stipple pattern used on monochrome displays.
7546 This stipple pattern is used on monochrome displays
7547 instead of shades of gray for a face background color.
7548 See `set-face-stipple' for possible values for this variable. */);
7549 Vface_default_stipple
= build_string ("gray3");
7551 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7552 doc
: /* An alist of defined terminal colors and their RGB values. */);
7553 Vtty_defined_color_alist
= Qnil
;
7555 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7556 doc
: /* Allowed scalable fonts.
7557 A value of nil means don't allow any scalable fonts.
7558 A value of t means allow any scalable font.
7559 Otherwise, value must be a list of regular expressions. A font may be
7560 scaled if its name matches a regular expression in the list.
7561 Note that if value is nil, a scalable font might still be used, if no
7562 other font of the appropriate family and registry is available. */);
7563 Vscalable_fonts_allowed
= Qnil
;
7565 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7566 doc
: /* List of ignored fonts.
7567 Each element is a regular expression that matches names of fonts to
7569 Vface_ignored_fonts
= Qnil
;
7572 DEFVAR_LISP ("face-font-rescale-alist", &Vface_font_rescale_alist
,
7573 doc
: /* Alist of fonts vs the rescaling factors.
7574 Each element is a cons (FONT-NAME-PATTERN . RESCALE-RATIO), where
7575 FONT-NAME-PATTERN is a regular expression matching a font name, and
7576 RESCALE-RATIO is a floating point number to specify how much larger
7577 \(or smaller) font we should use. For instance, if a face requests
7578 a font of 10 point, we actually use a font of 10 * RESCALE-RATIO point. */);
7579 Vface_font_rescale_alist
= Qnil
;
7581 #ifdef HAVE_WINDOW_SYSTEM
7582 defsubr (&Sbitmap_spec_p
);
7583 defsubr (&Sx_list_fonts
);
7584 defsubr (&Sinternal_face_x_get_resource
);
7585 defsubr (&Sx_family_fonts
);
7586 defsubr (&Sx_font_family_list
);
7587 #endif /* HAVE_WINDOW_SYSTEM */