1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000, 2001
3 Free Software Foundation.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
22 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
26 When using Emacs with X, the display style of characters can be
27 changed by defining `faces'. Each face can specify the following
32 2. Relative proportionate width, aka character set width or set
33 width (swidth), e.g. `semi-compressed'.
35 3. Font height in 1/10pt.
37 4. Font weight, e.g. `bold'.
39 5. Font slant, e.g. `italic'.
45 8. Whether or not characters should be underlined, and in what color.
47 9. Whether or not characters should be displayed in inverse video.
49 10. A background stipple, a bitmap.
51 11. Whether or not characters should be overlined, and in what color.
53 12. Whether or not characters should be strike-through, and in what
56 13. Whether or not a box should be drawn around characters, the box
57 type, and, for simple boxes, in what color.
59 14. Font or fontset pattern, or nil. This is a special attribute.
60 When this attribute is specified, the face uses a font opened by
61 that pattern as is. In addition, all the other font-related
62 attributes (1st thru 5th) are generated from the opened font name.
63 On the other hand, if one of the other font-related attributes are
64 specified, this attribute is set to nil. In that case, the face
65 doesn't inherit this attribute from the `default' face, and uses a
66 font determined by the other attributes (those may be inherited
67 from the `default' face).
69 15. A face name or list of face names from which to inherit attributes.
71 16. A specified average font width, which is invisible from Lisp,
72 and is used to ensure that a font specified on the command line,
73 for example, can be matched exactly.
75 Faces are frame-local by nature because Emacs allows to define the
76 same named face (face names are symbols) differently for different
77 frames. Each frame has an alist of face definitions for all named
78 faces. The value of a named face in such an alist is a Lisp vector
79 with the symbol `face' in slot 0, and a slot for each of the face
80 attributes mentioned above.
82 There is also a global face alist `Vface_new_frame_defaults'. Face
83 definitions from this list are used to initialize faces of newly
86 A face doesn't have to specify all attributes. Those not specified
87 have a value of `unspecified'. Faces specifying all attributes but
88 the 14th are called `fully-specified'.
93 The display style of a given character in the text is determined by
94 combining several faces. This process is called `face merging'.
95 Any aspect of the display style that isn't specified by overlays or
96 text properties is taken from the `default' face. Since it is made
97 sure that the default face is always fully-specified, face merging
98 always results in a fully-specified face.
103 After all face attributes for a character have been determined by
104 merging faces of that character, that face is `realized'. The
105 realization process maps face attributes to what is physically
106 available on the system where Emacs runs. The result is a
107 `realized face' in form of a struct face which is stored in the
108 face cache of the frame on which it was realized.
110 Face realization is done in the context of the character to display
111 because different fonts may be used for different characters. In
112 other words, for characters that have different font
113 specifications, different realized faces are needed to display
116 Font specification is done by fontsets. See the comment in
117 fontset.c for the details. In the current implementation, all ASCII
118 characters share the same font in a fontset.
120 Faces are at first realized for ASCII characters, and, at that
121 time, assigned a specific realized fontset. Hereafter, we call
122 such a face as `ASCII face'. When a face for a multibyte character
123 is realized, it inherits (thus shares) a fontset of an ASCII face
124 that has the same attributes other than font-related ones.
126 Thus, all realized face have a realized fontset.
131 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
132 font as ASCII characters. That is because it is expected that
133 unibyte text users specify a font that is suitable both for ASCII
134 and raw 8-bit characters.
139 Font selection tries to find the best available matching font for a
140 given (character, face) combination.
142 If the face specifies a fontset name, that fontset determines a
143 pattern for fonts of the given character. If the face specifies a
144 font name or the other font-related attributes, a fontset is
145 realized from the default fontset. In that case, that
146 specification determines a pattern for ASCII characters and the
147 default fontset determines a pattern for multibyte characters.
149 Available fonts on the system on which Emacs runs are then matched
150 against the font pattern. The result of font selection is the best
151 match for the given face attributes in this font list.
153 Font selection can be influenced by the user.
155 1. The user can specify the relative importance he gives the face
156 attributes width, height, weight, and slant by setting
157 face-font-selection-order (faces.el) to a list of face attribute
158 names. The default is '(:width :height :weight :slant), and means
159 that font selection first tries to find a good match for the font
160 width specified by a face, then---within fonts with that
161 width---tries to find a best match for the specified font height,
164 2. Setting face-font-family-alternatives allows the user to
165 specify alternative font families to try if a family specified by a
168 3. Setting face-font-registry-alternatives allows the user to
169 specify all alternative font registries to try for a face
170 specifying a registry.
172 4. Setting face-ignored-fonts allows the user to ignore specific
176 Character composition.
178 Usually, the realization process is already finished when Emacs
179 actually reflects the desired glyph matrix on the screen. However,
180 on displaying a composition (sequence of characters to be composed
181 on the screen), a suitable font for the components of the
182 composition is selected and realized while drawing them on the
183 screen, i.e. the realization process is delayed but in principle
187 Initialization of basic faces.
189 The faces `default', `modeline' are considered `basic faces'.
190 When redisplay happens the first time for a newly created frame,
191 basic faces are realized for CHARSET_ASCII. Frame parameters are
192 used to fill in unspecified attributes of the default face. */
195 #include <sys/types.h>
196 #include <sys/stat.h>
199 #include "keyboard.h"
202 #ifdef HAVE_WINDOW_SYSTEM
204 #endif /* HAVE_WINDOW_SYSTEM */
206 #ifdef HAVE_X_WINDOWS
210 #include <Xm/XmStrDefs.h>
211 #endif /* USE_MOTIF */
212 #endif /* HAVE_X_WINDOWS */
221 /* Redefine X specifics to W32 equivalents to avoid cluttering the
222 code with #ifdef blocks. */
223 #undef FRAME_X_DISPLAY_INFO
224 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
225 #define x_display_info w32_display_info
226 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
227 #define check_x check_w32
228 #define x_list_fonts w32_list_fonts
229 #define GCGraphicsExposures 0
230 /* For historic reasons, FONT_WIDTH refers to average width on W32,
231 not maximum as on X. Redefine here. */
233 #define FONT_WIDTH FONT_MAX_WIDTH
234 #endif /* WINDOWSNT */
238 #define x_display_info mac_display_info
239 #define check_x check_mac
241 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
244 x_create_gc (f
, mask
, xgcv
)
250 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
259 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
264 #include "dispextern.h"
265 #include "blockinput.h"
267 #include "intervals.h"
269 #ifdef HAVE_X_WINDOWS
271 /* Compensate for a bug in Xos.h on some systems, on which it requires
272 time.h. On some such systems, Xos.h tries to redefine struct
273 timeval and struct timezone if USG is #defined while it is
276 #ifdef XOS_NEEDS_TIME_H
282 #else /* not XOS_NEEDS_TIME_H */
284 #endif /* not XOS_NEEDS_TIME_H */
286 #endif /* HAVE_X_WINDOWS */
292 #define max(A, B) ((A) > (B) ? (A) : (B))
293 #define min(A, B) ((A) < (B) ? (A) : (B))
294 #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
;
347 /* Symbols used for attribute values. */
349 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
350 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
351 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
352 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
353 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
354 Lisp_Object Qultra_expanded
;
355 Lisp_Object Qreleased_button
, Qpressed_button
;
356 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
357 Lisp_Object Qunspecified
;
359 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
361 /* The name of the function to call when the background of the frame
362 has changed, frame_update_face_colors. */
364 Lisp_Object Qframe_update_face_colors
;
366 /* Names of basic faces. */
368 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
369 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
370 extern Lisp_Object Qmode_line
;
372 /* The symbol `face-alias'. A symbols having that property is an
373 alias for another face. Value of the property is the name of
376 Lisp_Object Qface_alias
;
378 /* Names of frame parameters related to faces. */
380 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
381 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
383 /* Default stipple pattern used on monochrome displays. This stipple
384 pattern is used on monochrome displays instead of shades of gray
385 for a face background color. See `set-face-stipple' for possible
386 values for this variable. */
388 Lisp_Object Vface_default_stipple
;
390 /* Alist of alternative font families. Each element is of the form
391 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
392 try FAMILY1, then FAMILY2, ... */
394 Lisp_Object Vface_alternative_font_family_alist
;
396 /* Alist of alternative font registries. Each element is of the form
397 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
398 loaded, try REGISTRY1, then REGISTRY2, ... */
400 Lisp_Object Vface_alternative_font_registry_alist
;
402 /* Allowed scalable fonts. A value of nil means don't allow any
403 scalable fonts. A value of t means allow the use of any scalable
404 font. Otherwise, value must be a list of regular expressions. A
405 font may be scaled if its name matches a regular expression in the
408 Lisp_Object Vscalable_fonts_allowed
, Qscalable_fonts_allowed
;
410 /* List of regular expressions that matches names of fonts to ignore. */
412 Lisp_Object Vface_ignored_fonts
;
414 /* Maximum number of fonts to consider in font_list. If not an
415 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
417 Lisp_Object Vfont_list_limit
;
418 #define DEFAULT_FONT_LIST_LIMIT 100
420 /* The symbols `foreground-color' and `background-color' which can be
421 used as part of a `face' property. This is for compatibility with
424 Lisp_Object Qforeground_color
, Qbackground_color
;
426 /* The symbols `face' and `mouse-face' used as text properties. */
429 extern Lisp_Object Qmouse_face
;
431 /* Error symbol for wrong_type_argument in load_pixmap. */
433 Lisp_Object Qbitmap_spec_p
;
435 /* Alist of global face definitions. Each element is of the form
436 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
437 is a Lisp vector of face attributes. These faces are used
438 to initialize faces for new frames. */
440 Lisp_Object Vface_new_frame_defaults
;
442 /* The next ID to assign to Lisp faces. */
444 static int next_lface_id
;
446 /* A vector mapping Lisp face Id's to face names. */
448 static Lisp_Object
*lface_id_to_name
;
449 static int lface_id_to_name_size
;
451 /* TTY color-related functions (defined in tty-colors.el). */
453 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
455 /* The name of the function used to compute colors on TTYs. */
457 Lisp_Object Qtty_color_alist
;
459 /* An alist of defined terminal colors and their RGB values. */
461 Lisp_Object Vtty_defined_color_alist
;
463 /* Counter for calls to clear_face_cache. If this counter reaches
464 CLEAR_FONT_TABLE_COUNT, and a frame has more than
465 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
467 static int clear_font_table_count
;
468 #define CLEAR_FONT_TABLE_COUNT 100
469 #define CLEAR_FONT_TABLE_NFONTS 10
471 /* Non-zero means face attributes have been changed since the last
472 redisplay. Used in redisplay_internal. */
474 int face_change_count
;
476 /* Non-zero means don't display bold text if a face's foreground
477 and background colors are the inverse of the default colors of the
478 display. This is a kluge to suppress `bold black' foreground text
479 which is hard to read on an LCD monitor. */
481 int tty_suppress_bold_inverse_default_colors_p
;
483 /* A list of the form `((x . y))' used to avoid consing in
484 Finternal_set_lisp_face_attribute. */
486 static Lisp_Object Vparam_value_alist
;
488 /* The total number of colors currently allocated. */
491 static int ncolors_allocated
;
492 static int npixmaps_allocated
;
496 /* Non-zero means the definition of the `menu' face for new frames has
499 int menu_face_changed_default
;
502 /* Function prototypes. */
507 static void map_tty_color
P_ ((struct frame
*, struct face
*,
508 enum lface_attribute_index
, int *));
509 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
510 static int may_use_scalable_font_p
P_ ((char *));
511 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
512 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
514 static int x_face_list_fonts
P_ ((struct frame
*, char *,
515 struct font_name
*, int, int));
516 static int font_scalable_p
P_ ((struct font_name
*));
517 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
518 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
519 static unsigned char *xstrlwr
P_ ((unsigned char *));
520 static void signal_error
P_ ((char *, Lisp_Object
));
521 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
522 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
523 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
524 static void free_face_colors
P_ ((struct frame
*, struct face
*));
525 static int face_color_gray_p
P_ ((struct frame
*, char *));
526 static char *build_font_name
P_ ((struct font_name
*));
527 static void free_font_names
P_ ((struct font_name
*, int));
528 static int sorted_font_list
P_ ((struct frame
*, char *,
529 int (*cmpfn
) P_ ((const void *, const void *)),
530 struct font_name
**));
531 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
532 Lisp_Object
, struct font_name
**));
533 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
534 Lisp_Object
, struct font_name
**));
535 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*,
536 Lisp_Object
, Lisp_Object
, struct font_name
**));
537 static int try_alternative_families
P_ ((struct frame
*f
, Lisp_Object
,
538 Lisp_Object
, struct font_name
**));
539 static int cmp_font_names
P_ ((const void *, const void *));
540 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
541 struct face
*, int));
542 static struct face
*realize_x_face
P_ ((struct face_cache
*,
543 Lisp_Object
*, int, struct face
*));
544 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
545 Lisp_Object
*, int));
546 static int realize_basic_faces
P_ ((struct frame
*));
547 static int realize_default_face
P_ ((struct frame
*));
548 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
549 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
550 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
551 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
552 static unsigned lface_hash
P_ ((Lisp_Object
*));
553 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
554 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
555 static void free_realized_face
P_ ((struct frame
*, struct face
*));
556 static void clear_face_gcs
P_ ((struct face_cache
*));
557 static void free_face_cache
P_ ((struct face_cache
*));
558 static int face_numeric_weight
P_ ((Lisp_Object
));
559 static int face_numeric_slant
P_ ((Lisp_Object
));
560 static int face_numeric_swidth
P_ ((Lisp_Object
));
561 static int face_fontset
P_ ((Lisp_Object
*));
562 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
563 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
564 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
565 Lisp_Object
*, Lisp_Object
));
566 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
568 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
569 Lisp_Object
, int, int));
570 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
571 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
572 static void free_realized_faces
P_ ((struct face_cache
*));
573 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
574 struct font_name
*, int, int));
575 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
576 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
577 static int xlfd_numeric_slant
P_ ((struct font_name
*));
578 static int xlfd_numeric_weight
P_ ((struct font_name
*));
579 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
580 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
581 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
582 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
583 static int xlfd_fixed_p
P_ ((struct font_name
*));
584 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
586 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
587 struct font_name
*, int,
589 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
590 struct font_name
*, int));
592 #ifdef HAVE_WINDOW_SYSTEM
594 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
595 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
596 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
597 int (*cmpfn
) P_ ((const void *, const void *))));
598 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
599 static void x_free_gc
P_ ((struct frame
*, GC
));
600 static void clear_font_table
P_ ((struct x_display_info
*));
603 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
604 #endif /* WINDOWSNT */
607 static void x_update_menu_appearance
P_ ((struct frame
*));
608 #endif /* USE_X_TOOLKIT */
610 #endif /* HAVE_WINDOW_SYSTEM */
613 /***********************************************************************
615 ***********************************************************************/
617 #ifdef HAVE_X_WINDOWS
619 #ifdef DEBUG_X_COLORS
621 /* The following is a poor mans infrastructure for debugging X color
622 allocation problems on displays with PseudoColor-8. Some X servers
623 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
624 color reference counts completely so that they don't signal an
625 error when a color is freed whose reference count is already 0.
626 Other X servers do. To help me debug this, the following code
627 implements a simple reference counting schema of its own, for a
628 single display/screen. --gerd. */
630 /* Reference counts for pixel colors. */
632 int color_count
[256];
634 /* Register color PIXEL as allocated. */
637 register_color (pixel
)
640 xassert (pixel
< 256);
641 ++color_count
[pixel
];
645 /* Register color PIXEL as deallocated. */
648 unregister_color (pixel
)
651 xassert (pixel
< 256);
652 if (color_count
[pixel
] > 0)
653 --color_count
[pixel
];
659 /* Register N colors from PIXELS as deallocated. */
662 unregister_colors (pixels
, n
)
663 unsigned long *pixels
;
667 for (i
= 0; i
< n
; ++i
)
668 unregister_color (pixels
[i
]);
672 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
673 "Dump currently allocated colors and their reference counts to stderr.")
678 fputc ('\n', stderr
);
680 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
683 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
686 fputc ('\n', stderr
);
688 fputc ('\t', stderr
);
692 fputc ('\n', stderr
);
696 #endif /* DEBUG_X_COLORS */
699 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
700 color values. Interrupt input must be blocked when this function
704 x_free_colors (f
, pixels
, npixels
)
706 unsigned long *pixels
;
709 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
711 /* If display has an immutable color map, freeing colors is not
712 necessary and some servers don't allow it. So don't do it. */
713 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
715 #ifdef DEBUG_X_COLORS
716 unregister_colors (pixels
, npixels
);
718 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
724 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
725 color values. Interrupt input must be blocked when this function
729 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
733 unsigned long *pixels
;
736 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
737 int class = dpyinfo
->visual
->class;
739 /* If display has an immutable color map, freeing colors is not
740 necessary and some servers don't allow it. So don't do it. */
741 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
743 #ifdef DEBUG_X_COLORS
744 unregister_colors (pixels
, npixels
);
746 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
751 /* Create and return a GC for use on frame F. GC values and mask
752 are given by XGCV and MASK. */
755 x_create_gc (f
, mask
, xgcv
)
762 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
769 /* Free GC which was used on frame F. */
777 xassert (--ngcs
>= 0);
778 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
782 #endif /* HAVE_X_WINDOWS */
785 /* W32 emulation of GCs */
788 x_create_gc (f
, mask
, xgcv
)
795 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
802 /* Free GC which was used on frame F. */
810 xassert (--ngcs
>= 0);
815 #endif /* WINDOWSNT */
817 /* Like stricmp. Used to compare parts of font names which are in
822 unsigned char *s1
, *s2
;
826 unsigned char c1
= tolower (*s1
);
827 unsigned char c2
= tolower (*s2
);
829 return c1
< c2
? -1 : 1;
834 return *s2
== 0 ? 0 : -1;
839 /* Like strlwr, which might not always be available. */
841 static unsigned char *
845 unsigned char *p
= s
;
854 /* Signal `error' with message S, and additional argument ARG. */
857 signal_error (s
, arg
)
861 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
865 /* If FRAME is nil, return a pointer to the selected frame.
866 Otherwise, check that FRAME is a live frame, and return a pointer
867 to it. NPARAM is the parameter number of FRAME, for
868 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
869 Lisp function definitions. */
871 static INLINE
struct frame
*
872 frame_or_selected_frame (frame
, nparam
)
877 frame
= selected_frame
;
879 CHECK_LIVE_FRAME (frame
, nparam
);
880 return XFRAME (frame
);
884 /***********************************************************************
886 ***********************************************************************/
888 /* Initialize face cache and basic faces for frame F. */
894 /* Make a face cache, if F doesn't have one. */
895 if (FRAME_FACE_CACHE (f
) == NULL
)
896 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
898 #ifdef HAVE_WINDOW_SYSTEM
899 /* Make the image cache. */
900 if (FRAME_WINDOW_P (f
))
902 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
903 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
904 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
906 #endif /* HAVE_WINDOW_SYSTEM */
908 /* Realize basic faces. Must have enough information in frame
909 parameters to realize basic faces at this point. */
910 #ifdef HAVE_X_WINDOWS
911 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
914 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
916 if (!realize_basic_faces (f
))
921 /* Free face cache of frame F. Called from Fdelete_frame. */
927 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
931 free_face_cache (face_cache
);
932 FRAME_FACE_CACHE (f
) = NULL
;
935 #ifdef HAVE_WINDOW_SYSTEM
936 if (FRAME_WINDOW_P (f
))
938 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
941 --image_cache
->refcount
;
942 if (image_cache
->refcount
== 0)
943 free_image_cache (f
);
946 #endif /* HAVE_WINDOW_SYSTEM */
950 /* Clear face caches, and recompute basic faces for frame F. Call
951 this after changing frame parameters on which those faces depend,
952 or when realized faces have been freed due to changing attributes
956 recompute_basic_faces (f
)
959 if (FRAME_FACE_CACHE (f
))
961 clear_face_cache (0);
962 if (!realize_basic_faces (f
))
968 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
969 try to free unused fonts, too. */
972 clear_face_cache (clear_fonts_p
)
975 #ifdef HAVE_WINDOW_SYSTEM
976 Lisp_Object tail
, frame
;
980 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
982 struct x_display_info
*dpyinfo
;
984 /* Fonts are common for frames on one display, i.e. on
986 for (dpyinfo
= x_display_list
; dpyinfo
; dpyinfo
= dpyinfo
->next
)
987 if (dpyinfo
->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
988 clear_font_table (dpyinfo
);
990 /* From time to time see if we can unload some fonts. This also
991 frees all realized faces on all frames. Fonts needed by
992 faces will be loaded again when faces are realized again. */
993 clear_font_table_count
= 0;
995 FOR_EACH_FRAME (tail
, frame
)
997 struct frame
*f
= XFRAME (frame
);
998 if (FRAME_WINDOW_P (f
)
999 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
1000 free_all_realized_faces (frame
);
1005 /* Clear GCs of realized faces. */
1006 FOR_EACH_FRAME (tail
, frame
)
1009 if (FRAME_WINDOW_P (f
))
1011 clear_face_gcs (FRAME_FACE_CACHE (f
));
1012 clear_image_cache (f
, 0);
1016 #endif /* HAVE_WINDOW_SYSTEM */
1020 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
1021 "Clear face caches on all frames.\n\
1022 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
1024 Lisp_Object thoroughly
;
1026 clear_face_cache (!NILP (thoroughly
));
1027 ++face_change_count
;
1028 ++windows_or_buffers_changed
;
1034 #ifdef HAVE_WINDOW_SYSTEM
1037 /* Remove fonts from the font table of DPYINFO except for the default
1038 ASCII fonts of frames on that display. Called from clear_face_cache
1039 from time to time. */
1042 clear_font_table (dpyinfo
)
1043 struct x_display_info
*dpyinfo
;
1047 /* Free those fonts that are not used by frames on DPYINFO. */
1048 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1050 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1051 Lisp_Object tail
, frame
;
1053 /* Check if slot is already free. */
1054 if (font_info
->name
== NULL
)
1057 /* Don't free a default font of some frame on this display. */
1058 FOR_EACH_FRAME (tail
, frame
)
1060 struct frame
*f
= XFRAME (frame
);
1061 if (FRAME_WINDOW_P (f
)
1062 && FRAME_X_DISPLAY_INFO (f
) == dpyinfo
1063 && font_info
->font
== FRAME_FONT (f
))
1071 if (font_info
->full_name
!= font_info
->name
)
1072 xfree (font_info
->full_name
);
1073 xfree (font_info
->name
);
1075 /* Free the font. */
1077 #ifdef HAVE_X_WINDOWS
1078 XFreeFont (dpyinfo
->display
, font_info
->font
);
1081 w32_unload_font (dpyinfo
, font_info
->font
);
1085 /* Mark font table slot free. */
1086 font_info
->font
= NULL
;
1087 font_info
->name
= font_info
->full_name
= NULL
;
1091 #endif /* HAVE_WINDOW_SYSTEM */
1095 /***********************************************************************
1097 ***********************************************************************/
1099 #ifdef HAVE_WINDOW_SYSTEM
1101 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1102 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1103 A bitmap specification is either a string, a file name, or a list\n\
1104 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1105 HEIGHT is its height, and DATA is a string containing the bits of\n\
1106 the pixmap. Bits are stored row by row, each row occupies\n\
1107 (WIDTH + 7)/8 bytes.")
1113 if (STRINGP (object
))
1114 /* If OBJECT is a string, it's a file name. */
1116 else if (CONSP (object
))
1118 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1119 HEIGHT must be integers > 0, and DATA must be string large
1120 enough to hold a bitmap of the specified size. */
1121 Lisp_Object width
, height
, data
;
1123 height
= width
= data
= Qnil
;
1127 width
= XCAR (object
);
1128 object
= XCDR (object
);
1131 height
= XCAR (object
);
1132 object
= XCDR (object
);
1134 data
= XCAR (object
);
1138 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1140 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1142 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1147 return pixmap_p
? Qt
: Qnil
;
1151 /* Load a bitmap according to NAME (which is either a file name or a
1152 pixmap spec) for use on frame F. Value is the bitmap_id (see
1153 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1154 bitmap cannot be loaded, display a message saying so, and return
1155 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1156 if these pointers are not null. */
1159 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1162 unsigned int *w_ptr
, *h_ptr
;
1170 tem
= Fbitmap_spec_p (name
);
1172 wrong_type_argument (Qbitmap_spec_p
, name
);
1177 /* Decode a bitmap spec into a bitmap. */
1182 w
= XINT (Fcar (name
));
1183 h
= XINT (Fcar (Fcdr (name
)));
1184 bits
= Fcar (Fcdr (Fcdr (name
)));
1186 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1191 /* It must be a string -- a file name. */
1192 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1198 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1209 ++npixmaps_allocated
;
1212 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1215 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1221 #endif /* HAVE_WINDOW_SYSTEM */
1225 /***********************************************************************
1227 ***********************************************************************/
1229 #ifdef HAVE_WINDOW_SYSTEM
1231 /* Update the line_height of frame F. Return non-zero if line height
1235 frame_update_line_height (f
)
1238 int line_height
, changed_p
;
1240 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1241 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1242 FRAME_LINE_HEIGHT (f
) = line_height
;
1246 #endif /* HAVE_WINDOW_SYSTEM */
1249 /***********************************************************************
1251 ***********************************************************************/
1253 #ifdef HAVE_WINDOW_SYSTEM
1255 /* Load font of face FACE which is used on frame F to display
1256 character C. The name of the font to load is determined by lface
1257 and fontset of FACE. */
1260 load_face_font (f
, face
, c
)
1265 struct font_info
*font_info
= NULL
;
1268 face
->font_info_id
= -1;
1271 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1276 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1281 face
->font_info_id
= font_info
->font_idx
;
1282 face
->font
= font_info
->font
;
1283 face
->font_name
= font_info
->full_name
;
1286 x_free_gc (f
, face
->gc
);
1291 add_to_log ("Unable to load font %s",
1292 build_string (font_name
), Qnil
);
1296 #endif /* HAVE_WINDOW_SYSTEM */
1300 /***********************************************************************
1302 ***********************************************************************/
1304 /* A version of defined_color for non-X frames. */
1307 tty_defined_color (f
, color_name
, color_def
, alloc
)
1313 Lisp_Object color_desc
;
1314 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1315 unsigned long red
= 0, green
= 0, blue
= 0;
1318 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1322 XSETFRAME (frame
, f
);
1324 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1325 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1327 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1328 if (CONSP (XCDR (XCDR (color_desc
))))
1330 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1331 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1332 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1336 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1337 /* We were called early during startup, and the colors are not
1338 yet set up in tty-defined-color-alist. Don't return a failure
1339 indication, since this produces the annoying "Unable to
1340 load color" messages in the *Messages* buffer. */
1343 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1345 if (strcmp (color_name
, "unspecified-fg") == 0)
1346 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1347 else if (strcmp (color_name
, "unspecified-bg") == 0)
1348 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1351 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1354 color_def
->pixel
= color_idx
;
1355 color_def
->red
= red
;
1356 color_def
->green
= green
;
1357 color_def
->blue
= blue
;
1363 /* Decide if color named COLOR_NAME is valid for the display
1364 associated with the frame F; if so, return the rgb values in
1365 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1367 This does the right thing for any type of frame. */
1370 defined_color (f
, color_name
, color_def
, alloc
)
1376 if (!FRAME_WINDOW_P (f
))
1377 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1378 #ifdef HAVE_X_WINDOWS
1379 else if (FRAME_X_P (f
))
1380 return x_defined_color (f
, color_name
, color_def
, alloc
);
1383 else if (FRAME_W32_P (f
))
1384 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1387 else if (FRAME_MAC_P (f
))
1388 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1395 /* Given the index IDX of a tty color on frame F, return its name, a
1399 tty_color_name (f
, idx
)
1403 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1406 Lisp_Object coldesc
;
1408 XSETFRAME (frame
, f
);
1409 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1411 if (!NILP (coldesc
))
1412 return XCAR (coldesc
);
1415 /* We can have an MSDOG frame under -nw for a short window of
1416 opportunity before internal_terminal_init is called. DTRT. */
1417 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1418 return msdos_stdcolor_name (idx
);
1421 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1422 return build_string (unspecified_fg
);
1423 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1424 return build_string (unspecified_bg
);
1427 return vga_stdcolor_name (idx
);
1430 return Qunspecified
;
1434 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1435 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1438 face_color_gray_p (f
, color_name
)
1445 if (defined_color (f
, color_name
, &color
, 0))
1446 gray_p
= ((abs (color
.red
- color
.green
)
1447 < max (color
.red
, color
.green
) / 20)
1448 && (abs (color
.green
- color
.blue
)
1449 < max (color
.green
, color
.blue
) / 20)
1450 && (abs (color
.blue
- color
.red
)
1451 < max (color
.blue
, color
.red
) / 20));
1459 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1460 BACKGROUND_P non-zero means the color will be used as background
1464 face_color_supported_p (f
, color_name
, background_p
)
1472 XSETFRAME (frame
, f
);
1473 return (FRAME_WINDOW_P (f
)
1474 ? (!NILP (Fxw_display_color_p (frame
))
1475 || xstricmp (color_name
, "black") == 0
1476 || xstricmp (color_name
, "white") == 0
1478 && face_color_gray_p (f
, color_name
))
1479 || (!NILP (Fx_display_grayscale_p (frame
))
1480 && face_color_gray_p (f
, color_name
)))
1481 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1485 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1486 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1487 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1488 If FRAME is nil or omitted, use the selected frame.")
1490 Lisp_Object color
, frame
;
1494 CHECK_FRAME (frame
, 0);
1495 CHECK_STRING (color
, 0);
1497 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1501 DEFUN ("color-supported-p", Fcolor_supported_p
,
1502 Scolor_supported_p
, 2, 3, 0,
1503 "Return non-nil if COLOR can be displayed on FRAME.\n\
1504 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1505 If FRAME is nil or omitted, use the selected frame.\n\
1506 COLOR must be a valid color name.")
1507 (color
, frame
, background_p
)
1508 Lisp_Object frame
, color
, background_p
;
1512 CHECK_FRAME (frame
, 0);
1513 CHECK_STRING (color
, 0);
1515 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1521 /* Load color with name NAME for use by face FACE on frame F.
1522 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1523 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1524 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1525 pixel color. If color cannot be loaded, display a message, and
1526 return the foreground, background or underline color of F, but
1527 record that fact in flags of the face so that we don't try to free
1531 load_color (f
, face
, name
, target_index
)
1535 enum lface_attribute_index target_index
;
1539 xassert (STRINGP (name
));
1540 xassert (target_index
== LFACE_FOREGROUND_INDEX
1541 || target_index
== LFACE_BACKGROUND_INDEX
1542 || target_index
== LFACE_UNDERLINE_INDEX
1543 || target_index
== LFACE_OVERLINE_INDEX
1544 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1545 || target_index
== LFACE_BOX_INDEX
);
1547 /* if the color map is full, defined_color will return a best match
1548 to the values in an existing cell. */
1549 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1551 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1553 switch (target_index
)
1555 case LFACE_FOREGROUND_INDEX
:
1556 face
->foreground_defaulted_p
= 1;
1557 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1560 case LFACE_BACKGROUND_INDEX
:
1561 face
->background_defaulted_p
= 1;
1562 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1565 case LFACE_UNDERLINE_INDEX
:
1566 face
->underline_defaulted_p
= 1;
1567 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1570 case LFACE_OVERLINE_INDEX
:
1571 face
->overline_color_defaulted_p
= 1;
1572 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1575 case LFACE_STRIKE_THROUGH_INDEX
:
1576 face
->strike_through_color_defaulted_p
= 1;
1577 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1580 case LFACE_BOX_INDEX
:
1581 face
->box_color_defaulted_p
= 1;
1582 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1591 ++ncolors_allocated
;
1598 #ifdef HAVE_WINDOW_SYSTEM
1600 /* Load colors for face FACE which is used on frame F. Colors are
1601 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1602 of ATTRS. If the background color specified is not supported on F,
1603 try to emulate gray colors with a stipple from Vface_default_stipple. */
1606 load_face_colors (f
, face
, attrs
)
1613 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1614 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1616 /* Swap colors if face is inverse-video. */
1617 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1625 /* Check for support for foreground, not for background because
1626 face_color_supported_p is smart enough to know that grays are
1627 "supported" as background because we are supposed to use stipple
1629 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1630 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1632 x_destroy_bitmap (f
, face
->stipple
);
1633 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1634 &face
->pixmap_w
, &face
->pixmap_h
);
1637 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1638 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1642 /* Free color PIXEL on frame F. */
1645 unload_color (f
, pixel
)
1647 unsigned long pixel
;
1649 #ifdef HAVE_X_WINDOWS
1653 x_free_colors (f
, &pixel
, 1);
1660 /* Free colors allocated for FACE. */
1663 free_face_colors (f
, face
)
1667 #ifdef HAVE_X_WINDOWS
1670 if (!face
->foreground_defaulted_p
)
1672 x_free_colors (f
, &face
->foreground
, 1);
1673 IF_DEBUG (--ncolors_allocated
);
1676 if (!face
->background_defaulted_p
)
1678 x_free_colors (f
, &face
->background
, 1);
1679 IF_DEBUG (--ncolors_allocated
);
1682 if (face
->underline_p
1683 && !face
->underline_defaulted_p
)
1685 x_free_colors (f
, &face
->underline_color
, 1);
1686 IF_DEBUG (--ncolors_allocated
);
1689 if (face
->overline_p
1690 && !face
->overline_color_defaulted_p
)
1692 x_free_colors (f
, &face
->overline_color
, 1);
1693 IF_DEBUG (--ncolors_allocated
);
1696 if (face
->strike_through_p
1697 && !face
->strike_through_color_defaulted_p
)
1699 x_free_colors (f
, &face
->strike_through_color
, 1);
1700 IF_DEBUG (--ncolors_allocated
);
1703 if (face
->box
!= FACE_NO_BOX
1704 && !face
->box_color_defaulted_p
)
1706 x_free_colors (f
, &face
->box_color
, 1);
1707 IF_DEBUG (--ncolors_allocated
);
1711 #endif /* HAVE_X_WINDOWS */
1714 #endif /* HAVE_WINDOW_SYSTEM */
1718 /***********************************************************************
1720 ***********************************************************************/
1722 /* An enumerator for each field of an XLFD font name. */
1743 /* An enumerator for each possible slant value of a font. Taken from
1744 the XLFD specification. */
1752 XLFD_SLANT_REVERSE_ITALIC
,
1753 XLFD_SLANT_REVERSE_OBLIQUE
,
1757 /* Relative font weight according to XLFD documentation. */
1761 XLFD_WEIGHT_UNKNOWN
,
1762 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1763 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1764 XLFD_WEIGHT_LIGHT
, /* 30 */
1765 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1766 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1767 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1768 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1769 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1770 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1773 /* Relative proportionate width. */
1777 XLFD_SWIDTH_UNKNOWN
,
1778 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1779 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1780 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1781 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1782 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1783 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1784 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1785 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1786 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1789 /* Structure used for tables mapping XLFD weight, slant, and width
1790 names to numeric and symbolic values. */
1796 Lisp_Object
*symbol
;
1799 /* Table of XLFD slant names and their numeric and symbolic
1800 representations. This table must be sorted by slant names in
1803 static struct table_entry slant_table
[] =
1805 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1806 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1807 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1808 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1809 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1810 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1813 /* Table of XLFD weight names. This table must be sorted by weight
1814 names in ascending order. */
1816 static struct table_entry weight_table
[] =
1818 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1819 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1820 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1821 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1822 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1823 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1824 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1825 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1826 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1827 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1828 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1829 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1830 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1831 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1832 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1833 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1836 /* Table of XLFD width names. This table must be sorted by width
1837 names in ascending order. */
1839 static struct table_entry swidth_table
[] =
1841 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1842 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1843 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1844 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1845 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1846 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1847 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1848 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1849 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1850 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1851 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1852 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1853 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1854 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1855 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1858 /* Structure used to hold the result of splitting font names in XLFD
1859 format into their fields. */
1863 /* The original name which is modified destructively by
1864 split_font_name. The pointer is kept here to be able to free it
1865 if it was allocated from the heap. */
1868 /* Font name fields. Each vector element points into `name' above.
1869 Fields are NUL-terminated. */
1870 char *fields
[XLFD_LAST
];
1872 /* Numeric values for those fields that interest us. See
1873 split_font_name for which these are. */
1874 int numeric
[XLFD_LAST
];
1876 /* Lower value mean higher priority. */
1877 int registry_priority
;
1880 /* The frame in effect when sorting font names. Set temporarily in
1881 sort_fonts so that it is available in font comparison functions. */
1883 static struct frame
*font_frame
;
1885 /* Order by which font selection chooses fonts. The default values
1886 mean `first, find a best match for the font width, then for the
1887 font height, then for weight, then for slant.' This variable can be
1888 set via set-face-font-sort-order. */
1891 static int font_sort_order
[4] = {
1892 XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
1895 static int font_sort_order
[4];
1898 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1899 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1900 is a pointer to the matching table entry or null if no table entry
1903 static struct table_entry
*
1904 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1905 struct table_entry
*table
;
1907 struct font_name
*font
;
1910 /* Function split_font_name converts fields to lower-case, so there
1911 is no need to use xstrlwr or xstricmp here. */
1912 char *s
= font
->fields
[field_index
];
1913 int low
, mid
, high
, cmp
;
1920 mid
= (low
+ high
) / 2;
1921 cmp
= strcmp (table
[mid
].name
, s
);
1935 /* Return a numeric representation for font name field
1936 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1937 has DIM entries. Value is the numeric value found or DFLT if no
1938 table entry matches. This function is used to translate weight,
1939 slant, and swidth names of XLFD font names to numeric values. */
1942 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1943 struct table_entry
*table
;
1945 struct font_name
*font
;
1949 struct table_entry
*p
;
1950 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1951 return p
? p
->numeric
: dflt
;
1955 /* Return a symbolic representation for font name field
1956 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1957 has DIM entries. Value is the symbolic value found or DFLT if no
1958 table entry matches. This function is used to translate weight,
1959 slant, and swidth names of XLFD font names to symbols. */
1961 static INLINE Lisp_Object
1962 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1963 struct table_entry
*table
;
1965 struct font_name
*font
;
1969 struct table_entry
*p
;
1970 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1971 return p
? *p
->symbol
: dflt
;
1975 /* Return a numeric value for the slant of the font given by FONT. */
1978 xlfd_numeric_slant (font
)
1979 struct font_name
*font
;
1981 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1982 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1986 /* Return a symbol representing the weight of the font given by FONT. */
1988 static INLINE Lisp_Object
1989 xlfd_symbolic_slant (font
)
1990 struct font_name
*font
;
1992 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1993 font
, XLFD_SLANT
, Qnormal
);
1997 /* Return a numeric value for the weight of the font given by FONT. */
2000 xlfd_numeric_weight (font
)
2001 struct font_name
*font
;
2003 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
2004 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
2008 /* Return a symbol representing the slant of the font given by FONT. */
2010 static INLINE Lisp_Object
2011 xlfd_symbolic_weight (font
)
2012 struct font_name
*font
;
2014 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
2015 font
, XLFD_WEIGHT
, Qnormal
);
2019 /* Return a numeric value for the swidth of the font whose XLFD font
2020 name fields are found in FONT. */
2023 xlfd_numeric_swidth (font
)
2024 struct font_name
*font
;
2026 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
2027 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
2031 /* Return a symbolic value for the swidth of FONT. */
2033 static INLINE Lisp_Object
2034 xlfd_symbolic_swidth (font
)
2035 struct font_name
*font
;
2037 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
2038 font
, XLFD_SWIDTH
, Qnormal
);
2042 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
2043 entries. Value is a pointer to the matching table entry or null if
2044 no element of TABLE contains SYMBOL. */
2046 static struct table_entry
*
2047 face_value (table
, dim
, symbol
)
2048 struct table_entry
*table
;
2054 xassert (SYMBOLP (symbol
));
2056 for (i
= 0; i
< dim
; ++i
)
2057 if (EQ (*table
[i
].symbol
, symbol
))
2060 return i
< dim
? table
+ i
: NULL
;
2064 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2065 entries. Value is -1 if SYMBOL is not found in TABLE. */
2068 face_numeric_value (table
, dim
, symbol
)
2069 struct table_entry
*table
;
2073 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2074 return p
? p
->numeric
: -1;
2078 /* Return a numeric value representing the weight specified by Lisp
2079 symbol WEIGHT. Value is one of the enumerators of enum
2083 face_numeric_weight (weight
)
2086 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2090 /* Return a numeric value representing the slant specified by Lisp
2091 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2094 face_numeric_slant (slant
)
2097 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2101 /* Return a numeric value representing the swidth specified by Lisp
2102 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2105 face_numeric_swidth (width
)
2108 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2112 #ifdef HAVE_WINDOW_SYSTEM
2114 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2118 struct font_name
*font
;
2120 /* Function split_font_name converts fields to lower-case, so there
2121 is no need to use tolower here. */
2122 return *font
->fields
[XLFD_SPACING
] != 'p';
2126 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2128 The actual height of the font when displayed on F depends on the
2129 resolution of both the font and frame. For example, a 10pt font
2130 designed for a 100dpi display will display larger than 10pt on a
2131 75dpi display. (It's not unusual to use fonts not designed for the
2132 display one is using. For example, some intlfonts are available in
2133 72dpi versions, only.)
2135 Value is the real point size of FONT on frame F, or 0 if it cannot
2139 xlfd_point_size (f
, font
)
2141 struct font_name
*font
;
2143 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2144 char *pixel_field
= font
->fields
[XLFD_PIXEL_SIZE
];
2148 if (*pixel_field
== '[')
2150 /* The pixel size field is `[A B C D]' which specifies
2151 a transformation matrix.
2157 by which all glyphs of the font are transformed. The spec
2158 says that s scalar value N for the pixel size is equivalent
2159 to A = N * resx/resy, B = C = 0, D = N. */
2160 char *start
= pixel_field
+ 1, *end
;
2164 for (i
= 0; i
< 4; ++i
)
2166 matrix
[i
] = strtod (start
, &end
);
2173 pixel
= atoi (pixel_field
);
2178 real_pt
= PT_PER_INCH
* 10.0 * pixel
/ resy
+ 0.5;
2184 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2185 of frame F. This function is used to guess a point size of font
2186 when only the pixel height of the font is available. */
2189 pixel_point_size (f
, pixel
)
2193 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2197 /* As one inch is PT_PER_INCH points, PT_PER_INCH/RESY gives the
2198 point size of one dot. */
2199 real_pt
= pixel
* PT_PER_INCH
/ resy
;
2200 int_pt
= real_pt
+ 0.5;
2206 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2207 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2208 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2209 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2210 zero if the font name doesn't have the format we expect. The
2211 expected format is a font name that starts with a `-' and has
2212 XLFD_LAST fields separated by `-'. */
2215 split_font_name (f
, font
, numeric_p
)
2217 struct font_name
*font
;
2223 if (*font
->name
== '-')
2225 char *p
= xstrlwr (font
->name
) + 1;
2227 while (i
< XLFD_LAST
)
2229 font
->fields
[i
] = p
;
2232 /* Pixel and point size may be of the form `[....]'. For
2233 BNF, see XLFD spec, chapter 4. Negative values are
2234 indicated by tilde characters which we replace with
2235 `-' characters, here. */
2237 && (i
- 1 == XLFD_PIXEL_SIZE
2238 || i
- 1 == XLFD_POINT_SIZE
))
2243 for (++p
; *p
&& *p
!= ']'; ++p
)
2247 /* Check that the matrix contains 4 floating point
2249 for (j
= 0, start
= font
->fields
[i
- 1] + 1;
2252 if (strtod (start
, &end
) == 0 && start
== end
)
2259 while (*p
&& *p
!= '-')
2269 success_p
= i
== XLFD_LAST
;
2271 /* If requested, and font name was in the expected format,
2272 compute numeric values for some fields. */
2273 if (numeric_p
&& success_p
)
2275 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2276 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2277 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2278 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2279 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2280 font
->numeric
[XLFD_AVGWIDTH
] = atoi (font
->fields
[XLFD_AVGWIDTH
]);
2283 /* Initialize it to zero. It will be overridden by font_list while
2284 trying alternate registries. */
2285 font
->registry_priority
= 0;
2291 /* Build an XLFD font name from font name fields in FONT. Value is a
2292 pointer to the font name, which is allocated via xmalloc. */
2295 build_font_name (font
)
2296 struct font_name
*font
;
2300 char *font_name
= (char *) xmalloc (size
);
2301 int total_length
= 0;
2303 for (i
= 0; i
< XLFD_LAST
; ++i
)
2305 /* Add 1 because of the leading `-'. */
2306 int len
= strlen (font
->fields
[i
]) + 1;
2308 /* Reallocate font_name if necessary. Add 1 for the final
2310 if (total_length
+ len
+ 1 >= size
)
2312 int new_size
= max (2 * size
, size
+ len
+ 1);
2313 int sz
= new_size
* sizeof *font_name
;
2314 font_name
= (char *) xrealloc (font_name
, sz
);
2318 font_name
[total_length
] = '-';
2319 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2320 total_length
+= len
;
2323 font_name
[total_length
] = 0;
2328 /* Free an array FONTS of N font_name structures. This frees FONTS
2329 itself and all `name' fields in its elements. */
2332 free_font_names (fonts
, n
)
2333 struct font_name
*fonts
;
2337 xfree (fonts
[--n
].name
);
2342 /* Sort vector FONTS of font_name structures which contains NFONTS
2343 elements using qsort and comparison function CMPFN. F is the frame
2344 on which the fonts will be used. The global variable font_frame
2345 is temporarily set to F to make it available in CMPFN. */
2348 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2350 struct font_name
*fonts
;
2352 int (*cmpfn
) P_ ((const void *, const void *));
2355 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2360 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2361 display in x_display_list. FONTS is a pointer to a vector of
2362 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2363 alternative patterns from Valternate_fontname_alist if no fonts are
2364 found matching PATTERN.
2366 For all fonts found, set FONTS[i].name to the name of the font,
2367 allocated via xmalloc, and split font names into fields. Ignore
2368 fonts that we can't parse. Value is the number of fonts found. */
2371 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
)
2374 struct font_name
*fonts
;
2375 int nfonts
, try_alternatives_p
;
2379 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2380 better to do it the other way around. */
2382 Lisp_Object lpattern
, tem
;
2384 lpattern
= build_string (pattern
);
2386 /* Get the list of fonts matching PATTERN. */
2389 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2392 lfonts
= x_list_fonts (f
, lpattern
, -1, nfonts
);
2395 /* Make a copy of the font names we got from X, and
2396 split them into fields. */
2398 for (tem
= lfonts
; CONSP (tem
) && n
< nfonts
; tem
= XCDR (tem
))
2400 Lisp_Object elt
, tail
;
2401 char *name
= XSTRING (XCAR (tem
))->data
;
2403 /* Ignore fonts matching a pattern from face-ignored-fonts. */
2404 for (tail
= Vface_ignored_fonts
; CONSP (tail
); tail
= XCDR (tail
))
2408 && fast_c_string_match_ignore_case (elt
, name
) >= 0)
2417 /* Make a copy of the font name. */
2418 fonts
[n
].name
= xstrdup (name
);
2420 if (split_font_name (f
, fonts
+ n
, 1))
2422 if (font_scalable_p (fonts
+ n
)
2423 && !may_use_scalable_font_p (name
))
2426 xfree (fonts
[n
].name
);
2432 xfree (fonts
[n
].name
);
2435 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2436 if (n
== 0 && try_alternatives_p
)
2438 Lisp_Object list
= Valternate_fontname_alist
;
2440 while (CONSP (list
))
2442 Lisp_Object entry
= XCAR (list
);
2444 && STRINGP (XCAR (entry
))
2445 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2452 Lisp_Object patterns
= XCAR (list
);
2455 while (CONSP (patterns
)
2456 /* If list is screwed up, give up. */
2457 && (name
= XCAR (patterns
),
2459 /* Ignore patterns equal to PATTERN because we tried that
2460 already with no success. */
2461 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2462 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2465 patterns
= XCDR (patterns
);
2473 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2474 using comparison function CMPFN. Value is the number of fonts
2475 found. If value is non-zero, *FONTS is set to a vector of
2476 font_name structures allocated from the heap containing matching
2477 fonts. Each element of *FONTS contains a name member that is also
2478 allocated from the heap. Font names in these structures are split
2479 into fields. Use free_font_names to free such an array. */
2482 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2485 int (*cmpfn
) P_ ((const void *, const void *));
2486 struct font_name
**fonts
;
2490 /* Get the list of fonts matching pattern. 100 should suffice. */
2491 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2492 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2493 nfonts
= XFASTINT (Vfont_list_limit
);
2495 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2496 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1);
2498 /* Sort the resulting array and return it in *FONTS. If no
2499 fonts were found, make sure to set *FONTS to null. */
2501 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2512 /* Compare two font_name structures *A and *B. Value is analogous to
2513 strcmp. Sort order is given by the global variable
2514 font_sort_order. Font names are sorted so that, everything else
2515 being equal, fonts with a resolution closer to that of the frame on
2516 which they are used are listed first. The global variable
2517 font_frame is the frame on which we operate. */
2520 cmp_font_names (a
, b
)
2523 struct font_name
*x
= (struct font_name
*) a
;
2524 struct font_name
*y
= (struct font_name
*) b
;
2527 /* All strings have been converted to lower-case by split_font_name,
2528 so we can use strcmp here. */
2529 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2534 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2536 int j
= font_sort_order
[i
];
2537 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2542 /* Everything else being equal, we prefer fonts with an
2543 y-resolution closer to that of the frame. */
2544 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2545 int x_resy
= x
->numeric
[XLFD_RESY
];
2546 int y_resy
= y
->numeric
[XLFD_RESY
];
2547 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2555 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2556 is non-nil list fonts matching that pattern. Otherwise, if
2557 REGISTRY is non-nil return only fonts with that registry, otherwise
2558 return fonts of any registry. Set *FONTS to a vector of font_name
2559 structures allocated from the heap containing the fonts found.
2560 Value is the number of fonts found. */
2563 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2565 Lisp_Object pattern
, family
, registry
;
2566 struct font_name
**fonts
;
2568 char *pattern_str
, *family_str
, *registry_str
;
2572 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2573 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2575 pattern_str
= (char *) alloca (strlen (family_str
)
2576 + strlen (registry_str
)
2578 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2579 strcat (pattern_str
, family_str
);
2580 strcat (pattern_str
, "-*-");
2581 strcat (pattern_str
, registry_str
);
2582 if (!index (registry_str
, '-'))
2584 if (registry_str
[strlen (registry_str
) - 1] == '*')
2585 strcat (pattern_str
, "-*");
2587 strcat (pattern_str
, "*-*");
2591 pattern_str
= (char *) XSTRING (pattern
)->data
;
2593 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2597 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2598 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2599 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2602 static struct font_name
*
2603 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2604 struct font_name
*fonts1
, *fonts2
;
2605 int nfonts1
, nfonts2
;
2607 int new_nfonts
= nfonts1
+ nfonts2
;
2608 struct font_name
*new_fonts
;
2610 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2611 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2612 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2619 /* Get a sorted list of fonts of family FAMILY on frame F.
2621 If PATTERN is non-nil list fonts matching that pattern.
2623 If REGISTRY is non-nil, return fonts with that registry and the
2624 alternative registries from Vface_alternative_font_registry_alist.
2626 If REGISTRY is nil return fonts of any registry.
2628 Set *FONTS to a vector of font_name structures allocated from the
2629 heap containing the fonts found. Value is the number of fonts
2633 font_list (f
, pattern
, family
, registry
, fonts
)
2635 Lisp_Object pattern
, family
, registry
;
2636 struct font_name
**fonts
;
2638 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2640 if (!NILP (registry
)
2641 && CONSP (Vface_alternative_font_registry_alist
))
2645 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2650 for (alter
= XCDR (alter
), reg_prio
= 1;
2652 alter
= XCDR (alter
), reg_prio
++)
2653 if (STRINGP (XCAR (alter
)))
2656 struct font_name
*fonts2
;
2658 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2660 for (i
= 0; i
< nfonts2
; i
++)
2661 fonts2
[i
].registry_priority
= reg_prio
;
2662 *fonts
= (nfonts
> 0
2663 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2674 /* Remove elements from LIST whose cars are `equal'. Called from
2675 x-family-fonts and x-font-family-list to remove duplicate font
2679 remove_duplicates (list
)
2682 Lisp_Object tail
= list
;
2684 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2686 Lisp_Object next
= XCDR (tail
);
2687 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2688 XCDR (tail
) = XCDR (next
);
2695 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2696 "Return a list of available fonts of family FAMILY on FRAME.\n\
2697 If FAMILY is omitted or nil, list all families.\n\
2698 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2700 If FRAME is omitted or nil, use the selected frame.\n\
2701 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2702 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2703 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2704 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2705 width, weight and slant of the font. These symbols are the same as for\n\
2706 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2707 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2708 giving the registry and encoding of the font.\n\
2709 The result list is sorted according to the current setting of\n\
2710 the face font sort order.")
2712 Lisp_Object family
, frame
;
2714 struct frame
*f
= check_x_frame (frame
);
2715 struct font_name
*fonts
;
2718 struct gcpro gcpro1
;
2721 CHECK_STRING (family
, 1);
2725 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2726 for (i
= nfonts
- 1; i
>= 0; --i
)
2728 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2731 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2732 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2733 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2734 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2735 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2736 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2737 tem
= build_font_name (fonts
+ i
);
2738 ASET (v
, 6, build_string (tem
));
2739 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2740 fonts
[i
].fields
[XLFD_ENCODING
]);
2741 ASET (v
, 7, build_string (tem
));
2744 result
= Fcons (v
, result
);
2747 remove_duplicates (result
);
2748 free_font_names (fonts
, nfonts
);
2754 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2756 "Return a list of available font families on FRAME.\n\
2757 If FRAME is omitted or nil, use the selected frame.\n\
2758 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2759 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2764 struct frame
*f
= check_x_frame (frame
);
2766 struct font_name
*fonts
;
2768 struct gcpro gcpro1
;
2769 int count
= specpdl_ptr
- specpdl
;
2772 /* Let's consider all fonts. Increase the limit for matching
2773 fonts until we have them all. */
2776 specbind (intern ("font-list-limit"), make_number (limit
));
2777 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2779 if (nfonts
== limit
)
2781 free_font_names (fonts
, nfonts
);
2790 for (i
= nfonts
- 1; i
>= 0; --i
)
2791 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2792 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2795 remove_duplicates (result
);
2796 free_font_names (fonts
, nfonts
);
2798 return unbind_to (count
, result
);
2802 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2803 "Return a list of the names of available fonts matching PATTERN.\n\
2804 If optional arguments FACE and FRAME are specified, return only fonts\n\
2805 the same size as FACE on FRAME.\n\
2806 PATTERN is a string, perhaps with wildcard characters;\n\
2807 the * character matches any substring, and\n\
2808 the ? character matches any single character.\n\
2809 PATTERN is case-insensitive.\n\
2810 FACE is a face name--a symbol.\n\
2812 The return value is a list of strings, suitable as arguments to\n\
2815 Fonts Emacs can't use may or may not be excluded\n\
2816 even if they match PATTERN and FACE.\n\
2817 The optional fourth argument MAXIMUM sets a limit on how many\n\
2818 fonts to match. The first MAXIMUM fonts are reported.\n\
2819 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2820 occupied by a character of a font. In that case, return only fonts\n\
2821 the WIDTH times as wide as FACE on FRAME.")
2822 (pattern
, face
, frame
, maximum
, width
)
2823 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2830 CHECK_STRING (pattern
, 0);
2836 CHECK_NATNUM (maximum
, 0);
2837 maxnames
= XINT (maximum
);
2841 CHECK_NUMBER (width
, 4);
2843 /* We can't simply call check_x_frame because this function may be
2844 called before any frame is created. */
2845 f
= frame_or_selected_frame (frame
, 2);
2846 if (!FRAME_WINDOW_P (f
))
2848 /* Perhaps we have not yet created any frame. */
2853 /* Determine the width standard for comparison with the fonts we find. */
2859 /* This is of limited utility since it works with character
2860 widths. Keep it for compatibility. --gerd. */
2861 int face_id
= lookup_named_face (f
, face
, 0);
2862 struct face
*face
= (face_id
< 0
2864 : FACE_FROM_ID (f
, face_id
));
2866 if (face
&& face
->font
)
2867 size
= FONT_WIDTH (face
->font
);
2869 size
= FONT_WIDTH (FRAME_FONT (f
));
2872 size
*= XINT (width
);
2876 Lisp_Object args
[2];
2878 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2880 /* We don't have to check fontsets. */
2882 args
[1] = list_fontsets (f
, pattern
, size
);
2883 return Fnconc (2, args
);
2887 #endif /* HAVE_WINDOW_SYSTEM */
2891 /***********************************************************************
2893 ***********************************************************************/
2895 /* Access face attributes of face LFACE, a Lisp vector. */
2897 #define LFACE_FAMILY(LFACE) AREF ((LFACE), LFACE_FAMILY_INDEX)
2898 #define LFACE_HEIGHT(LFACE) AREF ((LFACE), LFACE_HEIGHT_INDEX)
2899 #define LFACE_WEIGHT(LFACE) AREF ((LFACE), LFACE_WEIGHT_INDEX)
2900 #define LFACE_SLANT(LFACE) AREF ((LFACE), LFACE_SLANT_INDEX)
2901 #define LFACE_UNDERLINE(LFACE) AREF ((LFACE), LFACE_UNDERLINE_INDEX)
2902 #define LFACE_INVERSE(LFACE) AREF ((LFACE), LFACE_INVERSE_INDEX)
2903 #define LFACE_FOREGROUND(LFACE) AREF ((LFACE), LFACE_FOREGROUND_INDEX)
2904 #define LFACE_BACKGROUND(LFACE) AREF ((LFACE), LFACE_BACKGROUND_INDEX)
2905 #define LFACE_STIPPLE(LFACE) AREF ((LFACE), LFACE_STIPPLE_INDEX)
2906 #define LFACE_SWIDTH(LFACE) AREF ((LFACE), LFACE_SWIDTH_INDEX)
2907 #define LFACE_OVERLINE(LFACE) AREF ((LFACE), LFACE_OVERLINE_INDEX)
2908 #define LFACE_STRIKE_THROUGH(LFACE) AREF ((LFACE), LFACE_STRIKE_THROUGH_INDEX)
2909 #define LFACE_BOX(LFACE) AREF ((LFACE), LFACE_BOX_INDEX)
2910 #define LFACE_FONT(LFACE) AREF ((LFACE), LFACE_FONT_INDEX)
2911 #define LFACE_INHERIT(LFACE) AREF ((LFACE), LFACE_INHERIT_INDEX)
2912 #define LFACE_AVGWIDTH(LFACE) AREF ((LFACE), LFACE_AVGWIDTH_INDEX)
2914 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2915 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2917 #define LFACEP(LFACE) \
2919 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2920 && EQ (AREF (LFACE, 0), Qface))
2925 /* Check consistency of Lisp face attribute vector ATTRS. */
2928 check_lface_attrs (attrs
)
2931 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2932 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2933 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2934 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2935 xassert (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
2936 || INTEGERP (attrs
[LFACE_AVGWIDTH_INDEX
]));
2937 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2938 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2939 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2940 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2941 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2942 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2943 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2944 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2945 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2946 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2947 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2948 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2949 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2950 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2951 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2952 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2953 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2954 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2955 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2956 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2957 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2958 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2959 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2960 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2961 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2962 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2963 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2964 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2965 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2966 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2967 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2968 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2969 #ifdef HAVE_WINDOW_SYSTEM
2970 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2971 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2972 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2973 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2974 || NILP (attrs
[LFACE_FONT_INDEX
])
2975 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2980 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2988 xassert (LFACEP (lface
));
2989 check_lface_attrs (XVECTOR (lface
)->contents
);
2993 #else /* GLYPH_DEBUG == 0 */
2995 #define check_lface_attrs(attrs) (void) 0
2996 #define check_lface(lface) (void) 0
2998 #endif /* GLYPH_DEBUG == 0 */
3001 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
3002 to make it a symvol. If FACE_NAME is an alias for another face,
3003 return that face's name. */
3006 resolve_face_name (face_name
)
3007 Lisp_Object face_name
;
3009 Lisp_Object aliased
;
3011 if (STRINGP (face_name
))
3012 face_name
= intern (XSTRING (face_name
)->data
);
3014 while (SYMBOLP (face_name
))
3016 aliased
= Fget (face_name
, Qface_alias
);
3020 face_name
= aliased
;
3027 /* Return the face definition of FACE_NAME on frame F. F null means
3028 return the definition for new frames. FACE_NAME may be a string or
3029 a symbol (apparently Emacs 20.2 allowed strings as face names in
3030 face text properties; Ediff uses that). If FACE_NAME is an alias
3031 for another face, return that face's definition. If SIGNAL_P is
3032 non-zero, signal an error if FACE_NAME is not a valid face name.
3033 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3036 static INLINE Lisp_Object
3037 lface_from_face_name (f
, face_name
, signal_p
)
3039 Lisp_Object face_name
;
3044 face_name
= resolve_face_name (face_name
);
3047 lface
= assq_no_quit (face_name
, f
->face_alist
);
3049 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3052 lface
= XCDR (lface
);
3054 signal_error ("Invalid face", face_name
);
3056 check_lface (lface
);
3061 /* Get face attributes of face FACE_NAME from frame-local faces on
3062 frame F. Store the resulting attributes in ATTRS which must point
3063 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3064 is non-zero, signal an error if FACE_NAME does not name a face.
3065 Otherwise, value is zero if FACE_NAME is not a face. */
3068 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3070 Lisp_Object face_name
;
3077 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3080 bcopy (XVECTOR (lface
)->contents
, attrs
,
3081 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3091 /* Non-zero if all attributes in face attribute vector ATTRS are
3092 specified, i.e. are non-nil. */
3095 lface_fully_specified_p (attrs
)
3100 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3101 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
3102 && i
!= LFACE_AVGWIDTH_INDEX
)
3103 if (UNSPECIFIEDP (attrs
[i
]))
3106 return i
== LFACE_VECTOR_SIZE
;
3109 #ifdef HAVE_WINDOW_SYSTEM
3111 /* Set font-related attributes of Lisp face LFACE from the fullname of
3112 the font opened by FONTNAME. If FORCE_P is zero, set only
3113 unspecified attributes of LFACE. The exception is `font'
3114 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3116 If FONTNAME is not available on frame F,
3117 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3118 If the fullname is not in a valid XLFD format,
3119 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3120 in LFACE and return 1.
3121 Otherwise, return 1. */
3124 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3127 Lisp_Object fontname
;
3128 int force_p
, may_fail_p
;
3130 struct font_name font
;
3135 char *font_name
= XSTRING (fontname
)->data
;
3136 struct font_info
*font_info
;
3138 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3139 fontset
= fs_query_fontset (fontname
, 0);
3141 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3143 /* Check if FONT_NAME is surely available on the system. Usually
3144 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3145 returns quickly. But, even if FONT_NAME is not yet cached,
3146 caching it now is not futail because we anyway load the font
3149 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3159 font
.name
= STRDUPA (font_info
->full_name
);
3160 have_xlfd_p
= split_font_name (f
, &font
, 1);
3162 /* Set attributes only if unspecified, otherwise face defaults for
3163 new frames would never take effect. If we couldn't get a font
3164 name conforming to XLFD, set normal values. */
3166 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3171 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3172 + strlen (font
.fields
[XLFD_FOUNDRY
])
3174 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3175 font
.fields
[XLFD_FAMILY
]);
3176 val
= build_string (buffer
);
3179 val
= build_string ("*");
3180 LFACE_FAMILY (lface
) = val
;
3183 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3186 pt
= xlfd_point_size (f
, &font
);
3188 pt
= pixel_point_size (f
, font_info
->height
* 10);
3190 LFACE_HEIGHT (lface
) = make_number (pt
);
3193 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3194 LFACE_SWIDTH (lface
)
3195 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3197 if (force_p
|| UNSPECIFIEDP (LFACE_AVGWIDTH (lface
)))
3198 LFACE_AVGWIDTH (lface
)
3200 ? make_number (font
.numeric
[XLFD_AVGWIDTH
])
3203 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3204 LFACE_WEIGHT (lface
)
3205 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3207 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3209 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3211 LFACE_FONT (lface
) = fontname
;
3216 #endif /* HAVE_WINDOW_SYSTEM */
3219 /* Merges the face height FROM with the face height TO, and returns the
3220 merged height. If FROM is an invalid height, then INVALID is
3221 returned instead. FROM may be a either an absolute face height or a
3222 `relative' height, and TO must be an absolute height. The returned
3223 value is always an absolute height. GCPRO is a lisp value that will
3224 be protected from garbage-collection if this function makes a call
3228 merge_face_heights (from
, to
, invalid
, gcpro
)
3229 Lisp_Object from
, to
, invalid
, gcpro
;
3233 if (INTEGERP (from
))
3234 result
= XINT (from
);
3235 else if (NUMBERP (from
))
3236 result
= XFLOATINT (from
) * XINT (to
);
3237 #if 0 /* Probably not so useful. */
3238 else if (CONSP (from
) && CONSP (XCDR (from
)))
3240 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3242 if (INTEGERP (XCAR (XCDR (from
))))
3244 int inc
= XINT (XCAR (XCDR (from
)));
3245 if (EQ (XCAR (from
), Qminus
))
3248 result
= XFASTINT (to
);
3249 if (result
+ inc
> 0)
3250 /* Note that `underflows' don't mean FROM is invalid, so
3251 we just pin the result at TO if it would otherwise be
3258 else if (FUNCTIONP (from
))
3260 /* Call function with current height as argument.
3261 From is the new height. */
3262 Lisp_Object args
[2], height
;
3263 struct gcpro gcpro1
;
3269 height
= safe_call (2, args
);
3273 if (NUMBERP (height
))
3274 result
= XFLOATINT (height
);
3278 return make_number (result
);
3284 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3285 store the resulting attributes in TO, which must be already be
3286 completely specified and contain only absolute attributes. Every
3287 specified attribute of FROM overrides the corresponding attribute of
3288 TO; relative attributes in FROM are merged with the absolute value in
3289 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3290 face inheritance; it should be Qnil when called from other places. */
3293 merge_face_vectors (f
, from
, to
, cycle_check
)
3295 Lisp_Object
*from
, *to
;
3296 Lisp_Object cycle_check
;
3300 /* If FROM inherits from some other faces, merge their attributes into
3301 TO before merging FROM's direct attributes. Note that an :inherit
3302 attribute of `unspecified' is the same as one of nil; we never
3303 merge :inherit attributes, so nil is more correct, but lots of
3304 other code uses `unspecified' as a generic value for face attributes. */
3305 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3306 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3307 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3309 /* If TO specifies a :font attribute, and FROM specifies some
3310 font-related attribute, we need to clear TO's :font attribute
3311 (because it will be inconsistent with whatever FROM specifies, and
3312 FROM takes precedence). */
3313 if (!NILP (to
[LFACE_FONT_INDEX
])
3314 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3315 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3316 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3317 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3318 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])
3319 || !UNSPECIFIEDP (from
[LFACE_AVGWIDTH_INDEX
])))
3320 to
[LFACE_FONT_INDEX
] = Qnil
;
3322 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3323 if (!UNSPECIFIEDP (from
[i
]))
3324 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3325 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3329 /* TO is always an absolute face, which should inherit from nothing.
3330 We blindly copy the :inherit attribute above and fix it up here. */
3331 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3335 /* Checks the `cycle check' variable CHECK to see if it indicates that
3336 EL is part of a cycle; CHECK must be either Qnil or a value returned
3337 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3338 elements after which a cycle might be suspected; after that many
3339 elements, this macro begins consing in order to keep more precise
3342 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3345 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3346 the caller should make sure that's ok. */
3348 #define CYCLE_CHECK(check, el, suspicious) \
3351 : (INTEGERP (check) \
3352 ? (XFASTINT (check) < (suspicious) \
3353 ? make_number (XFASTINT (check) + 1) \
3354 : Fcons (el, Qnil)) \
3355 : (!NILP (Fmemq ((el), (check))) \
3357 : Fcons ((el), (check)))))
3360 /* Merge face attributes from the face on frame F whose name is
3361 INHERITS, into the vector of face attributes TO; INHERITS may also be
3362 a list of face names, in which case they are applied in order.
3363 CYCLE_CHECK is used to detect loops in face inheritance.
3364 Returns true if any of the inherited attributes are `font-related'. */
3367 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3369 Lisp_Object inherit
;
3371 Lisp_Object cycle_check
;
3373 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3374 /* Inherit from the named face INHERIT. */
3378 /* Make sure we're not in an inheritance loop. */
3379 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3380 if (NILP (cycle_check
))
3381 /* Cycle detected, ignore any further inheritance. */
3384 lface
= lface_from_face_name (f
, inherit
, 0);
3386 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3388 else if (CONSP (inherit
))
3389 /* Handle a list of inherited faces by calling ourselves recursively
3390 on each element. Note that we only do so for symbol elements, so
3391 it's not possible to infinitely recurse. */
3393 while (CONSP (inherit
))
3395 if (SYMBOLP (XCAR (inherit
)))
3396 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3398 /* Check for a circular inheritance list. */
3399 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3400 if (NILP (cycle_check
))
3401 /* Cycle detected. */
3404 inherit
= XCDR (inherit
);
3410 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3411 is a face property, determine the resulting face attributes on
3412 frame F, and store them in TO. PROP may be a single face
3413 specification or a list of such specifications. Each face
3414 specification can be
3416 1. A symbol or string naming a Lisp face.
3418 2. A property list of the form (KEYWORD VALUE ...) where each
3419 KEYWORD is a face attribute name, and value is an appropriate value
3422 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3423 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3424 for compatibility with 20.2.
3426 Face specifications earlier in lists take precedence over later
3430 merge_face_vector_with_property (f
, to
, prop
)
3437 Lisp_Object first
= XCAR (prop
);
3439 if (EQ (first
, Qforeground_color
)
3440 || EQ (first
, Qbackground_color
))
3442 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3443 . COLOR). COLOR must be a string. */
3444 Lisp_Object color_name
= XCDR (prop
);
3445 Lisp_Object color
= first
;
3447 if (STRINGP (color_name
))
3449 if (EQ (color
, Qforeground_color
))
3450 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3452 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3455 add_to_log ("Invalid face color", color_name
, Qnil
);
3457 else if (SYMBOLP (first
)
3458 && *XSYMBOL (first
)->name
->data
== ':')
3460 /* Assume this is the property list form. */
3461 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3463 Lisp_Object keyword
= XCAR (prop
);
3464 Lisp_Object value
= XCAR (XCDR (prop
));
3466 if (EQ (keyword
, QCfamily
))
3468 if (STRINGP (value
))
3469 to
[LFACE_FAMILY_INDEX
] = value
;
3471 add_to_log ("Invalid face font family", value
, Qnil
);
3473 else if (EQ (keyword
, QCheight
))
3475 Lisp_Object new_height
=
3476 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3479 if (NILP (new_height
))
3480 add_to_log ("Invalid face font height", value
, Qnil
);
3482 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3484 else if (EQ (keyword
, QCweight
))
3487 && face_numeric_weight (value
) >= 0)
3488 to
[LFACE_WEIGHT_INDEX
] = value
;
3490 add_to_log ("Invalid face weight", value
, Qnil
);
3492 else if (EQ (keyword
, QCslant
))
3495 && face_numeric_slant (value
) >= 0)
3496 to
[LFACE_SLANT_INDEX
] = value
;
3498 add_to_log ("Invalid face slant", value
, Qnil
);
3500 else if (EQ (keyword
, QCunderline
))
3505 to
[LFACE_UNDERLINE_INDEX
] = value
;
3507 add_to_log ("Invalid face underline", value
, Qnil
);
3509 else if (EQ (keyword
, QCoverline
))
3514 to
[LFACE_OVERLINE_INDEX
] = value
;
3516 add_to_log ("Invalid face overline", value
, Qnil
);
3518 else if (EQ (keyword
, QCstrike_through
))
3523 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3525 add_to_log ("Invalid face strike-through", value
, Qnil
);
3527 else if (EQ (keyword
, QCbox
))
3530 value
= make_number (1);
3531 if (INTEGERP (value
)
3535 to
[LFACE_BOX_INDEX
] = value
;
3537 add_to_log ("Invalid face box", value
, Qnil
);
3539 else if (EQ (keyword
, QCinverse_video
)
3540 || EQ (keyword
, QCreverse_video
))
3542 if (EQ (value
, Qt
) || NILP (value
))
3543 to
[LFACE_INVERSE_INDEX
] = value
;
3545 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3547 else if (EQ (keyword
, QCforeground
))
3549 if (STRINGP (value
))
3550 to
[LFACE_FOREGROUND_INDEX
] = value
;
3552 add_to_log ("Invalid face foreground", value
, Qnil
);
3554 else if (EQ (keyword
, QCbackground
))
3556 if (STRINGP (value
))
3557 to
[LFACE_BACKGROUND_INDEX
] = value
;
3559 add_to_log ("Invalid face background", value
, Qnil
);
3561 else if (EQ (keyword
, QCstipple
))
3563 #ifdef HAVE_X_WINDOWS
3564 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3565 if (!NILP (pixmap_p
))
3566 to
[LFACE_STIPPLE_INDEX
] = value
;
3568 add_to_log ("Invalid face stipple", value
, Qnil
);
3571 else if (EQ (keyword
, QCwidth
))
3574 && face_numeric_swidth (value
) >= 0)
3575 to
[LFACE_SWIDTH_INDEX
] = value
;
3577 add_to_log ("Invalid face width", value
, Qnil
);
3579 else if (EQ (keyword
, QCinherit
))
3581 if (SYMBOLP (value
))
3582 to
[LFACE_INHERIT_INDEX
] = value
;
3586 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3587 if (!SYMBOLP (XCAR (tail
)))
3590 to
[LFACE_INHERIT_INDEX
] = value
;
3592 add_to_log ("Invalid face inherit", value
, Qnil
);
3596 add_to_log ("Invalid attribute %s in face property",
3599 prop
= XCDR (XCDR (prop
));
3604 /* This is a list of face specs. Specifications at the
3605 beginning of the list take precedence over later
3606 specifications, so we have to merge starting with the
3607 last specification. */
3608 Lisp_Object next
= XCDR (prop
);
3610 merge_face_vector_with_property (f
, to
, next
);
3611 merge_face_vector_with_property (f
, to
, first
);
3616 /* PROP ought to be a face name. */
3617 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3619 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3621 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3626 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3627 Sinternal_make_lisp_face
, 1, 2, 0,
3628 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3629 If FACE was not known as a face before, create a new one.\n\
3630 If optional argument FRAME is specified, make a frame-local face\n\
3631 for that frame. Otherwise operate on the global face definition.\n\
3632 Value is a vector of face attributes.")
3634 Lisp_Object face
, frame
;
3636 Lisp_Object global_lface
, lface
;
3640 CHECK_SYMBOL (face
, 0);
3641 global_lface
= lface_from_face_name (NULL
, face
, 0);
3645 CHECK_LIVE_FRAME (frame
, 1);
3647 lface
= lface_from_face_name (f
, face
, 0);
3650 f
= NULL
, lface
= Qnil
;
3652 /* Add a global definition if there is none. */
3653 if (NILP (global_lface
))
3655 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3657 AREF (global_lface
, 0) = Qface
;
3658 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3659 Vface_new_frame_defaults
);
3661 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3662 face id to Lisp face is given by the vector lface_id_to_name.
3663 The mapping from Lisp face to Lisp face id is given by the
3664 property `face' of the Lisp face name. */
3665 if (next_lface_id
== lface_id_to_name_size
)
3667 int new_size
= max (50, 2 * lface_id_to_name_size
);
3668 int sz
= new_size
* sizeof *lface_id_to_name
;
3669 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3670 lface_id_to_name_size
= new_size
;
3673 lface_id_to_name
[next_lface_id
] = face
;
3674 Fput (face
, Qface
, make_number (next_lface_id
));
3678 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3679 AREF (global_lface
, i
) = Qunspecified
;
3681 /* Add a frame-local definition. */
3686 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3688 AREF (lface
, 0) = Qface
;
3689 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3692 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3693 AREF (lface
, i
) = Qunspecified
;
3696 lface
= global_lface
;
3698 xassert (LFACEP (lface
));
3699 check_lface (lface
);
3704 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3705 Sinternal_lisp_face_p
, 1, 2, 0,
3706 "Return non-nil if FACE names a face.\n\
3707 If optional second parameter FRAME is non-nil, check for the\n\
3708 existence of a frame-local face with name FACE on that frame.\n\
3709 Otherwise check for the existence of a global face.")
3711 Lisp_Object face
, frame
;
3717 CHECK_LIVE_FRAME (frame
, 1);
3718 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3721 lface
= lface_from_face_name (NULL
, face
, 0);
3727 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3728 Sinternal_copy_lisp_face
, 4, 4, 0,
3729 "Copy face FROM to TO.\n\
3730 If FRAME it t, copy the global face definition of FROM to the\n\
3731 global face definition of TO. Otherwise, copy the frame-local\n\
3732 definition of FROM on FRAME to the frame-local definition of TO\n\
3733 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3736 (from
, to
, frame
, new_frame
)
3737 Lisp_Object from
, to
, frame
, new_frame
;
3739 Lisp_Object lface
, copy
;
3741 CHECK_SYMBOL (from
, 0);
3742 CHECK_SYMBOL (to
, 1);
3743 if (NILP (new_frame
))
3748 /* Copy global definition of FROM. We don't make copies of
3749 strings etc. because 20.2 didn't do it either. */
3750 lface
= lface_from_face_name (NULL
, from
, 1);
3751 copy
= Finternal_make_lisp_face (to
, Qnil
);
3755 /* Copy frame-local definition of FROM. */
3756 CHECK_LIVE_FRAME (frame
, 2);
3757 CHECK_LIVE_FRAME (new_frame
, 3);
3758 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3759 copy
= Finternal_make_lisp_face (to
, new_frame
);
3762 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3763 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3769 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3770 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3771 "Set attribute ATTR of FACE to VALUE.\n\
3772 FRAME being a frame means change the face on that frame.\n\
3773 FRAME nil means change the face of the selected frame.\n\
3774 FRAME t means change the default for new frames.\n\
3775 FRAME 0 means change the face on all frames, and change the default\n\
3777 (face
, attr
, value
, frame
)
3778 Lisp_Object face
, attr
, value
, frame
;
3781 Lisp_Object old_value
= Qnil
;
3782 /* Set 1 if ATTR is QCfont. */
3783 int font_attr_p
= 0;
3784 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3785 int font_related_attr_p
= 0;
3787 CHECK_SYMBOL (face
, 0);
3788 CHECK_SYMBOL (attr
, 1);
3790 face
= resolve_face_name (face
);
3792 /* If FRAME is 0, change face on all frames, and change the
3793 default for new frames. */
3794 if (INTEGERP (frame
) && XINT (frame
) == 0)
3797 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3798 FOR_EACH_FRAME (tail
, frame
)
3799 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3803 /* Set lface to the Lisp attribute vector of FACE. */
3805 lface
= lface_from_face_name (NULL
, face
, 1);
3809 frame
= selected_frame
;
3811 CHECK_LIVE_FRAME (frame
, 3);
3812 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3814 /* If a frame-local face doesn't exist yet, create one. */
3816 lface
= Finternal_make_lisp_face (face
, frame
);
3819 if (EQ (attr
, QCfamily
))
3821 if (!UNSPECIFIEDP (value
))
3823 CHECK_STRING (value
, 3);
3824 if (XSTRING (value
)->size
== 0)
3825 signal_error ("Invalid face family", value
);
3827 old_value
= LFACE_FAMILY (lface
);
3828 LFACE_FAMILY (lface
) = value
;
3829 font_related_attr_p
= 1;
3831 else if (EQ (attr
, QCheight
))
3833 if (!UNSPECIFIEDP (value
))
3836 (EQ (face
, Qdefault
) ? value
:
3837 /* The default face must have an absolute size, otherwise, we do
3838 a test merge with a random height to see if VALUE's ok. */
3839 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3841 if (!INTEGERP(test
) || XINT(test
) <= 0)
3842 signal_error ("Invalid face height", value
);
3845 old_value
= LFACE_HEIGHT (lface
);
3846 LFACE_HEIGHT (lface
) = value
;
3847 font_related_attr_p
= 1;
3849 else if (EQ (attr
, QCweight
))
3851 if (!UNSPECIFIEDP (value
))
3853 CHECK_SYMBOL (value
, 3);
3854 if (face_numeric_weight (value
) < 0)
3855 signal_error ("Invalid face weight", value
);
3857 old_value
= LFACE_WEIGHT (lface
);
3858 LFACE_WEIGHT (lface
) = value
;
3859 font_related_attr_p
= 1;
3861 else if (EQ (attr
, QCslant
))
3863 if (!UNSPECIFIEDP (value
))
3865 CHECK_SYMBOL (value
, 3);
3866 if (face_numeric_slant (value
) < 0)
3867 signal_error ("Invalid face slant", value
);
3869 old_value
= LFACE_SLANT (lface
);
3870 LFACE_SLANT (lface
) = value
;
3871 font_related_attr_p
= 1;
3873 else if (EQ (attr
, QCunderline
))
3875 if (!UNSPECIFIEDP (value
))
3876 if ((SYMBOLP (value
)
3878 && !EQ (value
, Qnil
))
3879 /* Underline color. */
3881 && XSTRING (value
)->size
== 0))
3882 signal_error ("Invalid face underline", value
);
3884 old_value
= LFACE_UNDERLINE (lface
);
3885 LFACE_UNDERLINE (lface
) = value
;
3887 else if (EQ (attr
, QCoverline
))
3889 if (!UNSPECIFIEDP (value
))
3890 if ((SYMBOLP (value
)
3892 && !EQ (value
, Qnil
))
3893 /* Overline color. */
3895 && XSTRING (value
)->size
== 0))
3896 signal_error ("Invalid face overline", value
);
3898 old_value
= LFACE_OVERLINE (lface
);
3899 LFACE_OVERLINE (lface
) = value
;
3901 else if (EQ (attr
, QCstrike_through
))
3903 if (!UNSPECIFIEDP (value
))
3904 if ((SYMBOLP (value
)
3906 && !EQ (value
, Qnil
))
3907 /* Strike-through color. */
3909 && XSTRING (value
)->size
== 0))
3910 signal_error ("Invalid face strike-through", value
);
3912 old_value
= LFACE_STRIKE_THROUGH (lface
);
3913 LFACE_STRIKE_THROUGH (lface
) = value
;
3915 else if (EQ (attr
, QCbox
))
3919 /* Allow t meaning a simple box of width 1 in foreground color
3922 value
= make_number (1);
3924 if (UNSPECIFIEDP (value
))
3926 else if (NILP (value
))
3928 else if (INTEGERP (value
))
3929 valid_p
= XINT (value
) != 0;
3930 else if (STRINGP (value
))
3931 valid_p
= XSTRING (value
)->size
> 0;
3932 else if (CONSP (value
))
3948 if (EQ (k
, QCline_width
))
3950 if (!INTEGERP (v
) || XINT (v
) == 0)
3953 else if (EQ (k
, QCcolor
))
3955 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3958 else if (EQ (k
, QCstyle
))
3960 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3967 valid_p
= NILP (tem
);
3973 signal_error ("Invalid face box", value
);
3975 old_value
= LFACE_BOX (lface
);
3976 LFACE_BOX (lface
) = value
;
3978 else if (EQ (attr
, QCinverse_video
)
3979 || EQ (attr
, QCreverse_video
))
3981 if (!UNSPECIFIEDP (value
))
3983 CHECK_SYMBOL (value
, 3);
3984 if (!EQ (value
, Qt
) && !NILP (value
))
3985 signal_error ("Invalid inverse-video face attribute value", value
);
3987 old_value
= LFACE_INVERSE (lface
);
3988 LFACE_INVERSE (lface
) = value
;
3990 else if (EQ (attr
, QCforeground
))
3992 if (!UNSPECIFIEDP (value
))
3994 /* Don't check for valid color names here because it depends
3995 on the frame (display) whether the color will be valid
3996 when the face is realized. */
3997 CHECK_STRING (value
, 3);
3998 if (XSTRING (value
)->size
== 0)
3999 signal_error ("Empty foreground color value", value
);
4001 old_value
= LFACE_FOREGROUND (lface
);
4002 LFACE_FOREGROUND (lface
) = value
;
4004 else if (EQ (attr
, QCbackground
))
4006 if (!UNSPECIFIEDP (value
))
4008 /* Don't check for valid color names here because it depends
4009 on the frame (display) whether the color will be valid
4010 when the face is realized. */
4011 CHECK_STRING (value
, 3);
4012 if (XSTRING (value
)->size
== 0)
4013 signal_error ("Empty background color value", value
);
4015 old_value
= LFACE_BACKGROUND (lface
);
4016 LFACE_BACKGROUND (lface
) = value
;
4018 else if (EQ (attr
, QCstipple
))
4020 #ifdef HAVE_X_WINDOWS
4021 if (!UNSPECIFIEDP (value
)
4023 && NILP (Fbitmap_spec_p (value
)))
4024 signal_error ("Invalid stipple attribute", value
);
4025 old_value
= LFACE_STIPPLE (lface
);
4026 LFACE_STIPPLE (lface
) = value
;
4027 #endif /* HAVE_X_WINDOWS */
4029 else if (EQ (attr
, QCwidth
))
4031 if (!UNSPECIFIEDP (value
))
4033 CHECK_SYMBOL (value
, 3);
4034 if (face_numeric_swidth (value
) < 0)
4035 signal_error ("Invalid face width", value
);
4037 old_value
= LFACE_SWIDTH (lface
);
4038 LFACE_SWIDTH (lface
) = value
;
4039 font_related_attr_p
= 1;
4041 else if (EQ (attr
, QCfont
))
4043 #ifdef HAVE_WINDOW_SYSTEM
4044 /* Set font-related attributes of the Lisp face from an
4049 CHECK_STRING (value
, 3);
4051 f
= SELECTED_FRAME ();
4053 f
= check_x_frame (frame
);
4055 /* VALUE may be a fontset name or an alias of fontset. In such
4056 a case, use the base fontset name. */
4057 tmp
= Fquery_fontset (value
, Qnil
);
4061 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4062 signal_error ("Invalid font or fontset name", value
);
4065 #endif /* HAVE_WINDOW_SYSTEM */
4067 else if (EQ (attr
, QCinherit
))
4070 if (SYMBOLP (value
))
4073 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4074 if (!SYMBOLP (XCAR (tail
)))
4077 LFACE_INHERIT (lface
) = value
;
4079 signal_error ("Invalid face inheritance", value
);
4081 else if (EQ (attr
, QCbold
))
4083 old_value
= LFACE_WEIGHT (lface
);
4084 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4085 font_related_attr_p
= 1;
4087 else if (EQ (attr
, QCitalic
))
4089 old_value
= LFACE_SLANT (lface
);
4090 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4091 font_related_attr_p
= 1;
4094 signal_error ("Invalid face attribute name", attr
);
4096 if (font_related_attr_p
4097 && !UNSPECIFIEDP (value
))
4098 /* If a font-related attribute other than QCfont is specified, the
4099 original `font' attribute nor that of default face is useless
4100 to determine a new font. Thus, we set it to nil so that font
4101 selection mechanism doesn't use it. */
4102 LFACE_FONT (lface
) = Qnil
;
4104 /* Changing a named face means that all realized faces depending on
4105 that face are invalid. Since we cannot tell which realized faces
4106 depend on the face, make sure they are all removed. This is done
4107 by incrementing face_change_count. The next call to
4108 init_iterator will then free realized faces. */
4110 && (EQ (attr
, QCfont
)
4111 || NILP (Fequal (old_value
, value
))))
4113 ++face_change_count
;
4114 ++windows_or_buffers_changed
;
4117 if (!UNSPECIFIEDP (value
)
4118 && NILP (Fequal (old_value
, value
)))
4124 if (EQ (face
, Qdefault
))
4126 #ifdef HAVE_WINDOW_SYSTEM
4127 /* Changed font-related attributes of the `default' face are
4128 reflected in changed `font' frame parameters. */
4130 && (font_related_attr_p
|| font_attr_p
)
4131 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4132 set_font_frame_param (frame
, lface
);
4134 #endif /* HAVE_WINDOW_SYSTEM */
4136 if (EQ (attr
, QCforeground
))
4137 param
= Qforeground_color
;
4138 else if (EQ (attr
, QCbackground
))
4139 param
= Qbackground_color
;
4141 #ifdef HAVE_WINDOW_SYSTEM
4143 else if (EQ (face
, Qscroll_bar
))
4145 /* Changing the colors of `scroll-bar' sets frame parameters
4146 `scroll-bar-foreground' and `scroll-bar-background'. */
4147 if (EQ (attr
, QCforeground
))
4148 param
= Qscroll_bar_foreground
;
4149 else if (EQ (attr
, QCbackground
))
4150 param
= Qscroll_bar_background
;
4152 #endif /* not WINDOWSNT */
4153 else if (EQ (face
, Qborder
))
4155 /* Changing background color of `border' sets frame parameter
4157 if (EQ (attr
, QCbackground
))
4158 param
= Qborder_color
;
4160 else if (EQ (face
, Qcursor
))
4162 /* Changing background color of `cursor' sets frame parameter
4164 if (EQ (attr
, QCbackground
))
4165 param
= Qcursor_color
;
4167 else if (EQ (face
, Qmouse
))
4169 /* Changing background color of `mouse' sets frame parameter
4171 if (EQ (attr
, QCbackground
))
4172 param
= Qmouse_color
;
4174 #endif /* HAVE_WINDOW_SYSTEM */
4175 else if (EQ (face
, Qmenu
))
4177 /* Indicate that we have to update the menu bar when
4178 realizing faces on FRAME. FRAME t change the
4179 default for new frames. We do this by setting
4180 setting the flag in new face caches */
4183 struct frame
*f
= XFRAME (frame
);
4184 if (FRAME_FACE_CACHE (f
) == NULL
)
4185 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
4186 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 1;
4189 menu_face_changed_default
= 1;
4194 /* Update `default-frame-alist', which is used for new frames. */
4196 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4199 /* Update the current frame's parameters. */
4202 cons
= XCAR (Vparam_value_alist
);
4203 XCAR (cons
) = param
;
4204 XCDR (cons
) = value
;
4205 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4213 #ifdef HAVE_WINDOW_SYSTEM
4215 /* Set the `font' frame parameter of FRAME determined from `default'
4216 face attributes LFACE. If a face or fontset name is explicitely
4217 specfied in LFACE, use it as is. Otherwise, determine a font name
4218 from the other font-related atrributes of LFACE. In that case, if
4219 there's no matching font, signals an error. */
4222 set_font_frame_param (frame
, lface
)
4223 Lisp_Object frame
, lface
;
4225 struct frame
*f
= XFRAME (frame
);
4227 if (FRAME_WINDOW_P (f
))
4229 Lisp_Object font_name
;
4232 if (STRINGP (LFACE_FONT (lface
)))
4233 font_name
= LFACE_FONT (lface
);
4236 /* Choose a font name that reflects LFACE's attributes and has
4237 the registry and encoding pattern specified in the default
4238 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4239 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4241 error ("No font matches the specified attribute");
4242 font_name
= build_string (font
);
4246 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4251 /* Update the corresponding face when frame parameter PARAM on frame F
4252 has been assigned the value NEW_VALUE. */
4255 update_face_from_frame_parameter (f
, param
, new_value
)
4257 Lisp_Object param
, new_value
;
4261 /* If there are no faces yet, give up. This is the case when called
4262 from Fx_create_frame, and we do the necessary things later in
4263 face-set-after-frame-defaults. */
4264 if (NILP (f
->face_alist
))
4267 if (EQ (param
, Qforeground_color
))
4269 lface
= lface_from_face_name (f
, Qdefault
, 1);
4270 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4271 ? new_value
: Qunspecified
);
4272 realize_basic_faces (f
);
4274 else if (EQ (param
, Qbackground_color
))
4278 /* Changing the background color might change the background
4279 mode, so that we have to load new defface specs. Call
4280 frame-update-face-colors to do that. */
4281 XSETFRAME (frame
, f
);
4282 call1 (Qframe_update_face_colors
, frame
);
4284 lface
= lface_from_face_name (f
, Qdefault
, 1);
4285 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4286 ? new_value
: Qunspecified
);
4287 realize_basic_faces (f
);
4289 if (EQ (param
, Qborder_color
))
4291 lface
= lface_from_face_name (f
, Qborder
, 1);
4292 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4293 ? new_value
: Qunspecified
);
4295 else if (EQ (param
, Qcursor_color
))
4297 lface
= lface_from_face_name (f
, Qcursor
, 1);
4298 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4299 ? new_value
: Qunspecified
);
4301 else if (EQ (param
, Qmouse_color
))
4303 lface
= lface_from_face_name (f
, Qmouse
, 1);
4304 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4305 ? new_value
: Qunspecified
);
4310 /* Get the value of X resource RESOURCE, class CLASS for the display
4311 of frame FRAME. This is here because ordinary `x-get-resource'
4312 doesn't take a frame argument. */
4314 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4315 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4316 (resource
, class, frame
)
4317 Lisp_Object resource
, class, frame
;
4319 Lisp_Object value
= Qnil
;
4322 CHECK_STRING (resource
, 0);
4323 CHECK_STRING (class, 1);
4324 CHECK_LIVE_FRAME (frame
, 2);
4326 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4327 resource
, class, Qnil
, Qnil
);
4329 #endif /* not macintosh */
4330 #endif /* not WINDOWSNT */
4335 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4336 If VALUE is "on" or "true", return t. If VALUE is "off" or
4337 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4338 error; if SIGNAL_P is zero, return 0. */
4341 face_boolean_x_resource_value (value
, signal_p
)
4345 Lisp_Object result
= make_number (0);
4347 xassert (STRINGP (value
));
4349 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4350 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4352 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4353 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4355 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4356 result
= Qunspecified
;
4358 signal_error ("Invalid face attribute value from X resource", value
);
4364 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4365 Finternal_set_lisp_face_attribute_from_resource
,
4366 Sinternal_set_lisp_face_attribute_from_resource
,
4368 (face
, attr
, value
, frame
)
4369 Lisp_Object face
, attr
, value
, frame
;
4371 CHECK_SYMBOL (face
, 0);
4372 CHECK_SYMBOL (attr
, 1);
4373 CHECK_STRING (value
, 2);
4375 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4376 value
= Qunspecified
;
4377 else if (EQ (attr
, QCheight
))
4379 value
= Fstring_to_number (value
, make_number (10));
4380 if (XINT (value
) <= 0)
4381 signal_error ("Invalid face height from X resource", value
);
4383 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4384 value
= face_boolean_x_resource_value (value
, 1);
4385 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4386 value
= intern (XSTRING (value
)->data
);
4387 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4388 value
= face_boolean_x_resource_value (value
, 1);
4389 else if (EQ (attr
, QCunderline
)
4390 || EQ (attr
, QCoverline
)
4391 || EQ (attr
, QCstrike_through
)
4392 || EQ (attr
, QCbox
))
4394 Lisp_Object boolean_value
;
4396 /* If the result of face_boolean_x_resource_value is t or nil,
4397 VALUE does NOT specify a color. */
4398 boolean_value
= face_boolean_x_resource_value (value
, 0);
4399 if (SYMBOLP (boolean_value
))
4400 value
= boolean_value
;
4403 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4406 #endif /* HAVE_WINDOW_SYSTEM */
4409 /***********************************************************************
4411 ***********************************************************************/
4413 #if defined HAVE_X_WINDOWS && defined USE_X_TOOLKIT
4415 /* Make menus on frame F appear as specified by the `menu' face. */
4418 x_update_menu_appearance (f
)
4421 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
4425 && (rdb
= XrmGetDatabase (FRAME_X_DISPLAY (f
)),
4429 Lisp_Object lface
= lface_from_face_name (f
, Qmenu
, 1);
4430 struct face
*face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4431 char *myname
= XSTRING (Vx_resource_name
)->data
;
4434 const char *popup_path
= "popup_menu";
4436 const char *popup_path
= "menu.popup";
4439 if (STRINGP (LFACE_FOREGROUND (lface
)))
4441 sprintf (line
, "%s.%s*foreground: %s",
4443 XSTRING (LFACE_FOREGROUND (lface
))->data
);
4444 XrmPutLineResource (&rdb
, line
);
4445 sprintf (line
, "%s.pane.menubar*foreground: %s",
4446 myname
, XSTRING (LFACE_FOREGROUND (lface
))->data
);
4447 XrmPutLineResource (&rdb
, line
);
4451 if (STRINGP (LFACE_BACKGROUND (lface
)))
4453 sprintf (line
, "%s.%s*background: %s",
4455 XSTRING (LFACE_BACKGROUND (lface
))->data
);
4456 XrmPutLineResource (&rdb
, line
);
4457 sprintf (line
, "%s.pane.menubar*background: %s",
4458 myname
, XSTRING (LFACE_BACKGROUND (lface
))->data
);
4459 XrmPutLineResource (&rdb
, line
);
4464 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4465 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4466 || !UNSPECIFIEDP (LFACE_AVGWIDTH (lface
))
4467 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4468 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4469 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4472 const char *suffix
= "List";
4474 const char *suffix
= "";
4476 sprintf (line
, "%s.pane.menubar*font%s: %s",
4477 myname
, suffix
, face
->font_name
);
4478 XrmPutLineResource (&rdb
, line
);
4479 sprintf (line
, "%s.%s*font%s: %s",
4480 myname
, popup_path
, suffix
, face
->font_name
);
4481 XrmPutLineResource (&rdb
, line
);
4485 if (changed_p
&& f
->output_data
.x
->menubar_widget
)
4486 free_frame_menubar (f
);
4490 #endif /* HAVE_X_WINDOWS && USE_X_TOOLKIT */
4494 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4495 Sinternal_get_lisp_face_attribute
,
4497 "Return face attribute KEYWORD of face SYMBOL.\n\
4498 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4499 face attribute name, signal an error.\n\
4500 If the optional argument FRAME is given, report on face FACE in that\n\
4501 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4502 frames). If FRAME is omitted or nil, use the selected frame.")
4503 (symbol
, keyword
, frame
)
4504 Lisp_Object symbol
, keyword
, frame
;
4506 Lisp_Object lface
, value
= Qnil
;
4508 CHECK_SYMBOL (symbol
, 0);
4509 CHECK_SYMBOL (keyword
, 1);
4512 lface
= lface_from_face_name (NULL
, symbol
, 1);
4516 frame
= selected_frame
;
4517 CHECK_LIVE_FRAME (frame
, 2);
4518 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4521 if (EQ (keyword
, QCfamily
))
4522 value
= LFACE_FAMILY (lface
);
4523 else if (EQ (keyword
, QCheight
))
4524 value
= LFACE_HEIGHT (lface
);
4525 else if (EQ (keyword
, QCweight
))
4526 value
= LFACE_WEIGHT (lface
);
4527 else if (EQ (keyword
, QCslant
))
4528 value
= LFACE_SLANT (lface
);
4529 else if (EQ (keyword
, QCunderline
))
4530 value
= LFACE_UNDERLINE (lface
);
4531 else if (EQ (keyword
, QCoverline
))
4532 value
= LFACE_OVERLINE (lface
);
4533 else if (EQ (keyword
, QCstrike_through
))
4534 value
= LFACE_STRIKE_THROUGH (lface
);
4535 else if (EQ (keyword
, QCbox
))
4536 value
= LFACE_BOX (lface
);
4537 else if (EQ (keyword
, QCinverse_video
)
4538 || EQ (keyword
, QCreverse_video
))
4539 value
= LFACE_INVERSE (lface
);
4540 else if (EQ (keyword
, QCforeground
))
4541 value
= LFACE_FOREGROUND (lface
);
4542 else if (EQ (keyword
, QCbackground
))
4543 value
= LFACE_BACKGROUND (lface
);
4544 else if (EQ (keyword
, QCstipple
))
4545 value
= LFACE_STIPPLE (lface
);
4546 else if (EQ (keyword
, QCwidth
))
4547 value
= LFACE_SWIDTH (lface
);
4548 else if (EQ (keyword
, QCinherit
))
4549 value
= LFACE_INHERIT (lface
);
4550 else if (EQ (keyword
, QCfont
))
4551 value
= LFACE_FONT (lface
);
4553 signal_error ("Invalid face attribute name", keyword
);
4559 DEFUN ("internal-lisp-face-attribute-values",
4560 Finternal_lisp_face_attribute_values
,
4561 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4562 "Return a list of valid discrete values for face attribute ATTR.\n\
4563 Value is nil if ATTR doesn't have a discrete set of valid values.")
4567 Lisp_Object result
= Qnil
;
4569 CHECK_SYMBOL (attr
, 0);
4571 if (EQ (attr
, QCweight
)
4572 || EQ (attr
, QCslant
)
4573 || EQ (attr
, QCwidth
))
4575 /* Extract permissible symbols from tables. */
4576 struct table_entry
*table
;
4579 if (EQ (attr
, QCweight
))
4580 table
= weight_table
, dim
= DIM (weight_table
);
4581 else if (EQ (attr
, QCslant
))
4582 table
= slant_table
, dim
= DIM (slant_table
);
4584 table
= swidth_table
, dim
= DIM (swidth_table
);
4586 for (i
= 0; i
< dim
; ++i
)
4588 Lisp_Object symbol
= *table
[i
].symbol
;
4589 Lisp_Object tail
= result
;
4592 && !EQ (XCAR (tail
), symbol
))
4596 result
= Fcons (symbol
, result
);
4599 else if (EQ (attr
, QCunderline
))
4600 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4601 else if (EQ (attr
, QCoverline
))
4602 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4603 else if (EQ (attr
, QCstrike_through
))
4604 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4605 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4606 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4612 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4613 Sinternal_merge_in_global_face
, 2, 2, 0,
4614 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4615 Default face attributes override any local face attributes.")
4617 Lisp_Object face
, frame
;
4620 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4622 CHECK_LIVE_FRAME (frame
, 1);
4623 global_lface
= lface_from_face_name (NULL
, face
, 1);
4624 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4625 if (NILP (local_lface
))
4626 local_lface
= Finternal_make_lisp_face (face
, frame
);
4628 /* Make every specified global attribute override the local one.
4629 BEWARE!! This is only used from `face-set-after-frame-default' where
4630 the local frame is defined from default specs in `face-defface-spec'
4631 and those should be overridden by global settings. Hence the strange
4632 "global before local" priority. */
4633 lvec
= XVECTOR (local_lface
)->contents
;
4634 gvec
= XVECTOR (global_lface
)->contents
;
4635 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4636 if (! UNSPECIFIEDP (gvec
[i
]))
4643 /* The following function is implemented for compatibility with 20.2.
4644 The function is used in x-resolve-fonts when it is asked to
4645 return fonts with the same size as the font of a face. This is
4646 done in fontset.el. */
4648 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4649 "Return the font name of face FACE, or nil if it is unspecified.\n\
4650 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4651 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4652 The font default for a face is either nil, or a list\n\
4653 of the form (bold), (italic) or (bold italic).\n\
4654 If FRAME is omitted or nil, use the selected frame.")
4656 Lisp_Object face
, frame
;
4660 Lisp_Object result
= Qnil
;
4661 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4663 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4664 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4665 result
= Fcons (Qbold
, result
);
4667 if (!NILP (LFACE_SLANT (lface
))
4668 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4669 result
= Fcons (Qitalic
, result
);
4675 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4676 int face_id
= lookup_named_face (f
, face
, 0);
4677 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4678 return face
? build_string (face
->font_name
) : Qnil
;
4683 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4684 all attributes are `equal'. Tries to be fast because this function
4685 is called quite often. */
4688 lface_equal_p (v1
, v2
)
4689 Lisp_Object
*v1
, *v2
;
4693 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4695 Lisp_Object a
= v1
[i
];
4696 Lisp_Object b
= v2
[i
];
4698 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4699 and the other is specified. */
4700 equal_p
= XTYPE (a
) == XTYPE (b
);
4709 equal_p
= ((STRING_BYTES (XSTRING (a
))
4710 == STRING_BYTES (XSTRING (b
)))
4711 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4712 STRING_BYTES (XSTRING (a
))) == 0);
4721 equal_p
= !NILP (Fequal (a
, b
));
4731 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4732 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4733 "True if FACE1 and FACE2 are equal.\n\
4734 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4735 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4736 If FRAME is omitted or nil, use the selected frame.")
4737 (face1
, face2
, frame
)
4738 Lisp_Object face1
, face2
, frame
;
4742 Lisp_Object lface1
, lface2
;
4747 /* Don't use check_x_frame here because this function is called
4748 before X frames exist. At that time, if FRAME is nil,
4749 selected_frame will be used which is the frame dumped with
4750 Emacs. That frame is not an X frame. */
4751 f
= frame_or_selected_frame (frame
, 2);
4753 lface1
= lface_from_face_name (NULL
, face1
, 1);
4754 lface2
= lface_from_face_name (NULL
, face2
, 1);
4755 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4756 XVECTOR (lface2
)->contents
);
4757 return equal_p
? Qt
: Qnil
;
4761 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4762 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4763 "True if FACE has no attribute specified.\n\
4764 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4765 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4766 If FRAME is omitted or nil, use the selected frame.")
4768 Lisp_Object face
, frame
;
4775 frame
= selected_frame
;
4776 CHECK_LIVE_FRAME (frame
, 0);
4780 lface
= lface_from_face_name (NULL
, face
, 1);
4782 lface
= lface_from_face_name (f
, face
, 1);
4784 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4785 if (!UNSPECIFIEDP (AREF (lface
, i
)))
4788 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4792 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4794 "Return an alist of frame-local faces defined on FRAME.\n\
4795 For internal use only.")
4799 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4800 return f
->face_alist
;
4804 /* Return a hash code for Lisp string STRING with case ignored. Used
4805 below in computing a hash value for a Lisp face. */
4807 static INLINE
unsigned
4808 hash_string_case_insensitive (string
)
4813 xassert (STRINGP (string
));
4814 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4815 hash
= (hash
<< 1) ^ tolower (*s
);
4820 /* Return a hash code for face attribute vector V. */
4822 static INLINE
unsigned
4826 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4827 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4828 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4829 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4830 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4831 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4832 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4836 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4837 considering charsets/registries). They do if they specify the same
4838 family, point size, weight, width, slant, and fontset. Both LFACE1
4839 and LFACE2 must be fully-specified. */
4842 lface_same_font_attributes_p (lface1
, lface2
)
4843 Lisp_Object
*lface1
, *lface2
;
4845 xassert (lface_fully_specified_p (lface1
)
4846 && lface_fully_specified_p (lface2
));
4847 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4848 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4849 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4850 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4851 && EQ (lface1
[LFACE_AVGWIDTH_INDEX
], lface2
[LFACE_AVGWIDTH_INDEX
])
4852 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4853 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4854 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4855 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4856 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4857 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4858 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4863 /***********************************************************************
4865 ***********************************************************************/
4867 /* Allocate and return a new realized face for Lisp face attribute
4870 static struct face
*
4871 make_realized_face (attr
)
4874 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4875 bzero (face
, sizeof *face
);
4876 face
->ascii_face
= face
;
4877 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4882 /* Free realized face FACE, including its X resources. FACE may
4886 free_realized_face (f
, face
)
4892 #ifdef HAVE_WINDOW_SYSTEM
4893 if (FRAME_WINDOW_P (f
))
4895 /* Free fontset of FACE if it is ASCII face. */
4896 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4897 free_face_fontset (f
, face
);
4900 x_free_gc (f
, face
->gc
);
4904 free_face_colors (f
, face
);
4905 x_destroy_bitmap (f
, face
->stipple
);
4907 #endif /* HAVE_WINDOW_SYSTEM */
4914 /* Prepare face FACE for subsequent display on frame F. This
4915 allocated GCs if they haven't been allocated yet or have been freed
4916 by clearing the face cache. */
4919 prepare_face_for_display (f
, face
)
4923 #ifdef HAVE_WINDOW_SYSTEM
4924 xassert (FRAME_WINDOW_P (f
));
4929 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4931 xgcv
.foreground
= face
->foreground
;
4932 xgcv
.background
= face
->background
;
4933 #ifdef HAVE_X_WINDOWS
4934 xgcv
.graphics_exposures
= False
;
4936 /* The font of FACE may be null if we couldn't load it. */
4939 #ifdef HAVE_X_WINDOWS
4940 xgcv
.font
= face
->font
->fid
;
4943 xgcv
.font
= face
->font
;
4946 xgcv
.font
= face
->font
;
4952 #ifdef HAVE_X_WINDOWS
4955 xgcv
.fill_style
= FillOpaqueStippled
;
4956 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4957 mask
|= GCFillStyle
| GCStipple
;
4960 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4963 #endif /* HAVE_WINDOW_SYSTEM */
4967 /***********************************************************************
4969 ***********************************************************************/
4971 /* Return a new face cache for frame F. */
4973 static struct face_cache
*
4977 struct face_cache
*c
;
4980 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4981 bzero (c
, sizeof *c
);
4982 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4983 c
->buckets
= (struct face
**) xmalloc (size
);
4984 bzero (c
->buckets
, size
);
4986 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4988 c
->menu_face_changed_p
= menu_face_changed_default
;
4993 /* Clear out all graphics contexts for all realized faces, except for
4994 the basic faces. This should be done from time to time just to avoid
4995 keeping too many graphics contexts that are no longer needed. */
4999 struct face_cache
*c
;
5001 if (c
&& FRAME_WINDOW_P (c
->f
))
5003 #ifdef HAVE_WINDOW_SYSTEM
5005 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5007 struct face
*face
= c
->faces_by_id
[i
];
5008 if (face
&& face
->gc
)
5010 x_free_gc (c
->f
, face
->gc
);
5014 #endif /* HAVE_WINDOW_SYSTEM */
5019 /* Free all realized faces in face cache C, including basic faces. C
5020 may be null. If faces are freed, make sure the frame's current
5021 matrix is marked invalid, so that a display caused by an expose
5022 event doesn't try to use faces we destroyed. */
5025 free_realized_faces (c
)
5026 struct face_cache
*c
;
5031 struct frame
*f
= c
->f
;
5033 /* We must block input here because we can't process X events
5034 safely while only some faces are freed, or when the frame's
5035 current matrix still references freed faces. */
5038 for (i
= 0; i
< c
->used
; ++i
)
5040 free_realized_face (f
, c
->faces_by_id
[i
]);
5041 c
->faces_by_id
[i
] = NULL
;
5045 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5046 bzero (c
->buckets
, size
);
5048 /* Must do a thorough redisplay the next time. Mark current
5049 matrices as invalid because they will reference faces freed
5050 above. This function is also called when a frame is
5051 destroyed. In this case, the root window of F is nil. */
5052 if (WINDOWP (f
->root_window
))
5054 clear_current_matrices (f
);
5055 ++windows_or_buffers_changed
;
5063 /* Free all faces realized for multibyte characters on frame F that
5067 free_realized_multibyte_face (f
, fontset
)
5071 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5075 /* We must block input here because we can't process X events safely
5076 while only some faces are freed, or when the frame's current
5077 matrix still references freed faces. */
5080 for (i
= 0; i
< cache
->used
; i
++)
5082 face
= cache
->faces_by_id
[i
];
5084 && face
!= face
->ascii_face
5085 && face
->fontset
== fontset
)
5087 uncache_face (cache
, face
);
5088 free_realized_face (f
, face
);
5092 /* Must do a thorough redisplay the next time. Mark current
5093 matrices as invalid because they will reference faces freed
5094 above. This function is also called when a frame is destroyed.
5095 In this case, the root window of F is nil. */
5096 if (WINDOWP (f
->root_window
))
5098 clear_current_matrices (f
);
5099 ++windows_or_buffers_changed
;
5106 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5107 This is done after attributes of a named face have been changed,
5108 because we can't tell which realized faces depend on that face. */
5111 free_all_realized_faces (frame
)
5117 FOR_EACH_FRAME (rest
, frame
)
5118 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5121 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5125 /* Free face cache C and faces in it, including their X resources. */
5129 struct face_cache
*c
;
5133 free_realized_faces (c
);
5135 xfree (c
->faces_by_id
);
5141 /* Cache realized face FACE in face cache C. HASH is the hash value
5142 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5143 collision list of the face hash table of C. This is done because
5144 otherwise lookup_face would find FACE for every character, even if
5145 faces with the same attributes but for specific characters exist. */
5148 cache_face (c
, face
, hash
)
5149 struct face_cache
*c
;
5153 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5157 if (face
->fontset
>= 0)
5159 struct face
*last
= c
->buckets
[i
];
5170 c
->buckets
[i
] = face
;
5171 face
->prev
= face
->next
= NULL
;
5177 face
->next
= c
->buckets
[i
];
5179 face
->next
->prev
= face
;
5180 c
->buckets
[i
] = face
;
5183 /* Find a free slot in C->faces_by_id and use the index of the free
5184 slot as FACE->id. */
5185 for (i
= 0; i
< c
->used
; ++i
)
5186 if (c
->faces_by_id
[i
] == NULL
)
5190 /* Maybe enlarge C->faces_by_id. */
5191 if (i
== c
->used
&& c
->used
== c
->size
)
5193 int new_size
= 2 * c
->size
;
5194 int sz
= new_size
* sizeof *c
->faces_by_id
;
5195 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5200 /* Check that FACE got a unique id. */
5205 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5206 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5212 #endif /* GLYPH_DEBUG */
5214 c
->faces_by_id
[i
] = face
;
5220 /* Remove face FACE from cache C. */
5223 uncache_face (c
, face
)
5224 struct face_cache
*c
;
5227 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5230 face
->prev
->next
= face
->next
;
5232 c
->buckets
[i
] = face
->next
;
5235 face
->next
->prev
= face
->prev
;
5237 c
->faces_by_id
[face
->id
] = NULL
;
5238 if (face
->id
== c
->used
)
5243 /* Look up a realized face with face attributes ATTR in the face cache
5244 of frame F. The face will be used to display character C. Value
5245 is the ID of the face found. If no suitable face is found, realize
5246 a new one. In that case, if C is a multibyte character, BASE_FACE
5247 is a face that has the same attributes. */
5250 lookup_face (f
, attr
, c
, base_face
)
5254 struct face
*base_face
;
5256 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5261 xassert (cache
!= NULL
);
5262 check_lface_attrs (attr
);
5264 /* Look up ATTR in the face cache. */
5265 hash
= lface_hash (attr
);
5266 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5268 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5269 if (face
->hash
== hash
5270 && (!FRAME_WINDOW_P (f
)
5271 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5272 && lface_equal_p (face
->lface
, attr
))
5275 /* If not found, realize a new face. */
5277 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5280 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5282 /* When this function is called from face_for_char (in this case, C is
5283 a multibyte character), a fontset of a face returned by
5284 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5285 C) is not sutisfied. The fontset is set for this face by
5286 face_for_char later. */
5288 if (FRAME_WINDOW_P (f
))
5289 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5291 #endif /* GLYPH_DEBUG */
5297 /* Return the face id of the realized face for named face SYMBOL on
5298 frame F suitable for displaying character C. Value is -1 if the
5299 face couldn't be determined, which might happen if the default face
5300 isn't realized and cannot be realized. */
5303 lookup_named_face (f
, symbol
, c
)
5308 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5309 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5310 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5312 if (default_face
== NULL
)
5314 if (!realize_basic_faces (f
))
5316 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5319 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5320 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5321 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5322 return lookup_face (f
, attrs
, c
, NULL
);
5326 /* Return the ID of the realized ASCII face of Lisp face with ID
5327 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5330 ascii_face_of_lisp_face (f
, lface_id
)
5336 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5338 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5339 face_id
= lookup_named_face (f
, face_name
, 0);
5348 /* Return a face for charset ASCII that is like the face with id
5349 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5350 STEPS < 0 means larger. Value is the id of the face. */
5353 smaller_face (f
, face_id
, steps
)
5357 #ifdef HAVE_WINDOW_SYSTEM
5359 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5360 int pt
, last_pt
, last_height
;
5363 struct face
*new_face
;
5365 /* If not called for an X frame, just return the original face. */
5366 if (FRAME_TERMCAP_P (f
))
5369 /* Try in increments of 1/2 pt. */
5370 delta
= steps
< 0 ? 5 : -5;
5371 steps
= abs (steps
);
5373 face
= FACE_FROM_ID (f
, face_id
);
5374 bcopy (face
->lface
, attrs
, sizeof attrs
);
5375 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5376 new_face_id
= face_id
;
5377 last_height
= FONT_HEIGHT (face
->font
);
5381 /* Give up if we cannot find a font within 10pt. */
5382 && abs (last_pt
- pt
) < 100)
5384 /* Look up a face for a slightly smaller/larger font. */
5386 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5387 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5388 new_face
= FACE_FROM_ID (f
, new_face_id
);
5390 /* If height changes, count that as one step. */
5391 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5392 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5395 last_height
= FONT_HEIGHT (new_face
->font
);
5402 #else /* not HAVE_WINDOW_SYSTEM */
5406 #endif /* not HAVE_WINDOW_SYSTEM */
5410 /* Return a face for charset ASCII that is like the face with id
5411 FACE_ID on frame F, but has height HEIGHT. */
5414 face_with_height (f
, face_id
, height
)
5419 #ifdef HAVE_WINDOW_SYSTEM
5421 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5423 if (FRAME_TERMCAP_P (f
)
5427 face
= FACE_FROM_ID (f
, face_id
);
5428 bcopy (face
->lface
, attrs
, sizeof attrs
);
5429 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5430 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5431 #endif /* HAVE_WINDOW_SYSTEM */
5437 /* Return the face id of the realized face for named face SYMBOL on
5438 frame F suitable for displaying character C, and use attributes of
5439 the face FACE_ID for attributes that aren't completely specified by
5440 SYMBOL. This is like lookup_named_face, except that the default
5441 attributes come from FACE_ID, not from the default face. FACE_ID
5442 is assumed to be already realized. */
5445 lookup_derived_face (f
, symbol
, c
, face_id
)
5451 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5452 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5453 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5458 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5459 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5460 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5461 return lookup_face (f
, attrs
, c
, default_face
);
5466 /***********************************************************************
5468 ***********************************************************************/
5470 DEFUN ("internal-set-font-selection-order",
5471 Finternal_set_font_selection_order
,
5472 Sinternal_set_font_selection_order
, 1, 1, 0,
5473 "Set font selection order for face font selection to ORDER.\n\
5474 ORDER must be a list of length 4 containing the symbols `:width',\n\
5475 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5476 first in ORDER are matched first, e.g. if `:height' appears before\n\
5477 `:weight' in ORDER, font selection first tries to find a font with\n\
5478 a suitable height, and then tries to match the font weight.\n\
5485 int indices
[DIM (font_sort_order
)];
5487 CHECK_LIST (order
, 0);
5488 bzero (indices
, sizeof indices
);
5492 CONSP (list
) && i
< DIM (indices
);
5493 list
= XCDR (list
), ++i
)
5495 Lisp_Object attr
= XCAR (list
);
5498 if (EQ (attr
, QCwidth
))
5500 else if (EQ (attr
, QCheight
))
5501 xlfd
= XLFD_POINT_SIZE
;
5502 else if (EQ (attr
, QCweight
))
5504 else if (EQ (attr
, QCslant
))
5509 if (indices
[i
] != 0)
5514 if (!NILP (list
) || i
!= DIM (indices
))
5515 signal_error ("Invalid font sort order", order
);
5516 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5517 if (indices
[i
] == 0)
5518 signal_error ("Invalid font sort order", order
);
5520 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5522 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5523 free_all_realized_faces (Qnil
);
5530 DEFUN ("internal-set-alternative-font-family-alist",
5531 Finternal_set_alternative_font_family_alist
,
5532 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5533 "Define alternative font families to try in face font selection.\n\
5534 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5535 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5536 be found. Value is ALIST.")
5540 CHECK_LIST (alist
, 0);
5541 Vface_alternative_font_family_alist
= alist
;
5542 free_all_realized_faces (Qnil
);
5547 DEFUN ("internal-set-alternative-font-registry-alist",
5548 Finternal_set_alternative_font_registry_alist
,
5549 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5550 "Define alternative font registries to try in face font selection.\n\
5551 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5552 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5553 be found. Value is ALIST.")
5557 CHECK_LIST (alist
, 0);
5558 Vface_alternative_font_registry_alist
= alist
;
5559 free_all_realized_faces (Qnil
);
5564 #ifdef HAVE_WINDOW_SYSTEM
5566 /* Value is non-zero if FONT is the name of a scalable font. The
5567 X11R6 XLFD spec says that point size, pixel size, and average width
5568 are zero for scalable fonts. Intlfonts contain at least one
5569 scalable font ("*-muleindian-1") for which this isn't true, so we
5570 just test average width. */
5573 font_scalable_p (font
)
5574 struct font_name
*font
;
5576 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5577 return (*s
== '0' && *(s
+ 1) == '\0')
5579 /* Windows implementation of XLFD is slightly broken for backward
5580 compatibility with previous broken versions, so test for
5581 wildcards as well as 0. */
5588 /* Ignore the difference of font point size less than this value. */
5590 #define FONT_POINT_SIZE_QUANTUM 5
5592 /* Value is non-zero if FONT1 is a better match for font attributes
5593 VALUES than FONT2. VALUES is an array of face attribute values in
5594 font sort order. COMPARE_PT_P zero means don't compare point
5595 sizes. AVGWIDTH, if not zero, is a specified font average width
5599 better_font_p (values
, font1
, font2
, compare_pt_p
, avgwidth
)
5601 struct font_name
*font1
, *font2
;
5602 int compare_pt_p
, avgwidth
;
5606 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5608 int xlfd_idx
= font_sort_order
[i
];
5610 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5612 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5613 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5615 if (xlfd_idx
== XLFD_POINT_SIZE
5616 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5618 if (delta1
> delta2
)
5620 else if (delta1
< delta2
)
5624 /* The difference may be equal because, e.g., the face
5625 specifies `italic' but we have only `regular' and
5626 `oblique'. Prefer `oblique' in this case. */
5627 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5628 && font1
->numeric
[xlfd_idx
] > values
[i
]
5629 && font2
->numeric
[xlfd_idx
] < values
[i
])
5637 int delta1
= abs (avgwidth
- font1
->numeric
[XLFD_AVGWIDTH
]);
5638 int delta2
= abs (avgwidth
- font2
->numeric
[XLFD_AVGWIDTH
]);
5639 if (delta1
> delta2
)
5641 else if (delta1
< delta2
)
5645 return font1
->registry_priority
< font2
->registry_priority
;
5649 /* Value is non-zero if FONT is an exact match for face attributes in
5650 SPECIFIED. SPECIFIED is an array of face attribute values in font
5651 sort order. AVGWIDTH, if non-zero, is an average width to compare
5655 exact_face_match_p (specified
, font
, avgwidth
)
5657 struct font_name
*font
;
5662 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5663 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5666 return (i
== DIM (font_sort_order
)
5668 || avgwidth
== font
->numeric
[XLFD_AVGWIDTH
]));
5672 /* Value is the name of a scaled font, generated from scalable font
5673 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5674 Value is allocated from heap. */
5677 build_scalable_font_name (f
, font
, specified_pt
)
5679 struct font_name
*font
;
5682 char point_size
[20], pixel_size
[20];
5684 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5687 /* If scalable font is for a specific resolution, compute
5688 the point size we must specify from the resolution of
5689 the display and the specified resolution of the font. */
5690 if (font
->numeric
[XLFD_RESY
] != 0)
5692 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5693 pixel_value
= font
->numeric
[XLFD_RESY
] / (PT_PER_INCH
* 10.0) * pt
;
5698 pixel_value
= resy
/ (PT_PER_INCH
* 10.0) * pt
;
5701 /* Set point size of the font. */
5702 sprintf (point_size
, "%d", (int) pt
);
5703 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5704 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5706 /* Set pixel size. */
5707 sprintf (pixel_size
, "%d", pixel_value
);
5708 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5709 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5711 /* If font doesn't specify its resolution, use the
5712 resolution of the display. */
5713 if (font
->numeric
[XLFD_RESY
] == 0)
5716 sprintf (buffer
, "%d", (int) resy
);
5717 font
->fields
[XLFD_RESY
] = buffer
;
5718 font
->numeric
[XLFD_RESY
] = resy
;
5721 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5724 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5725 sprintf (buffer
, "%d", resx
);
5726 font
->fields
[XLFD_RESX
] = buffer
;
5727 font
->numeric
[XLFD_RESX
] = resx
;
5730 return build_font_name (font
);
5734 /* Value is non-zero if we are allowed to use scalable font FONT. We
5735 can't run a Lisp function here since this function may be called
5736 with input blocked. */
5739 may_use_scalable_font_p (font
)
5742 if (EQ (Vscalable_fonts_allowed
, Qt
))
5744 else if (CONSP (Vscalable_fonts_allowed
))
5746 Lisp_Object tail
, regexp
;
5748 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5750 regexp
= XCAR (tail
);
5751 if (STRINGP (regexp
)
5752 && fast_c_string_match_ignore_case (regexp
, font
) >= 0)
5762 /* Return the name of the best matching font for face attributes ATTRS
5763 in the array of font_name structures FONTS which contains NFONTS
5764 elements. WIDTH_RATIO is a factor with which to multiply average
5765 widths if ATTRS specifies such a width.
5767 Value is a font name which is allocated from the heap. FONTS is
5768 freed by this function. */
5771 best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
)
5774 struct font_name
*fonts
;
5779 struct font_name
*best
;
5782 int exact_p
, avgwidth
;
5787 /* Make specified font attributes available in `specified',
5788 indexed by sort order. */
5789 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5791 int xlfd_idx
= font_sort_order
[i
];
5793 if (xlfd_idx
== XLFD_SWIDTH
)
5794 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5795 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5796 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5797 else if (xlfd_idx
== XLFD_WEIGHT
)
5798 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5799 else if (xlfd_idx
== XLFD_SLANT
)
5800 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5805 avgwidth
= (UNSPECIFIEDP (attrs
[LFACE_AVGWIDTH_INDEX
])
5807 : XFASTINT (attrs
[LFACE_AVGWIDTH_INDEX
]) * width_ratio
);
5811 /* Start with the first non-scalable font in the list. */
5812 for (i
= 0; i
< nfonts
; ++i
)
5813 if (!font_scalable_p (fonts
+ i
))
5816 /* Find the best match among the non-scalable fonts. */
5821 for (i
= 1; i
< nfonts
; ++i
)
5822 if (!font_scalable_p (fonts
+ i
)
5823 && better_font_p (specified
, fonts
+ i
, best
, 1, avgwidth
))
5827 exact_p
= exact_face_match_p (specified
, best
, avgwidth
);
5836 /* Unless we found an exact match among non-scalable fonts, see if
5837 we can find a better match among scalable fonts. */
5840 /* A scalable font is better if
5842 1. its weight, slant, swidth attributes are better, or.
5844 2. the best non-scalable font doesn't have the required
5845 point size, and the scalable fonts weight, slant, swidth
5848 int non_scalable_has_exact_height_p
;
5850 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5851 non_scalable_has_exact_height_p
= 1;
5853 non_scalable_has_exact_height_p
= 0;
5855 for (i
= 0; i
< nfonts
; ++i
)
5856 if (font_scalable_p (fonts
+ i
))
5859 || better_font_p (specified
, fonts
+ i
, best
, 0, 0)
5860 || (!non_scalable_has_exact_height_p
5861 && !better_font_p (specified
, best
, fonts
+ i
, 0, 0)))
5866 if (font_scalable_p (best
))
5867 font_name
= build_scalable_font_name (f
, best
, pt
);
5869 font_name
= build_font_name (best
);
5871 /* Free font_name structures. */
5872 free_font_names (fonts
, nfonts
);
5878 /* Get a list of matching fonts on frame F, considering FAMILY
5879 and alternative font families from Vface_alternative_font_registry_alist.
5881 FAMILY is the font family whose alternatives are considered.
5883 REGISTRY, if a string, specifies a font registry and encoding to
5884 match. A value of nil means include fonts of any registry and
5887 Return in *FONTS a pointer to a vector of font_name structures for
5888 the fonts matched. Value is the number of fonts found. */
5891 try_alternative_families (f
, family
, registry
, fonts
)
5893 Lisp_Object family
, registry
;
5894 struct font_name
**fonts
;
5899 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5902 /* Try alternative font families. */
5903 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5906 for (alter
= XCDR (alter
);
5907 CONSP (alter
) && nfonts
== 0;
5908 alter
= XCDR (alter
))
5910 if (STRINGP (XCAR (alter
)))
5911 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5915 /* Try scalable fonts before giving up. */
5916 if (nfonts
== 0 && NILP (Vscalable_fonts_allowed
))
5918 int count
= BINDING_STACK_SIZE ();
5919 specbind (Qscalable_fonts_allowed
, Qt
);
5920 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5921 unbind_to (count
, Qnil
);
5928 /* Get a list of matching fonts on frame F.
5930 FAMILY, if a string, specifies a font family derived from the fontset.
5931 It is only used if the face does not specify any family in ATTRS or
5932 if we cannot find any font of the face's family.
5934 REGISTRY, if a string, specifies a font registry and encoding to
5935 match. A value of nil means include fonts of any registry and
5938 Return in *FONTS a pointer to a vector of font_name structures for
5939 the fonts matched. Value is the number of fonts found. */
5942 try_font_list (f
, attrs
, family
, registry
, fonts
)
5945 Lisp_Object family
, registry
;
5946 struct font_name
**fonts
;
5949 Lisp_Object face_family
= attrs
[LFACE_FAMILY_INDEX
];
5951 if (STRINGP (face_family
))
5952 nfonts
= try_alternative_families (f
, face_family
, registry
, fonts
);
5954 if (nfonts
== 0 && !NILP (family
))
5955 nfonts
= try_alternative_families (f
, family
, registry
, fonts
);
5957 /* Try font family of the default face or "fixed". */
5960 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5962 family
= default_face
->lface
[LFACE_FAMILY_INDEX
];
5964 family
= build_string ("fixed");
5965 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5968 /* Try any family with the given registry. */
5970 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5976 /* Return the fontset id of the base fontset name or alias name given
5977 by the fontset attribute of ATTRS. Value is -1 if the fontset
5978 attribute of ATTRS doesn't name a fontset. */
5981 face_fontset (attrs
)
5986 name
= attrs
[LFACE_FONT_INDEX
];
5987 if (!STRINGP (name
))
5989 return fs_query_fontset (name
, 0);
5993 /* Choose a name of font to use on frame F to display character C with
5994 Lisp face attributes specified by ATTRS. The font name is
5995 determined by the font-related attributes in ATTRS and the name
5996 pattern for C in FONTSET. Value is the font name which is
5997 allocated from the heap and must be freed by the caller, or NULL if
5998 we can get no information about the font name of C. It is assured
5999 that we always get some information for a single byte
6003 choose_face_font (f
, attrs
, fontset
, c
)
6008 Lisp_Object pattern
;
6009 char *font_name
= NULL
;
6010 struct font_name
*fonts
;
6011 int nfonts
, width_ratio
;
6013 /* Get (foundry and) family name and registry (and encoding) name of
6015 pattern
= fontset_font_pattern (f
, fontset
, c
);
6018 xassert (!SINGLE_BYTE_CHAR_P (c
));
6022 /* If what we got is a name pattern, return it. */
6023 if (STRINGP (pattern
))
6024 return xstrdup (XSTRING (pattern
)->data
);
6026 /* Get a list of fonts matching that pattern and choose the
6027 best match for the specified face attributes from it. */
6028 nfonts
= try_font_list (f
, attrs
, XCAR (pattern
), XCDR (pattern
), &fonts
);
6029 width_ratio
= (SINGLE_BYTE_CHAR_P (c
)
6031 : CHARSET_WIDTH (CHAR_CHARSET (c
)));
6032 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
, width_ratio
);
6036 #endif /* HAVE_WINDOW_SYSTEM */
6040 /***********************************************************************
6042 ***********************************************************************/
6044 /* Realize basic faces on frame F. Value is zero if frame parameters
6045 of F don't contain enough information needed to realize the default
6049 realize_basic_faces (f
)
6053 int count
= BINDING_STACK_SIZE ();
6055 /* Block input here so that we won't be surprised by an X expose
6056 event, for instance, without having the faces set up. */
6058 specbind (Qscalable_fonts_allowed
, Qt
);
6060 if (realize_default_face (f
))
6062 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6063 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6064 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6065 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6066 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6067 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6068 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6069 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6070 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6072 /* Reflect changes in the `menu' face in menu bars. */
6073 if (FRAME_FACE_CACHE (f
)->menu_face_changed_p
)
6075 FRAME_FACE_CACHE (f
)->menu_face_changed_p
= 0;
6076 #ifdef USE_X_TOOLKIT
6077 x_update_menu_appearance (f
);
6084 unbind_to (count
, Qnil
);
6090 /* Realize the default face on frame F. If the face is not fully
6091 specified, make it fully-specified. Attributes of the default face
6092 that are not explicitly specified are taken from frame parameters. */
6095 realize_default_face (f
)
6098 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6100 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6101 Lisp_Object frame_font
;
6104 /* If the `default' face is not yet known, create it. */
6105 lface
= lface_from_face_name (f
, Qdefault
, 0);
6109 XSETFRAME (frame
, f
);
6110 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6113 #ifdef HAVE_WINDOW_SYSTEM
6114 if (FRAME_WINDOW_P (f
))
6116 /* Set frame_font to the value of the `font' frame parameter. */
6117 frame_font
= Fassq (Qfont
, f
->param_alist
);
6118 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6119 frame_font
= XCDR (frame_font
);
6120 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6122 #endif /* HAVE_WINDOW_SYSTEM */
6124 if (!FRAME_WINDOW_P (f
))
6126 LFACE_FAMILY (lface
) = build_string ("default");
6127 LFACE_SWIDTH (lface
) = Qnormal
;
6128 LFACE_HEIGHT (lface
) = make_number (1);
6129 LFACE_WEIGHT (lface
) = Qnormal
;
6130 LFACE_SLANT (lface
) = Qnormal
;
6131 LFACE_AVGWIDTH (lface
) = Qunspecified
;
6134 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6135 LFACE_UNDERLINE (lface
) = Qnil
;
6137 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6138 LFACE_OVERLINE (lface
) = Qnil
;
6140 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6141 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6143 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6144 LFACE_BOX (lface
) = Qnil
;
6146 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6147 LFACE_INVERSE (lface
) = Qnil
;
6149 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6151 /* This function is called so early that colors are not yet
6152 set in the frame parameter list. */
6153 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6155 if (CONSP (color
) && STRINGP (XCDR (color
)))
6156 LFACE_FOREGROUND (lface
) = XCDR (color
);
6157 else if (FRAME_WINDOW_P (f
))
6159 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6160 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6165 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6167 /* This function is called so early that colors are not yet
6168 set in the frame parameter list. */
6169 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6170 if (CONSP (color
) && STRINGP (XCDR (color
)))
6171 LFACE_BACKGROUND (lface
) = XCDR (color
);
6172 else if (FRAME_WINDOW_P (f
))
6174 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6175 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6180 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6181 LFACE_STIPPLE (lface
) = Qnil
;
6183 /* Realize the face; it must be fully-specified now. */
6184 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6185 check_lface (lface
);
6186 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6187 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6192 /* Realize basic faces other than the default face in face cache C.
6193 SYMBOL is the face name, ID is the face id the realized face must
6194 have. The default face must have been realized already. */
6197 realize_named_face (f
, symbol
, id
)
6202 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6203 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6204 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6205 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6206 struct face
*new_face
;
6208 /* The default face must exist and be fully specified. */
6209 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6210 check_lface_attrs (attrs
);
6211 xassert (lface_fully_specified_p (attrs
));
6213 /* If SYMBOL isn't know as a face, create it. */
6217 XSETFRAME (frame
, f
);
6218 lface
= Finternal_make_lisp_face (symbol
, frame
);
6221 /* Merge SYMBOL's face with the default face. */
6222 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6223 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6225 /* Realize the face. */
6226 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6230 /* Realize the fully-specified face with attributes ATTRS in face
6231 cache CACHE for character C. If C is a multibyte character,
6232 BASE_FACE is a face that has the same attributes. Otherwise,
6233 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6234 ID of face to remove before caching the new face. Value is a
6235 pointer to the newly created realized face. */
6237 static struct face
*
6238 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6239 struct face_cache
*cache
;
6242 struct face
*base_face
;
6247 /* LFACE must be fully specified. */
6248 xassert (cache
!= NULL
);
6249 check_lface_attrs (attrs
);
6251 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6253 /* Remove the former face. */
6254 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6255 uncache_face (cache
, former_face
);
6256 free_realized_face (cache
->f
, former_face
);
6259 if (FRAME_WINDOW_P (cache
->f
))
6260 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6261 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6262 face
= realize_tty_face (cache
, attrs
, c
);
6266 /* Insert the new face. */
6267 cache_face (cache
, face
, lface_hash (attrs
));
6268 #ifdef HAVE_WINDOW_SYSTEM
6269 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6270 load_face_font (cache
->f
, face
, c
);
6271 #endif /* HAVE_WINDOW_SYSTEM */
6276 /* Realize the fully-specified face with attributes ATTRS in face
6277 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6278 a multibyte character, BASE_FACE is a face that has the same
6279 attributes. Otherwise, BASE_FACE is ignored. If the new face
6280 doesn't share font with the default face, a fontname is allocated
6281 from the heap and set in `font_name' of the new face, but it is not
6282 yet loaded here. Value is a pointer to the newly created realized
6285 static struct face
*
6286 realize_x_face (cache
, attrs
, c
, base_face
)
6287 struct face_cache
*cache
;
6290 struct face
*base_face
;
6292 #ifdef HAVE_WINDOW_SYSTEM
6293 struct face
*face
, *default_face
;
6295 Lisp_Object stipple
, overline
, strike_through
, box
;
6297 xassert (FRAME_WINDOW_P (cache
->f
));
6298 xassert (SINGLE_BYTE_CHAR_P (c
)
6301 /* Allocate a new realized face. */
6302 face
= make_realized_face (attrs
);
6306 /* If C is a multibyte character, we share all face attirbutes with
6307 BASE_FACE including the realized fontset. But, we must load a
6309 if (!SINGLE_BYTE_CHAR_P (c
))
6311 bcopy (base_face
, face
, sizeof *face
);
6314 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6315 face
->foreground_defaulted_p
= 1;
6316 face
->background_defaulted_p
= 1;
6317 face
->underline_defaulted_p
= 1;
6318 face
->overline_color_defaulted_p
= 1;
6319 face
->strike_through_color_defaulted_p
= 1;
6320 face
->box_color_defaulted_p
= 1;
6322 /* to force realize_face to load font */
6327 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6329 /* Determine the font to use. Most of the time, the font will be
6330 the same as the font of the default face, so try that first. */
6331 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6333 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6334 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6336 face
->font
= default_face
->font
;
6337 face
->fontset
= default_face
->fontset
;
6338 face
->font_info_id
= default_face
->font_info_id
;
6339 face
->font_name
= default_face
->font_name
;
6340 face
->ascii_face
= face
;
6342 /* But, as we can't share the fontset, make a new realized
6343 fontset that has the same base fontset as of the default
6346 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6350 /* If the face attribute ATTRS specifies a fontset, use it as
6351 the base of a new realized fontset. Otherwise, use the same
6352 base fontset as of the default face. The base determines
6353 registry and encoding of a font. It may also determine
6354 foundry and family. The other fields of font name pattern
6355 are constructed from ATTRS. */
6356 int fontset
= face_fontset (attrs
);
6358 if ((fontset
== -1) && default_face
)
6359 fontset
= default_face
->fontset
;
6360 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6361 face
->font
= NULL
; /* to force realize_face to load font */
6364 /* Load the font if it is specified in ATTRS. This fixes
6365 changing frame font on the Mac. */
6366 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6368 struct font_info
*font_info
=
6369 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6371 face
->font
= font_info
->font
;
6376 /* Load colors, and set remaining attributes. */
6378 load_face_colors (f
, face
, attrs
);
6381 box
= attrs
[LFACE_BOX_INDEX
];
6384 /* A simple box of line width 1 drawn in color given by
6386 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6388 face
->box
= FACE_SIMPLE_BOX
;
6389 face
->box_line_width
= 1;
6391 else if (INTEGERP (box
))
6393 /* Simple box of specified line width in foreground color of the
6395 xassert (XINT (box
) != 0);
6396 face
->box
= FACE_SIMPLE_BOX
;
6397 face
->box_line_width
= XINT (box
);
6398 face
->box_color
= face
->foreground
;
6399 face
->box_color_defaulted_p
= 1;
6401 else if (CONSP (box
))
6403 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6404 being one of `raised' or `sunken'. */
6405 face
->box
= FACE_SIMPLE_BOX
;
6406 face
->box_color
= face
->foreground
;
6407 face
->box_color_defaulted_p
= 1;
6408 face
->box_line_width
= 1;
6412 Lisp_Object keyword
, value
;
6414 keyword
= XCAR (box
);
6422 if (EQ (keyword
, QCline_width
))
6424 if (INTEGERP (value
) && XINT (value
) != 0)
6425 face
->box_line_width
= XINT (value
);
6427 else if (EQ (keyword
, QCcolor
))
6429 if (STRINGP (value
))
6431 face
->box_color
= load_color (f
, face
, value
,
6433 face
->use_box_color_for_shadows_p
= 1;
6436 else if (EQ (keyword
, QCstyle
))
6438 if (EQ (value
, Qreleased_button
))
6439 face
->box
= FACE_RAISED_BOX
;
6440 else if (EQ (value
, Qpressed_button
))
6441 face
->box
= FACE_SUNKEN_BOX
;
6446 /* Text underline, overline, strike-through. */
6448 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6450 /* Use default color (same as foreground color). */
6451 face
->underline_p
= 1;
6452 face
->underline_defaulted_p
= 1;
6453 face
->underline_color
= 0;
6455 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6457 /* Use specified color. */
6458 face
->underline_p
= 1;
6459 face
->underline_defaulted_p
= 0;
6460 face
->underline_color
6461 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6462 LFACE_UNDERLINE_INDEX
);
6464 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6466 face
->underline_p
= 0;
6467 face
->underline_defaulted_p
= 0;
6468 face
->underline_color
= 0;
6471 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6472 if (STRINGP (overline
))
6474 face
->overline_color
6475 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6476 LFACE_OVERLINE_INDEX
);
6477 face
->overline_p
= 1;
6479 else if (EQ (overline
, Qt
))
6481 face
->overline_color
= face
->foreground
;
6482 face
->overline_color_defaulted_p
= 1;
6483 face
->overline_p
= 1;
6486 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6487 if (STRINGP (strike_through
))
6489 face
->strike_through_color
6490 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6491 LFACE_STRIKE_THROUGH_INDEX
);
6492 face
->strike_through_p
= 1;
6494 else if (EQ (strike_through
, Qt
))
6496 face
->strike_through_color
= face
->foreground
;
6497 face
->strike_through_color_defaulted_p
= 1;
6498 face
->strike_through_p
= 1;
6501 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6502 if (!NILP (stipple
))
6503 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6505 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6507 #endif /* HAVE_WINDOW_SYSTEM */
6511 /* Map a specified color of face FACE on frame F to a tty color index.
6512 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6513 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6514 default foreground/background colors. */
6517 map_tty_color (f
, face
, idx
, defaulted
)
6520 enum lface_attribute_index idx
;
6523 Lisp_Object frame
, color
, def
;
6524 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6525 unsigned long default_pixel
, default_other_pixel
, pixel
;
6527 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6531 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6532 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6536 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6537 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6540 XSETFRAME (frame
, f
);
6541 color
= face
->lface
[idx
];
6544 && XSTRING (color
)->size
6545 && CONSP (Vtty_defined_color_alist
)
6546 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6549 /* Associations in tty-defined-color-alist are of the form
6550 (NAME INDEX R G B). We need the INDEX part. */
6551 pixel
= XINT (XCAR (XCDR (def
)));
6554 if (pixel
== default_pixel
&& STRINGP (color
))
6556 pixel
= load_color (f
, face
, color
, idx
);
6558 #if defined (MSDOS) || defined (WINDOWSNT)
6559 /* If the foreground of the default face is the default color,
6560 use the foreground color defined by the frame. */
6562 if (FRAME_MSDOS_P (f
))
6565 if (pixel
== default_pixel
6566 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6569 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6571 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6572 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6575 else if (pixel
== default_other_pixel
)
6578 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6580 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6581 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6587 #endif /* MSDOS or WINDOWSNT */
6591 face
->foreground
= pixel
;
6593 face
->background
= pixel
;
6597 /* Realize the fully-specified face with attributes ATTRS in face
6598 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6599 pointer to the newly created realized face. */
6601 static struct face
*
6602 realize_tty_face (cache
, attrs
, c
)
6603 struct face_cache
*cache
;
6609 int face_colors_defaulted
= 0;
6610 struct frame
*f
= cache
->f
;
6612 /* Frame must be a termcap frame. */
6613 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6615 /* Allocate a new realized face. */
6616 face
= make_realized_face (attrs
);
6617 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6619 /* Map face attributes to TTY appearances. We map slant to
6620 dimmed text because we want italic text to appear differently
6621 and because dimmed text is probably used infrequently. */
6622 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6623 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6625 if (weight
> XLFD_WEIGHT_MEDIUM
)
6626 face
->tty_bold_p
= 1;
6627 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6628 face
->tty_dim_p
= 1;
6629 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6630 face
->tty_underline_p
= 1;
6631 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6632 face
->tty_reverse_p
= 1;
6634 /* Map color names to color indices. */
6635 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6636 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6638 /* Swap colors if face is inverse-video. If the colors are taken
6639 from the frame colors, they are already inverted, since the
6640 frame-creation function calls x-handle-reverse-video. */
6641 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6643 unsigned long tem
= face
->foreground
;
6644 face
->foreground
= face
->background
;
6645 face
->background
= tem
;
6648 if (tty_suppress_bold_inverse_default_colors_p
6650 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6651 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6652 face
->tty_bold_p
= 0;
6658 DEFUN ("tty-suppress-bold-inverse-default-colors",
6659 Ftty_suppress_bold_inverse_default_colors
,
6660 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6661 "Suppress/allow boldness of faces with inverse default colors.\n\
6662 SUPPRESS non-nil means suppress it.\n\
6663 This affects bold faces on TTYs whose foreground is the default background\n\
6664 color of the display and whose background is the default foreground color.\n\
6665 For such faces, the bold face attribute is ignored if this variable\n\
6668 Lisp_Object suppress
;
6670 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6671 ++face_change_count
;
6677 /***********************************************************************
6679 ***********************************************************************/
6681 /* Return the ID of the face to use to display character CH with face
6682 property PROP on frame F in current_buffer. */
6685 compute_char_face (f
, ch
, prop
)
6692 if (NILP (current_buffer
->enable_multibyte_characters
))
6697 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6698 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6702 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6703 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6704 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6705 merge_face_vector_with_property (f
, attrs
, prop
);
6706 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6713 /* Return the face ID associated with buffer position POS for
6714 displaying ASCII characters. Return in *ENDPTR the position at
6715 which a different face is needed, as far as text properties and
6716 overlays are concerned. W is a window displaying current_buffer.
6718 REGION_BEG, REGION_END delimit the region, so it can be
6721 LIMIT is a position not to scan beyond. That is to limit the time
6722 this function can take.
6724 If MOUSE is non-zero, use the character's mouse-face, not its face.
6726 The face returned is suitable for displaying ASCII characters. */
6729 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6730 endptr
, limit
, mouse
)
6733 int region_beg
, region_end
;
6738 struct frame
*f
= XFRAME (w
->frame
);
6739 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6740 Lisp_Object prop
, position
;
6742 Lisp_Object
*overlay_vec
;
6745 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6746 Lisp_Object limit1
, end
;
6747 struct face
*default_face
;
6749 /* W must display the current buffer. We could write this function
6750 to use the frame and buffer of W, but right now it doesn't. */
6751 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6753 XSETFRAME (frame
, f
);
6754 XSETFASTINT (position
, pos
);
6757 if (pos
< region_beg
&& region_beg
< endpos
)
6758 endpos
= region_beg
;
6760 /* Get the `face' or `mouse_face' text property at POS, and
6761 determine the next position at which the property changes. */
6762 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6763 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6764 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6766 endpos
= XINT (end
);
6768 /* Look at properties from overlays. */
6773 /* First try with room for 40 overlays. */
6775 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6776 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6777 &next_overlay
, NULL
, 0);
6779 /* If there are more than 40, make enough space for all, and try
6781 if (noverlays
> len
)
6784 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6785 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6786 &next_overlay
, NULL
, 0);
6789 if (next_overlay
< endpos
)
6790 endpos
= next_overlay
;
6795 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6797 /* Optimize common cases where we can use the default face. */
6800 && !(pos
>= region_beg
&& pos
< region_end
))
6801 return DEFAULT_FACE_ID
;
6803 /* Begin with attributes from the default face. */
6804 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6806 /* Merge in attributes specified via text properties. */
6808 merge_face_vector_with_property (f
, attrs
, prop
);
6810 /* Now merge the overlay data. */
6811 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6812 for (i
= 0; i
< noverlays
; i
++)
6817 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6819 merge_face_vector_with_property (f
, attrs
, prop
);
6821 oend
= OVERLAY_END (overlay_vec
[i
]);
6822 oendpos
= OVERLAY_POSITION (oend
);
6823 if (oendpos
< endpos
)
6827 /* If in the region, merge in the region face. */
6828 if (pos
>= region_beg
&& pos
< region_end
)
6830 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6831 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6833 if (region_end
< endpos
)
6834 endpos
= region_end
;
6839 /* Look up a realized face with the given face attributes,
6840 or realize a new one for ASCII characters. */
6841 return lookup_face (f
, attrs
, 0, NULL
);
6845 /* Compute the face at character position POS in Lisp string STRING on
6846 window W, for ASCII characters.
6848 If STRING is an overlay string, it comes from position BUFPOS in
6849 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6850 not an overlay string. W must display the current buffer.
6851 REGION_BEG and REGION_END give the start and end positions of the
6852 region; both are -1 if no region is visible.
6854 BASE_FACE_ID is the id of a face to merge with. For strings coming
6855 from overlays or the `display' property it is the face at BUFPOS.
6857 If MOUSE_P is non-zero, use the character's mouse-face, not its face.
6859 Set *ENDPTR to the next position where to check for faces in
6860 STRING; -1 if the face is constant from POS to the end of the
6863 Value is the id of the face to use. The face returned is suitable
6864 for displaying ASCII characters. */
6867 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6868 region_end
, endptr
, base_face_id
, mouse_p
)
6872 int region_beg
, region_end
;
6874 enum face_id base_face_id
;
6877 Lisp_Object prop
, position
, end
, limit
;
6878 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6879 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6880 struct face
*base_face
;
6881 int multibyte_p
= STRING_MULTIBYTE (string
);
6882 Lisp_Object prop_name
= mouse_p
? Qmouse_face
: Qface
;
6884 /* Get the value of the face property at the current position within
6885 STRING. Value is nil if there is no face property. */
6886 XSETFASTINT (position
, pos
);
6887 prop
= Fget_text_property (position
, prop_name
, string
);
6889 /* Get the next position at which to check for faces. Value of end
6890 is nil if face is constant all the way to the end of the string.
6891 Otherwise it is a string position where to check faces next.
6892 Limit is the maximum position up to which to check for property
6893 changes in Fnext_single_property_change. Strings are usually
6894 short, so set the limit to the end of the string. */
6895 XSETFASTINT (limit
, XSTRING (string
)->size
);
6896 end
= Fnext_single_property_change (position
, prop_name
, string
, limit
);
6898 *endptr
= XFASTINT (end
);
6902 base_face
= FACE_FROM_ID (f
, base_face_id
);
6903 xassert (base_face
);
6905 /* Optimize the default case that there is no face property and we
6906 are not in the region. */
6908 && (base_face_id
!= DEFAULT_FACE_ID
6909 /* BUFPOS <= 0 means STRING is not an overlay string, so
6910 that the region doesn't have to be taken into account. */
6912 || bufpos
< region_beg
6913 || bufpos
>= region_end
)
6915 /* We can't realize faces for different charsets differently
6916 if we don't have fonts, so we can stop here if not working
6917 on a window-system frame. */
6918 || !FRAME_WINDOW_P (f
)
6919 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6920 return base_face
->id
;
6922 /* Begin with attributes from the base face. */
6923 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6925 /* Merge in attributes specified via text properties. */
6927 merge_face_vector_with_property (f
, attrs
, prop
);
6929 /* If in the region, merge in the region face. */
6931 && bufpos
>= region_beg
6932 && bufpos
< region_end
)
6934 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6935 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6938 /* Look up a realized face with the given face attributes,
6939 or realize a new one for ASCII characters. */
6940 return lookup_face (f
, attrs
, 0, NULL
);
6945 /***********************************************************************
6947 ***********************************************************************/
6951 /* Print the contents of the realized face FACE to stderr. */
6954 dump_realized_face (face
)
6957 fprintf (stderr
, "ID: %d\n", face
->id
);
6958 #ifdef HAVE_X_WINDOWS
6959 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6961 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6963 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6964 fprintf (stderr
, "background: 0x%lx (%s)\n",
6966 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6967 fprintf (stderr
, "font_name: %s (%s)\n",
6969 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6970 #ifdef HAVE_X_WINDOWS
6971 fprintf (stderr
, "font = %p\n", face
->font
);
6973 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6974 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6975 fprintf (stderr
, "underline: %d (%s)\n",
6977 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6978 fprintf (stderr
, "hash: %d\n", face
->hash
);
6979 fprintf (stderr
, "charset: %d\n", face
->charset
);
6983 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6991 fprintf (stderr
, "font selection order: ");
6992 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6993 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6994 fprintf (stderr
, "\n");
6996 fprintf (stderr
, "alternative fonts: ");
6997 debug_print (Vface_alternative_font_family_alist
);
6998 fprintf (stderr
, "\n");
7000 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7001 Fdump_face (make_number (i
));
7006 CHECK_NUMBER (n
, 0);
7007 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7009 error ("Not a valid face");
7010 dump_realized_face (face
);
7017 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7021 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7022 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7023 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7027 #endif /* GLYPH_DEBUG != 0 */
7031 /***********************************************************************
7033 ***********************************************************************/
7038 Qface
= intern ("face");
7040 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7041 staticpro (&Qbitmap_spec_p
);
7042 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7043 staticpro (&Qframe_update_face_colors
);
7045 /* Lisp face attribute keywords. */
7046 QCfamily
= intern (":family");
7047 staticpro (&QCfamily
);
7048 QCheight
= intern (":height");
7049 staticpro (&QCheight
);
7050 QCweight
= intern (":weight");
7051 staticpro (&QCweight
);
7052 QCslant
= intern (":slant");
7053 staticpro (&QCslant
);
7054 QCunderline
= intern (":underline");
7055 staticpro (&QCunderline
);
7056 QCinverse_video
= intern (":inverse-video");
7057 staticpro (&QCinverse_video
);
7058 QCreverse_video
= intern (":reverse-video");
7059 staticpro (&QCreverse_video
);
7060 QCforeground
= intern (":foreground");
7061 staticpro (&QCforeground
);
7062 QCbackground
= intern (":background");
7063 staticpro (&QCbackground
);
7064 QCstipple
= intern (":stipple");;
7065 staticpro (&QCstipple
);
7066 QCwidth
= intern (":width");
7067 staticpro (&QCwidth
);
7068 QCfont
= intern (":font");
7069 staticpro (&QCfont
);
7070 QCbold
= intern (":bold");
7071 staticpro (&QCbold
);
7072 QCitalic
= intern (":italic");
7073 staticpro (&QCitalic
);
7074 QCoverline
= intern (":overline");
7075 staticpro (&QCoverline
);
7076 QCstrike_through
= intern (":strike-through");
7077 staticpro (&QCstrike_through
);
7078 QCbox
= intern (":box");
7080 QCinherit
= intern (":inherit");
7081 staticpro (&QCinherit
);
7083 /* Symbols used for Lisp face attribute values. */
7084 QCcolor
= intern (":color");
7085 staticpro (&QCcolor
);
7086 QCline_width
= intern (":line-width");
7087 staticpro (&QCline_width
);
7088 QCstyle
= intern (":style");
7089 staticpro (&QCstyle
);
7090 Qreleased_button
= intern ("released-button");
7091 staticpro (&Qreleased_button
);
7092 Qpressed_button
= intern ("pressed-button");
7093 staticpro (&Qpressed_button
);
7094 Qnormal
= intern ("normal");
7095 staticpro (&Qnormal
);
7096 Qultra_light
= intern ("ultra-light");
7097 staticpro (&Qultra_light
);
7098 Qextra_light
= intern ("extra-light");
7099 staticpro (&Qextra_light
);
7100 Qlight
= intern ("light");
7101 staticpro (&Qlight
);
7102 Qsemi_light
= intern ("semi-light");
7103 staticpro (&Qsemi_light
);
7104 Qsemi_bold
= intern ("semi-bold");
7105 staticpro (&Qsemi_bold
);
7106 Qbold
= intern ("bold");
7108 Qextra_bold
= intern ("extra-bold");
7109 staticpro (&Qextra_bold
);
7110 Qultra_bold
= intern ("ultra-bold");
7111 staticpro (&Qultra_bold
);
7112 Qoblique
= intern ("oblique");
7113 staticpro (&Qoblique
);
7114 Qitalic
= intern ("italic");
7115 staticpro (&Qitalic
);
7116 Qreverse_oblique
= intern ("reverse-oblique");
7117 staticpro (&Qreverse_oblique
);
7118 Qreverse_italic
= intern ("reverse-italic");
7119 staticpro (&Qreverse_italic
);
7120 Qultra_condensed
= intern ("ultra-condensed");
7121 staticpro (&Qultra_condensed
);
7122 Qextra_condensed
= intern ("extra-condensed");
7123 staticpro (&Qextra_condensed
);
7124 Qcondensed
= intern ("condensed");
7125 staticpro (&Qcondensed
);
7126 Qsemi_condensed
= intern ("semi-condensed");
7127 staticpro (&Qsemi_condensed
);
7128 Qsemi_expanded
= intern ("semi-expanded");
7129 staticpro (&Qsemi_expanded
);
7130 Qexpanded
= intern ("expanded");
7131 staticpro (&Qexpanded
);
7132 Qextra_expanded
= intern ("extra-expanded");
7133 staticpro (&Qextra_expanded
);
7134 Qultra_expanded
= intern ("ultra-expanded");
7135 staticpro (&Qultra_expanded
);
7136 Qbackground_color
= intern ("background-color");
7137 staticpro (&Qbackground_color
);
7138 Qforeground_color
= intern ("foreground-color");
7139 staticpro (&Qforeground_color
);
7140 Qunspecified
= intern ("unspecified");
7141 staticpro (&Qunspecified
);
7143 Qface_alias
= intern ("face-alias");
7144 staticpro (&Qface_alias
);
7145 Qdefault
= intern ("default");
7146 staticpro (&Qdefault
);
7147 Qtool_bar
= intern ("tool-bar");
7148 staticpro (&Qtool_bar
);
7149 Qregion
= intern ("region");
7150 staticpro (&Qregion
);
7151 Qfringe
= intern ("fringe");
7152 staticpro (&Qfringe
);
7153 Qheader_line
= intern ("header-line");
7154 staticpro (&Qheader_line
);
7155 Qscroll_bar
= intern ("scroll-bar");
7156 staticpro (&Qscroll_bar
);
7157 Qmenu
= intern ("menu");
7159 Qcursor
= intern ("cursor");
7160 staticpro (&Qcursor
);
7161 Qborder
= intern ("border");
7162 staticpro (&Qborder
);
7163 Qmouse
= intern ("mouse");
7164 staticpro (&Qmouse
);
7165 Qtty_color_desc
= intern ("tty-color-desc");
7166 staticpro (&Qtty_color_desc
);
7167 Qtty_color_by_index
= intern ("tty-color-by-index");
7168 staticpro (&Qtty_color_by_index
);
7169 Qtty_color_alist
= intern ("tty-color-alist");
7170 staticpro (&Qtty_color_alist
);
7171 Qscalable_fonts_allowed
= intern ("scalable-fonts-allowed");
7172 staticpro (&Qscalable_fonts_allowed
);
7174 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7175 staticpro (&Vparam_value_alist
);
7176 Vface_alternative_font_family_alist
= Qnil
;
7177 staticpro (&Vface_alternative_font_family_alist
);
7178 Vface_alternative_font_registry_alist
= Qnil
;
7179 staticpro (&Vface_alternative_font_registry_alist
);
7181 defsubr (&Sinternal_make_lisp_face
);
7182 defsubr (&Sinternal_lisp_face_p
);
7183 defsubr (&Sinternal_set_lisp_face_attribute
);
7184 #ifdef HAVE_WINDOW_SYSTEM
7185 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7187 defsubr (&Scolor_gray_p
);
7188 defsubr (&Scolor_supported_p
);
7189 defsubr (&Sinternal_get_lisp_face_attribute
);
7190 defsubr (&Sinternal_lisp_face_attribute_values
);
7191 defsubr (&Sinternal_lisp_face_equal_p
);
7192 defsubr (&Sinternal_lisp_face_empty_p
);
7193 defsubr (&Sinternal_copy_lisp_face
);
7194 defsubr (&Sinternal_merge_in_global_face
);
7195 defsubr (&Sface_font
);
7196 defsubr (&Sframe_face_alist
);
7197 defsubr (&Sinternal_set_font_selection_order
);
7198 defsubr (&Sinternal_set_alternative_font_family_alist
);
7199 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7201 defsubr (&Sdump_face
);
7202 defsubr (&Sshow_face_resources
);
7203 #endif /* GLYPH_DEBUG */
7204 defsubr (&Sclear_face_cache
);
7205 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7207 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7208 defsubr (&Sdump_colors
);
7211 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7212 "*Limit for font matching.\n\
7213 If an integer > 0, font matching functions won't load more than\n\
7214 that number of fonts when searching for a matching font.");
7215 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7217 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7218 "List of global face definitions (for internal use only.)");
7219 Vface_new_frame_defaults
= Qnil
;
7221 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7222 "*Default stipple pattern used on monochrome displays.\n\
7223 This stipple pattern is used on monochrome displays\n\
7224 instead of shades of gray for a face background color.\n\
7225 See `set-face-stipple' for possible values for this variable.");
7226 Vface_default_stipple
= build_string ("gray3");
7228 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7229 "An alist of defined terminal colors and their RGB values.");
7230 Vtty_defined_color_alist
= Qnil
;
7232 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7233 "Allowed scalable fonts.\n\
7234 A value of nil means don't allow any scalable fonts.\n\
7235 A value of t means allow any scalable font.\n\
7236 Otherwise, value must be a list of regular expressions. A font may be\n\
7237 scaled if its name matches a regular expression in the list.\n\
7238 Note that if value is nil, a scalable font might still be used, if no\n\
7239 other font of the appropriate family and registry is available.");
7240 Vscalable_fonts_allowed
= Qnil
;
7242 DEFVAR_LISP ("face-ignored-fonts", &Vface_ignored_fonts
,
7243 "List of ignored fonts.\n\
7244 Each element is a regular expression that matches names of fonts to ignore.");
7245 Vface_ignored_fonts
= Qnil
;
7247 #ifdef HAVE_WINDOW_SYSTEM
7248 defsubr (&Sbitmap_spec_p
);
7249 defsubr (&Sx_list_fonts
);
7250 defsubr (&Sinternal_face_x_get_resource
);
7251 defsubr (&Sx_family_fonts
);
7252 defsubr (&Sx_font_family_list
);
7253 #endif /* HAVE_WINDOW_SYSTEM */