1 /* xfaces.c -- "Face" primitives.
2 Copyright (C) 1993, 1994, 1998, 1999, 2000 Free Software Foundation.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
21 /* New face implementation by Gerd Moellmann <gerd@gnu.org>. */
25 When using Emacs with X, the display style of characters can be
26 changed by defining `faces'. Each face can specify the following
31 2. Relative proportionate width, aka character set width or set
32 width (swidth), e.g. `semi-compressed'.
34 3. Font height in 1/10pt.
36 4. Font weight, e.g. `bold'.
38 5. Font slant, e.g. `italic'.
44 8. Whether or not characters should be underlined, and in what color.
46 9. Whether or not characters should be displayed in inverse video.
48 10. A background stipple, a bitmap.
50 11. Whether or not characters should be overlined, and in what color.
52 12. Whether or not characters should be strike-through, and in what
55 13. Whether or not a box should be drawn around characters, the box
56 type, and, for simple boxes, in what color.
58 14. Font or fontset pattern, or nil. This is a special attribute.
59 When this attribyte is specified, the face uses a font opened by
60 that pattern as is. In addition, all the other font-related
61 attributes (1st thru 5th) are generated from the opened font name.
62 On the other hand, if one of the other font-related attributes are
63 specified, this attribute is set to nil. In that case, the face
64 doesn't inherit this attribute from the `default' face, and uses a
65 font determined by the other attributes (those may be inherited
66 from the `default' face).
68 15. A face name or list of face names from which to inherit attributes.
70 Faces are frame-local by nature because Emacs allows to define the
71 same named face (face names are symbols) differently for different
72 frames. Each frame has an alist of face definitions for all named
73 faces. The value of a named face in such an alist is a Lisp vector
74 with the symbol `face' in slot 0, and a slot for each of the face
75 attributes mentioned above.
77 There is also a global face alist `Vface_new_frame_defaults'. Face
78 definitions from this list are used to initialize faces of newly
81 A face doesn't have to specify all attributes. Those not specified
82 have a value of `unspecified'. Faces specifying all attributes but
83 the 14th are called `fully-specified'.
88 The display style of a given character in the text is determined by
89 combining several faces. This process is called `face merging'.
90 Any aspect of the display style that isn't specified by overlays or
91 text properties is taken from the `default' face. Since it is made
92 sure that the default face is always fully-specified, face merging
93 always results in a fully-specified face.
98 After all face attributes for a character have been determined by
99 merging faces of that character, that face is `realized'. The
100 realization process maps face attributes to what is physically
101 available on the system where Emacs runs. The result is a
102 `realized face' in form of a struct face which is stored in the
103 face cache of the frame on which it was realized.
105 Face realization is done in the context of the character to display
106 because different fonts may be used for different characters. In
107 other words, for characters that have different font
108 specifications, different realized faces are needed to display
111 Font specification is done by fontsets. See the comment in
112 fontset.c for the details. In the current implementation, all ASCII
113 characters share the same font in a fontset.
115 Faces are at first realized for ASCII characters, and, at that
116 time, assigned a specific realized fontset. Hereafter, we call
117 such a face as `ASCII face'. When a face for a multibyte character
118 is realized, it inherits (thus shares) a fontset of an ASCII face
119 that has the same attributes other than font-related ones.
121 Thus, all realzied face have a realized fontset.
126 Unibyte text (i.e. raw 8-bit characters) is displayed with the same
127 font as ASCII characters. That is because it is expected that
128 unibyte text users specify a font that is suitable both for ASCII
129 and raw 8-bit characters.
134 Font selection tries to find the best available matching font for a
135 given (character, face) combination.
137 If the face specifies a fontset name, that fontset determines a
138 pattern for fonts of the given character. If the face specifies a
139 font name or the other font-related attributes, a fontset is
140 realized from the default fontset. In that case, that
141 specification determines a pattern for ASCII characters and the
142 default fontset determines a pattern for multibyte characters.
144 Available fonts on the system on which Emacs runs are then matched
145 against the font pattern. The result of font selection is the best
146 match for the given face attributes in this font list.
148 Font selection can be influenced by the user.
150 1. The user can specify the relative importance he gives the face
151 attributes width, height, weight, and slant by setting
152 face-font-selection-order (faces.el) to a list of face attribute
153 names. The default is '(:width :height :weight :slant), and means
154 that font selection first tries to find a good match for the font
155 width specified by a face, then---within fonts with that
156 width---tries to find a best match for the specified font height,
159 2. Setting face-alternative-font-family-alist allows the user to
160 specify alternative font families to try if a family specified by a
164 Character compositition.
166 Usually, the realization process is already finished when Emacs
167 actually reflects the desired glyph matrix on the screen. However,
168 on displaying a composition (sequence of characters to be composed
169 on the screen), a suitable font for the components of the
170 composition is selected and realized while drawing them on the
171 screen, i.e. the realization process is delayed but in principle
175 Initialization of basic faces.
177 The faces `default', `modeline' are considered `basic faces'.
178 When redisplay happens the first time for a newly created frame,
179 basic faces are realized for CHARSET_ASCII. Frame parameters are
180 used to fill in unspecified attributes of the default face. */
183 #include <sys/types.h>
184 #include <sys/stat.h>
189 #ifdef HAVE_WINDOW_SYSTEM
191 #endif /* HAVE_WINDOW_SYSTEM */
193 #ifdef HAVE_X_WINDOWS
197 #include <Xm/XmStrDefs.h>
198 #endif /* USE_MOTIF */
199 #endif /* HAVE_X_WINDOWS */
208 /* Redefine X specifics to W32 equivalents to avoid cluttering the
209 code with #ifdef blocks. */
210 #define FRAME_X_DISPLAY_INFO FRAME_W32_DISPLAY_INFO
211 #define x_display_info w32_display_info
212 #define FRAME_X_FONT_TABLE FRAME_W32_FONT_TABLE
213 #define check_x check_w32
214 #define x_list_fonts w32_list_fonts
215 #define GCGraphicsExposures 0
216 /* For historic reasons, FONT_WIDTH refers to average width on W32,
217 not maximum as on X. Redefine here. */
218 #define FONT_WIDTH FONT_MAX_WIDTH
219 #endif /* WINDOWSNT */
223 #define x_display_info mac_display_info
224 #define check_x check_mac
226 extern XGCValues
*XCreateGC (void *, WindowPtr
, unsigned long, XGCValues
*);
229 x_create_gc (f
, mask
, xgcv
)
235 gc
= XCreateGC (FRAME_MAC_DISPLAY (f
), FRAME_MAC_WINDOW (f
), mask
, xgcv
);
244 XFreeGC (FRAME_MAC_DISPLAY (f
), gc
);
249 #include "dispextern.h"
250 #include "blockinput.h"
252 #include "intervals.h"
254 #ifdef HAVE_X_WINDOWS
256 /* Compensate for a bug in Xos.h on some systems, on which it requires
257 time.h. On some such systems, Xos.h tries to redefine struct
258 timeval and struct timezone if USG is #defined while it is
261 #ifdef XOS_NEEDS_TIME_H
267 #else /* not XOS_NEEDS_TIME_H */
269 #endif /* not XOS_NEEDS_TIME_H */
271 #endif /* HAVE_X_WINDOWS */
275 #include "keyboard.h"
278 #define max(A, B) ((A) > (B) ? (A) : (B))
279 #define min(A, B) ((A) < (B) ? (A) : (B))
280 #define abs(X) ((X) < 0 ? -(X) : (X))
283 /* Non-zero if face attribute ATTR is unspecified. */
285 #define UNSPECIFIEDP(ATTR) EQ ((ATTR), Qunspecified)
287 /* Value is the number of elements of VECTOR. */
289 #define DIM(VECTOR) (sizeof (VECTOR) / sizeof *(VECTOR))
291 /* Make a copy of string S on the stack using alloca. Value is a pointer
294 #define STRDUPA(S) strcpy ((char *) alloca (strlen ((S)) + 1), (S))
296 /* Make a copy of the contents of Lisp string S on the stack using
297 alloca. Value is a pointer to the copy. */
299 #define LSTRDUPA(S) STRDUPA (XSTRING ((S))->data)
301 /* Size of hash table of realized faces in face caches (should be a
304 #define FACE_CACHE_BUCKETS_SIZE 1001
306 /* A definition of XColor for non-X frames. */
308 #ifndef HAVE_X_WINDOWS
313 unsigned short red
, green
, blue
;
319 #endif /* not HAVE_X_WINDOWS */
321 /* Keyword symbols used for face attribute names. */
323 Lisp_Object QCfamily
, QCheight
, QCweight
, QCslant
, QCunderline
;
324 Lisp_Object QCinverse_video
, QCforeground
, QCbackground
, QCstipple
;
325 Lisp_Object QCwidth
, QCfont
, QCbold
, QCitalic
;
326 Lisp_Object QCreverse_video
;
327 Lisp_Object QCoverline
, QCstrike_through
, QCbox
, QCinherit
;
329 /* Symbols used for attribute values. */
331 Lisp_Object Qnormal
, Qbold
, Qultra_light
, Qextra_light
, Qlight
;
332 Lisp_Object Qsemi_light
, Qsemi_bold
, Qextra_bold
, Qultra_bold
;
333 Lisp_Object Qoblique
, Qitalic
, Qreverse_oblique
, Qreverse_italic
;
334 Lisp_Object Qultra_condensed
, Qextra_condensed
, Qcondensed
;
335 Lisp_Object Qsemi_condensed
, Qsemi_expanded
, Qexpanded
, Qextra_expanded
;
336 Lisp_Object Qultra_expanded
;
337 Lisp_Object Qreleased_button
, Qpressed_button
;
338 Lisp_Object QCstyle
, QCcolor
, QCline_width
;
339 Lisp_Object Qunspecified
;
341 char unspecified_fg
[] = "unspecified-fg", unspecified_bg
[] = "unspecified-bg";
343 /* The name of the function to call when the background of the frame
344 has changed, frame_update_face_colors. */
346 Lisp_Object Qframe_update_face_colors
;
348 /* Names of basic faces. */
350 Lisp_Object Qdefault
, Qtool_bar
, Qregion
, Qfringe
;
351 Lisp_Object Qheader_line
, Qscroll_bar
, Qcursor
, Qborder
, Qmouse
, Qmenu
;
352 extern Lisp_Object Qmode_line
;
354 /* The symbol `face-alias'. A symbols having that property is an
355 alias for another face. Value of the property is the name of
358 Lisp_Object Qface_alias
;
360 /* Names of frame parameters related to faces. */
362 extern Lisp_Object Qscroll_bar_foreground
, Qscroll_bar_background
;
363 extern Lisp_Object Qborder_color
, Qcursor_color
, Qmouse_color
;
365 /* Default stipple pattern used on monochrome displays. This stipple
366 pattern is used on monochrome displays instead of shades of gray
367 for a face background color. See `set-face-stipple' for possible
368 values for this variable. */
370 Lisp_Object Vface_default_stipple
;
372 /* Alist of alternative font families. Each element is of the form
373 (FAMILY FAMILY1 FAMILY2 ...). If fonts of FAMILY can't be loaded,
374 try FAMILY1, then FAMILY2, ... */
376 Lisp_Object Vface_alternative_font_family_alist
;
378 /* Allowed scalable fonts. A value of nil means don't allow any
379 scalable fonts. A value of t means allow the use of any scalable
380 font. Otherwise, value must be a list of regular expressions. A
381 font may be scaled if its name matches a regular expression in the
384 Lisp_Object Vscalable_fonts_allowed
;
386 /* Maximum number of fonts to consider in font_list. If not an
387 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
389 Lisp_Object Vfont_list_limit
;
390 #define DEFAULT_FONT_LIST_LIMIT 100
392 /* The symbols `foreground-color' and `background-color' which can be
393 used as part of a `face' property. This is for compatibility with
396 Lisp_Object Qforeground_color
, Qbackground_color
;
398 /* The symbols `face' and `mouse-face' used as text properties. */
401 extern Lisp_Object Qmouse_face
;
403 /* Error symbol for wrong_type_argument in load_pixmap. */
405 Lisp_Object Qbitmap_spec_p
;
407 /* Alist of global face definitions. Each element is of the form
408 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
409 is a Lisp vector of face attributes. These faces are used
410 to initialize faces for new frames. */
412 Lisp_Object Vface_new_frame_defaults
;
414 /* The next ID to assign to Lisp faces. */
416 static int next_lface_id
;
418 /* A vector mapping Lisp face Id's to face names. */
420 static Lisp_Object
*lface_id_to_name
;
421 static int lface_id_to_name_size
;
423 /* TTY color-related functions (defined in tty-colors.el). */
425 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
427 /* The name of the function used to compute colors on TTYs. */
429 Lisp_Object Qtty_color_alist
;
431 /* An alist of defined terminal colors and their RGB values. */
433 Lisp_Object Vtty_defined_color_alist
;
435 /* Counter for calls to clear_face_cache. If this counter reaches
436 CLEAR_FONT_TABLE_COUNT, and a frame has more than
437 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
439 static int clear_font_table_count
;
440 #define CLEAR_FONT_TABLE_COUNT 100
441 #define CLEAR_FONT_TABLE_NFONTS 10
443 /* Non-zero means face attributes have been changed since the last
444 redisplay. Used in redisplay_internal. */
446 int face_change_count
;
448 /* Non-zero means don't display bold text if a face's foreground
449 and background colors are the inverse of the default colors of the
450 display. This is a kluge to suppress `bold black' foreground text
451 which is hard to read on an LCD monitor. */
453 int tty_suppress_bold_inverse_default_colors_p
;
455 /* A list of the form `((x . y))' used to avoid consing in
456 Finternal_set_lisp_face_attribute. */
458 static Lisp_Object Vparam_value_alist
;
460 /* The total number of colors currently allocated. */
463 static int ncolors_allocated
;
464 static int npixmaps_allocated
;
470 /* Function prototypes. */
475 static void map_tty_color
P_ ((struct frame
*, struct face
*,
476 enum lface_attribute_index
, int *));
477 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
478 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
479 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
480 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
482 static int first_font_matching
P_ ((struct frame
*f
, char *,
483 struct font_name
*));
484 static int x_face_list_fonts
P_ ((struct frame
*, char *,
485 struct font_name
*, int, int, int));
486 static int font_scalable_p
P_ ((struct font_name
*));
487 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
488 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
489 static unsigned char *xstrlwr
P_ ((unsigned char *));
490 static void signal_error
P_ ((char *, Lisp_Object
));
491 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
492 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
493 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
494 static void free_face_colors
P_ ((struct frame
*, struct face
*));
495 static int face_color_gray_p
P_ ((struct frame
*, char *));
496 static char *build_font_name
P_ ((struct font_name
*));
497 static void free_font_names
P_ ((struct font_name
*, int));
498 static int sorted_font_list
P_ ((struct frame
*, char *,
499 int (*cmpfn
) P_ ((const void *, const void *)),
500 struct font_name
**));
501 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
502 Lisp_Object
, struct font_name
**));
503 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
504 Lisp_Object
, Lisp_Object
, struct font_name
**));
505 static int cmp_font_names
P_ ((const void *, const void *));
506 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
507 struct face
*, int));
508 static struct face
*realize_x_face
P_ ((struct face_cache
*,
509 Lisp_Object
*, int, struct face
*));
510 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
511 Lisp_Object
*, int));
512 static int realize_basic_faces
P_ ((struct frame
*));
513 static int realize_default_face
P_ ((struct frame
*));
514 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
515 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
516 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
517 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
518 static unsigned lface_hash
P_ ((Lisp_Object
*));
519 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
520 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
521 static void free_realized_face
P_ ((struct frame
*, struct face
*));
522 static void clear_face_gcs
P_ ((struct face_cache
*));
523 static void free_face_cache
P_ ((struct face_cache
*));
524 static int face_numeric_weight
P_ ((Lisp_Object
));
525 static int face_numeric_slant
P_ ((Lisp_Object
));
526 static int face_numeric_swidth
P_ ((Lisp_Object
));
527 static int face_fontset
P_ ((Lisp_Object
*));
528 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
529 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
530 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
531 Lisp_Object
*, Lisp_Object
));
532 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
534 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
535 Lisp_Object
, int, int));
536 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
537 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
538 static void free_realized_faces
P_ ((struct face_cache
*));
539 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
540 struct font_name
*, int));
541 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
542 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
543 static int xlfd_numeric_slant
P_ ((struct font_name
*));
544 static int xlfd_numeric_weight
P_ ((struct font_name
*));
545 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
546 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
547 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
548 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
549 static int xlfd_fixed_p
P_ ((struct font_name
*));
550 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
552 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
553 struct font_name
*, int,
555 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
556 struct font_name
*, int));
558 #ifdef HAVE_WINDOW_SYSTEM
560 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
561 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
562 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
563 int (*cmpfn
) P_ ((const void *, const void *))));
564 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
565 static void x_free_gc
P_ ((struct frame
*, GC
));
566 static void clear_font_table
P_ ((struct frame
*));
569 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
570 #endif /* WINDOWSNT */
572 #endif /* HAVE_WINDOW_SYSTEM */
575 /***********************************************************************
577 ***********************************************************************/
579 #ifdef HAVE_X_WINDOWS
581 #ifdef DEBUG_X_COLORS
583 /* The following is a poor mans infrastructure for debugging X color
584 allocation problems on displays with PseudoColor-8. Some X servers
585 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
586 color reference counts completely so that they don't signal an
587 error when a color is freed whose reference count is already 0.
588 Other X servers do. To help me debug this, the following code
589 implements a simple reference counting schema of its own, for a
590 single display/screen. --gerd. */
592 /* Reference counts for pixel colors. */
594 int color_count
[256];
596 /* Register color PIXEL as allocated. */
599 register_color (pixel
)
602 xassert (pixel
< 256);
603 ++color_count
[pixel
];
607 /* Register color PIXEL as deallocated. */
610 unregister_color (pixel
)
613 xassert (pixel
< 256);
614 if (color_count
[pixel
] > 0)
615 --color_count
[pixel
];
621 /* Register N colors from PIXELS as deallocated. */
624 unregister_colors (pixels
, n
)
625 unsigned long *pixels
;
629 for (i
= 0; i
< n
; ++i
)
630 unregister_color (pixels
[i
]);
634 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
635 "Dump currently allocated colors and their reference counts to stderr.")
640 fputc ('\n', stderr
);
642 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
645 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
648 fputc ('\n', stderr
);
650 fputc ('\t', stderr
);
654 fputc ('\n', stderr
);
658 #endif /* DEBUG_X_COLORS */
661 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
662 color values. Interrupt input must be blocked when this function
666 x_free_colors (f
, pixels
, npixels
)
668 unsigned long *pixels
;
671 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
673 /* If display has an immutable color map, freeing colors is not
674 necessary and some servers don't allow it. So don't do it. */
675 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
677 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
679 #ifdef DEBUG_X_COLORS
680 unregister_colors (pixels
, npixels
);
686 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
687 color values. Interrupt input must be blocked when this function
691 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
695 unsigned long *pixels
;
698 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
699 int class = dpyinfo
->visual
->class;
701 /* If display has an immutable color map, freeing colors is not
702 necessary and some servers don't allow it. So don't do it. */
703 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
705 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
706 #ifdef DEBUG_X_COLORS
707 unregister_colors (pixels
, npixels
);
713 /* Create and return a GC for use on frame F. GC values and mask
714 are given by XGCV and MASK. */
717 x_create_gc (f
, mask
, xgcv
)
724 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
731 /* Free GC which was used on frame F. */
739 xassert (--ngcs
>= 0);
740 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
744 #endif /* HAVE_X_WINDOWS */
747 /* W32 emulation of GCs */
750 x_create_gc (f
, mask
, xgcv
)
757 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
764 /* Free GC which was used on frame F. */
772 xassert (--ngcs
>= 0);
777 #endif /* WINDOWSNT */
779 /* Like stricmp. Used to compare parts of font names which are in
784 unsigned char *s1
, *s2
;
788 unsigned char c1
= tolower (*s1
);
789 unsigned char c2
= tolower (*s2
);
791 return c1
< c2
? -1 : 1;
796 return *s2
== 0 ? 0 : -1;
801 /* Like strlwr, which might not always be available. */
803 static unsigned char *
807 unsigned char *p
= s
;
816 /* Signal `error' with message S, and additional argument ARG. */
819 signal_error (s
, arg
)
823 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
827 /* If FRAME is nil, return a pointer to the selected frame.
828 Otherwise, check that FRAME is a live frame, and return a pointer
829 to it. NPARAM is the parameter number of FRAME, for
830 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
831 Lisp function definitions. */
833 static INLINE
struct frame
*
834 frame_or_selected_frame (frame
, nparam
)
839 frame
= selected_frame
;
841 CHECK_LIVE_FRAME (frame
, nparam
);
842 return XFRAME (frame
);
846 /***********************************************************************
848 ***********************************************************************/
850 /* Initialize face cache and basic faces for frame F. */
856 /* Make a face cache, if F doesn't have one. */
857 if (FRAME_FACE_CACHE (f
) == NULL
)
858 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
860 #ifdef HAVE_WINDOW_SYSTEM
861 /* Make the image cache. */
862 if (FRAME_WINDOW_P (f
))
864 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
865 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
866 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
868 #endif /* HAVE_WINDOW_SYSTEM */
870 /* Realize basic faces. Must have enough information in frame
871 parameters to realize basic faces at this point. */
872 #ifdef HAVE_X_WINDOWS
873 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
876 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
878 if (!realize_basic_faces (f
))
883 /* Free face cache of frame F. Called from Fdelete_frame. */
889 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
893 free_face_cache (face_cache
);
894 FRAME_FACE_CACHE (f
) = NULL
;
897 #ifdef HAVE_WINDOW_SYSTEM
898 if (FRAME_WINDOW_P (f
))
900 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
903 --image_cache
->refcount
;
904 if (image_cache
->refcount
== 0)
905 free_image_cache (f
);
908 #endif /* HAVE_WINDOW_SYSTEM */
912 /* Clear face caches, and recompute basic faces for frame F. Call
913 this after changing frame parameters on which those faces depend,
914 or when realized faces have been freed due to changing attributes
918 recompute_basic_faces (f
)
921 if (FRAME_FACE_CACHE (f
))
923 clear_face_cache (0);
924 if (!realize_basic_faces (f
))
930 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
931 try to free unused fonts, too. */
934 clear_face_cache (clear_fonts_p
)
937 #ifdef HAVE_WINDOW_SYSTEM
938 Lisp_Object tail
, frame
;
942 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
944 /* From time to time see if we can unload some fonts. This also
945 frees all realized faces on all frames. Fonts needed by
946 faces will be loaded again when faces are realized again. */
947 clear_font_table_count
= 0;
949 FOR_EACH_FRAME (tail
, frame
)
952 if (FRAME_WINDOW_P (f
)
953 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
955 free_all_realized_faces (frame
);
956 clear_font_table (f
);
962 /* Clear GCs of realized faces. */
963 FOR_EACH_FRAME (tail
, frame
)
966 if (FRAME_WINDOW_P (f
))
968 clear_face_gcs (FRAME_FACE_CACHE (f
));
969 clear_image_cache (f
, 0);
973 #endif /* HAVE_WINDOW_SYSTEM */
977 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
978 "Clear face caches on all frames.\n\
979 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
981 Lisp_Object thorougly
;
983 clear_face_cache (!NILP (thorougly
));
985 ++windows_or_buffers_changed
;
991 #ifdef HAVE_WINDOW_SYSTEM
994 /* Remove those fonts from the font table of frame F exept for the
995 default ASCII font for the frame. Called from clear_face_cache
996 from time to time. */
1002 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1005 xassert (FRAME_WINDOW_P (f
));
1007 /* Free those fonts that are not used by the frame F as the default. */
1008 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1010 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1012 if (!font_info
->name
1013 || font_info
->font
== FRAME_FONT (f
))
1017 if (font_info
->full_name
!= font_info
->name
)
1018 xfree (font_info
->full_name
);
1019 xfree (font_info
->name
);
1021 /* Free the font. */
1023 #ifdef HAVE_X_WINDOWS
1024 XFreeFont (dpyinfo
->display
, font_info
->font
);
1027 w32_unload_font (dpyinfo
, font_info
->font
);
1031 /* Mark font table slot free. */
1032 font_info
->font
= NULL
;
1033 font_info
->name
= font_info
->full_name
= NULL
;
1037 #endif /* HAVE_WINDOW_SYSTEM */
1041 /***********************************************************************
1043 ***********************************************************************/
1045 #ifdef HAVE_WINDOW_SYSTEM
1047 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1048 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1049 A bitmap specification is either a string, a file name, or a list\n\
1050 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1051 HEIGHT is its height, and DATA is a string containing the bits of\n\
1052 the pixmap. Bits are stored row by row, each row occupies\n\
1053 (WIDTH + 7)/8 bytes.")
1059 if (STRINGP (object
))
1060 /* If OBJECT is a string, it's a file name. */
1062 else if (CONSP (object
))
1064 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1065 HEIGHT must be integers > 0, and DATA must be string large
1066 enough to hold a bitmap of the specified size. */
1067 Lisp_Object width
, height
, data
;
1069 height
= width
= data
= Qnil
;
1073 width
= XCAR (object
);
1074 object
= XCDR (object
);
1077 height
= XCAR (object
);
1078 object
= XCDR (object
);
1080 data
= XCAR (object
);
1084 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1086 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1088 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1093 return pixmap_p
? Qt
: Qnil
;
1097 /* Load a bitmap according to NAME (which is either a file name or a
1098 pixmap spec) for use on frame F. Value is the bitmap_id (see
1099 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1100 bitmap cannot be loaded, display a message saying so, and return
1101 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1102 if these pointers are not null. */
1105 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1108 unsigned int *w_ptr
, *h_ptr
;
1116 tem
= Fbitmap_spec_p (name
);
1118 wrong_type_argument (Qbitmap_spec_p
, name
);
1123 /* Decode a bitmap spec into a bitmap. */
1128 w
= XINT (Fcar (name
));
1129 h
= XINT (Fcar (Fcdr (name
)));
1130 bits
= Fcar (Fcdr (Fcdr (name
)));
1132 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1137 /* It must be a string -- a file name. */
1138 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1144 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1155 ++npixmaps_allocated
;
1158 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1161 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1167 #endif /* HAVE_WINDOW_SYSTEM */
1171 /***********************************************************************
1173 ***********************************************************************/
1175 #ifdef HAVE_WINDOW_SYSTEM
1177 /* Update the line_height of frame F. Return non-zero if line height
1181 frame_update_line_height (f
)
1184 int line_height
, changed_p
;
1186 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1187 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1188 FRAME_LINE_HEIGHT (f
) = line_height
;
1192 #endif /* HAVE_WINDOW_SYSTEM */
1195 /***********************************************************************
1197 ***********************************************************************/
1199 #ifdef HAVE_WINDOW_SYSTEM
1201 /* Load font of face FACE which is used on frame F to display
1202 character C. The name of the font to load is determined by lface
1203 and fontset of FACE. */
1206 load_face_font (f
, face
, c
)
1211 struct font_info
*font_info
= NULL
;
1214 face
->font_info_id
= -1;
1217 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1222 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1227 face
->font_info_id
= font_info
->font_idx
;
1228 face
->font
= font_info
->font
;
1229 face
->font_name
= font_info
->full_name
;
1232 x_free_gc (f
, face
->gc
);
1237 add_to_log ("Unable to load font %s",
1238 build_string (font_name
), Qnil
);
1242 #endif /* HAVE_WINDOW_SYSTEM */
1246 /***********************************************************************
1248 ***********************************************************************/
1250 /* A version of defined_color for non-X frames. */
1253 tty_defined_color (f
, color_name
, color_def
, alloc
)
1259 Lisp_Object color_desc
;
1260 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1261 unsigned long red
= 0, green
= 0, blue
= 0;
1264 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1268 XSETFRAME (frame
, f
);
1270 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1271 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1273 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1274 if (CONSP (XCDR (XCDR (color_desc
))))
1276 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1277 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1278 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1282 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1283 /* We were called early during startup, and the colors are not
1284 yet set up in tty-defined-color-alist. Don't return a failure
1285 indication, since this produces the annoying "Unable to
1286 load color" messages in the *Messages* buffer. */
1289 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1291 if (strcmp (color_name
, "unspecified-fg") == 0)
1292 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1293 else if (strcmp (color_name
, "unspecified-bg") == 0)
1294 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1297 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1300 color_def
->pixel
= color_idx
;
1301 color_def
->red
= red
;
1302 color_def
->green
= green
;
1303 color_def
->blue
= blue
;
1309 /* Decide if color named COLOR_NAME is valid for the display
1310 associated with the frame F; if so, return the rgb values in
1311 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1313 This does the right thing for any type of frame. */
1316 defined_color (f
, color_name
, color_def
, alloc
)
1322 if (!FRAME_WINDOW_P (f
))
1323 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1324 #ifdef HAVE_X_WINDOWS
1325 else if (FRAME_X_P (f
))
1326 return x_defined_color (f
, color_name
, color_def
, alloc
);
1329 else if (FRAME_W32_P (f
))
1330 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1333 else if (FRAME_MAC_P (f
))
1334 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1341 /* Given the index IDX of a tty color on frame F, return its name, a
1345 tty_color_name (f
, idx
)
1349 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1352 Lisp_Object coldesc
;
1354 XSETFRAME (frame
, f
);
1355 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1357 if (!NILP (coldesc
))
1358 return XCAR (coldesc
);
1361 /* We can have an MSDOG frame under -nw for a short window of
1362 opportunity before internal_terminal_init is called. DTRT. */
1363 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1364 return msdos_stdcolor_name (idx
);
1367 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1368 return build_string (unspecified_fg
);
1369 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1370 return build_string (unspecified_bg
);
1373 return vga_stdcolor_name (idx
);
1376 return Qunspecified
;
1380 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1381 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1384 face_color_gray_p (f
, color_name
)
1391 if (defined_color (f
, color_name
, &color
, 0))
1392 gray_p
= ((abs (color
.red
- color
.green
)
1393 < max (color
.red
, color
.green
) / 20)
1394 && (abs (color
.green
- color
.blue
)
1395 < max (color
.green
, color
.blue
) / 20)
1396 && (abs (color
.blue
- color
.red
)
1397 < max (color
.blue
, color
.red
) / 20));
1405 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1406 BACKGROUND_P non-zero means the color will be used as background
1410 face_color_supported_p (f
, color_name
, background_p
)
1418 XSETFRAME (frame
, f
);
1419 return (FRAME_WINDOW_P (f
)
1420 ? (!NILP (Fxw_display_color_p (frame
))
1421 || xstricmp (color_name
, "black") == 0
1422 || xstricmp (color_name
, "white") == 0
1424 && face_color_gray_p (f
, color_name
))
1425 || (!NILP (Fx_display_grayscale_p (frame
))
1426 && face_color_gray_p (f
, color_name
)))
1427 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1431 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1432 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1433 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1434 If FRAME is nil or omitted, use the selected frame.")
1436 Lisp_Object color
, frame
;
1440 CHECK_FRAME (frame
, 0);
1441 CHECK_STRING (color
, 0);
1443 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1447 DEFUN ("color-supported-p", Fcolor_supported_p
,
1448 Scolor_supported_p
, 2, 3, 0,
1449 "Return non-nil if COLOR can be displayed on FRAME.\n\
1450 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1451 If FRAME is nil or omitted, use the selected frame.\n\
1452 COLOR must be a valid color name.")
1453 (color
, frame
, background_p
)
1454 Lisp_Object frame
, color
, background_p
;
1458 CHECK_FRAME (frame
, 0);
1459 CHECK_STRING (color
, 0);
1461 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1467 /* Load color with name NAME for use by face FACE on frame F.
1468 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1469 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1470 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1471 pixel color. If color cannot be loaded, display a message, and
1472 return the foreground, background or underline color of F, but
1473 record that fact in flags of the face so that we don't try to free
1477 load_color (f
, face
, name
, target_index
)
1481 enum lface_attribute_index target_index
;
1485 xassert (STRINGP (name
));
1486 xassert (target_index
== LFACE_FOREGROUND_INDEX
1487 || target_index
== LFACE_BACKGROUND_INDEX
1488 || target_index
== LFACE_UNDERLINE_INDEX
1489 || target_index
== LFACE_OVERLINE_INDEX
1490 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1491 || target_index
== LFACE_BOX_INDEX
);
1493 /* if the color map is full, defined_color will return a best match
1494 to the values in an existing cell. */
1495 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1497 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1499 switch (target_index
)
1501 case LFACE_FOREGROUND_INDEX
:
1502 face
->foreground_defaulted_p
= 1;
1503 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1506 case LFACE_BACKGROUND_INDEX
:
1507 face
->background_defaulted_p
= 1;
1508 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1511 case LFACE_UNDERLINE_INDEX
:
1512 face
->underline_defaulted_p
= 1;
1513 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1516 case LFACE_OVERLINE_INDEX
:
1517 face
->overline_color_defaulted_p
= 1;
1518 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1521 case LFACE_STRIKE_THROUGH_INDEX
:
1522 face
->strike_through_color_defaulted_p
= 1;
1523 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1526 case LFACE_BOX_INDEX
:
1527 face
->box_color_defaulted_p
= 1;
1528 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1537 ++ncolors_allocated
;
1544 #ifdef HAVE_WINDOW_SYSTEM
1546 /* Load colors for face FACE which is used on frame F. Colors are
1547 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1548 of ATTRS. If the background color specified is not supported on F,
1549 try to emulate gray colors with a stipple from Vface_default_stipple. */
1552 load_face_colors (f
, face
, attrs
)
1559 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1560 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1562 /* Swap colors if face is inverse-video. */
1563 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1571 /* Check for support for foreground, not for background because
1572 face_color_supported_p is smart enough to know that grays are
1573 "supported" as background because we are supposed to use stipple
1575 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1576 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1578 x_destroy_bitmap (f
, face
->stipple
);
1579 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1580 &face
->pixmap_w
, &face
->pixmap_h
);
1583 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1584 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1588 /* Free color PIXEL on frame F. */
1591 unload_color (f
, pixel
)
1593 unsigned long pixel
;
1595 #ifdef HAVE_X_WINDOWS
1597 x_free_colors (f
, &pixel
, 1);
1603 /* Free colors allocated for FACE. */
1606 free_face_colors (f
, face
)
1610 #ifdef HAVE_X_WINDOWS
1613 if (!face
->foreground_defaulted_p
)
1615 x_free_colors (f
, &face
->foreground
, 1);
1616 IF_DEBUG (--ncolors_allocated
);
1619 if (!face
->background_defaulted_p
)
1621 x_free_colors (f
, &face
->background
, 1);
1622 IF_DEBUG (--ncolors_allocated
);
1625 if (face
->underline_p
1626 && !face
->underline_defaulted_p
)
1628 x_free_colors (f
, &face
->underline_color
, 1);
1629 IF_DEBUG (--ncolors_allocated
);
1632 if (face
->overline_p
1633 && !face
->overline_color_defaulted_p
)
1635 x_free_colors (f
, &face
->overline_color
, 1);
1636 IF_DEBUG (--ncolors_allocated
);
1639 if (face
->strike_through_p
1640 && !face
->strike_through_color_defaulted_p
)
1642 x_free_colors (f
, &face
->strike_through_color
, 1);
1643 IF_DEBUG (--ncolors_allocated
);
1646 if (face
->box
!= FACE_NO_BOX
1647 && !face
->box_color_defaulted_p
)
1649 x_free_colors (f
, &face
->box_color
, 1);
1650 IF_DEBUG (--ncolors_allocated
);
1654 #endif /* HAVE_X_WINDOWS */
1657 #endif /* HAVE_WINDOW_SYSTEM */
1661 /***********************************************************************
1663 ***********************************************************************/
1665 /* An enumerator for each field of an XLFD font name. */
1686 /* An enumerator for each possible slant value of a font. Taken from
1687 the XLFD specification. */
1695 XLFD_SLANT_REVERSE_ITALIC
,
1696 XLFD_SLANT_REVERSE_OBLIQUE
,
1700 /* Relative font weight according to XLFD documentation. */
1704 XLFD_WEIGHT_UNKNOWN
,
1705 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1706 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1707 XLFD_WEIGHT_LIGHT
, /* 30 */
1708 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1709 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1710 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1711 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1712 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1713 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1716 /* Relative proportionate width. */
1720 XLFD_SWIDTH_UNKNOWN
,
1721 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1722 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1723 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1724 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1725 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1726 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1727 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1728 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1729 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1732 /* Structure used for tables mapping XLFD weight, slant, and width
1733 names to numeric and symbolic values. */
1739 Lisp_Object
*symbol
;
1742 /* Table of XLFD slant names and their numeric and symbolic
1743 representations. This table must be sorted by slant names in
1746 static struct table_entry slant_table
[] =
1748 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1749 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1750 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1751 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1752 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1753 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1756 /* Table of XLFD weight names. This table must be sorted by weight
1757 names in ascending order. */
1759 static struct table_entry weight_table
[] =
1761 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1762 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1763 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1764 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1765 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1766 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1767 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1768 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1769 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1770 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1771 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1772 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1773 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1774 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1775 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1778 /* Table of XLFD width names. This table must be sorted by width
1779 names in ascending order. */
1781 static struct table_entry swidth_table
[] =
1783 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1784 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1785 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1786 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1787 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1788 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1789 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1790 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1791 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1792 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1793 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1794 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1795 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1796 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1797 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1800 /* Structure used to hold the result of splitting font names in XLFD
1801 format into their fields. */
1805 /* The original name which is modified destructively by
1806 split_font_name. The pointer is kept here to be able to free it
1807 if it was allocated from the heap. */
1810 /* Font name fields. Each vector element points into `name' above.
1811 Fields are NUL-terminated. */
1812 char *fields
[XLFD_LAST
];
1814 /* Numeric values for those fields that interest us. See
1815 split_font_name for which these are. */
1816 int numeric
[XLFD_LAST
];
1819 /* The frame in effect when sorting font names. Set temporarily in
1820 sort_fonts so that it is available in font comparison functions. */
1822 static struct frame
*font_frame
;
1824 /* Order by which font selection chooses fonts. The default values
1825 mean `first, find a best match for the font width, then for the
1826 font height, then for weight, then for slant.' This variable can be
1827 set via set-face-font-sort-order. */
1830 static int font_sort_order
[4] = { XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
};
1832 static int font_sort_order
[4];
1835 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1836 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1837 is a pointer to the matching table entry or null if no table entry
1840 static struct table_entry
*
1841 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1842 struct table_entry
*table
;
1844 struct font_name
*font
;
1847 /* Function split_font_name converts fields to lower-case, so there
1848 is no need to use xstrlwr or xstricmp here. */
1849 char *s
= font
->fields
[field_index
];
1850 int low
, mid
, high
, cmp
;
1857 mid
= (low
+ high
) / 2;
1858 cmp
= strcmp (table
[mid
].name
, s
);
1872 /* Return a numeric representation for font name field
1873 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1874 has DIM entries. Value is the numeric value found or DFLT if no
1875 table entry matches. This function is used to translate weight,
1876 slant, and swidth names of XLFD font names to numeric values. */
1879 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1880 struct table_entry
*table
;
1882 struct font_name
*font
;
1886 struct table_entry
*p
;
1887 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1888 return p
? p
->numeric
: dflt
;
1892 /* Return a symbolic representation for font name field
1893 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1894 has DIM entries. Value is the symbolic value found or DFLT if no
1895 table entry matches. This function is used to translate weight,
1896 slant, and swidth names of XLFD font names to symbols. */
1898 static INLINE Lisp_Object
1899 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1900 struct table_entry
*table
;
1902 struct font_name
*font
;
1906 struct table_entry
*p
;
1907 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1908 return p
? *p
->symbol
: dflt
;
1912 /* Return a numeric value for the slant of the font given by FONT. */
1915 xlfd_numeric_slant (font
)
1916 struct font_name
*font
;
1918 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1919 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1923 /* Return a symbol representing the weight of the font given by FONT. */
1925 static INLINE Lisp_Object
1926 xlfd_symbolic_slant (font
)
1927 struct font_name
*font
;
1929 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1930 font
, XLFD_SLANT
, Qnormal
);
1934 /* Return a numeric value for the weight of the font given by FONT. */
1937 xlfd_numeric_weight (font
)
1938 struct font_name
*font
;
1940 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1941 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1945 /* Return a symbol representing the slant of the font given by FONT. */
1947 static INLINE Lisp_Object
1948 xlfd_symbolic_weight (font
)
1949 struct font_name
*font
;
1951 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1952 font
, XLFD_WEIGHT
, Qnormal
);
1956 /* Return a numeric value for the swidth of the font whose XLFD font
1957 name fields are found in FONT. */
1960 xlfd_numeric_swidth (font
)
1961 struct font_name
*font
;
1963 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1964 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1968 /* Return a symbolic value for the swidth of FONT. */
1970 static INLINE Lisp_Object
1971 xlfd_symbolic_swidth (font
)
1972 struct font_name
*font
;
1974 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1975 font
, XLFD_SWIDTH
, Qnormal
);
1979 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1980 entries. Value is a pointer to the matching table entry or null if
1981 no element of TABLE contains SYMBOL. */
1983 static struct table_entry
*
1984 face_value (table
, dim
, symbol
)
1985 struct table_entry
*table
;
1991 xassert (SYMBOLP (symbol
));
1993 for (i
= 0; i
< dim
; ++i
)
1994 if (EQ (*table
[i
].symbol
, symbol
))
1997 return i
< dim
? table
+ i
: NULL
;
2001 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2002 entries. Value is -1 if SYMBOL is not found in TABLE. */
2005 face_numeric_value (table
, dim
, symbol
)
2006 struct table_entry
*table
;
2010 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2011 return p
? p
->numeric
: -1;
2015 /* Return a numeric value representing the weight specified by Lisp
2016 symbol WEIGHT. Value is one of the enumerators of enum
2020 face_numeric_weight (weight
)
2023 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2027 /* Return a numeric value representing the slant specified by Lisp
2028 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2031 face_numeric_slant (slant
)
2034 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2038 /* Return a numeric value representing the swidth specified by Lisp
2039 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2042 face_numeric_swidth (width
)
2045 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2049 #ifdef HAVE_WINDOW_SYSTEM
2051 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2055 struct font_name
*font
;
2057 /* Function split_font_name converts fields to lower-case, so there
2058 is no need to use tolower here. */
2059 return *font
->fields
[XLFD_SPACING
] != 'p';
2063 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2065 The actual height of the font when displayed on F depends on the
2066 resolution of both the font and frame. For example, a 10pt font
2067 designed for a 100dpi display will display larger than 10pt on a
2068 75dpi display. (It's not unusual to use fonts not designed for the
2069 display one is using. For example, some intlfonts are available in
2070 72dpi versions, only.)
2072 Value is the real point size of FONT on frame F, or 0 if it cannot
2076 xlfd_point_size (f
, font
)
2078 struct font_name
*font
;
2080 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2081 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2082 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2085 if (font_resy
== 0 || font_pt
== 0)
2088 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2094 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2095 of frame F. This function is used to guess a point size of font
2096 when only the pixel height of the font is available. */
2099 pixel_point_size (f
, pixel
)
2103 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2107 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2108 real_pt
= pixel
* 72 / resy
;
2109 int_pt
= real_pt
+ 0.5;
2115 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2116 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2117 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2118 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2119 zero if the font name doesn't have the format we expect. The
2120 expected format is a font name that starts with a `-' and has
2121 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2122 forms of font names where certain field contents are enclosed in
2123 square brackets. We don't support that, for now. */
2126 split_font_name (f
, font
, numeric_p
)
2128 struct font_name
*font
;
2134 if (*font
->name
== '-')
2136 char *p
= xstrlwr (font
->name
) + 1;
2138 while (i
< XLFD_LAST
)
2140 font
->fields
[i
] = p
;
2143 while (*p
&& *p
!= '-')
2153 success_p
= i
== XLFD_LAST
;
2155 /* If requested, and font name was in the expected format,
2156 compute numeric values for some fields. */
2157 if (numeric_p
&& success_p
)
2159 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2160 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2161 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2162 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2163 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2170 /* Build an XLFD font name from font name fields in FONT. Value is a
2171 pointer to the font name, which is allocated via xmalloc. */
2174 build_font_name (font
)
2175 struct font_name
*font
;
2179 char *font_name
= (char *) xmalloc (size
);
2180 int total_length
= 0;
2182 for (i
= 0; i
< XLFD_LAST
; ++i
)
2184 /* Add 1 because of the leading `-'. */
2185 int len
= strlen (font
->fields
[i
]) + 1;
2187 /* Reallocate font_name if necessary. Add 1 for the final
2189 if (total_length
+ len
+ 1 >= size
)
2191 int new_size
= max (2 * size
, size
+ len
+ 1);
2192 int sz
= new_size
* sizeof *font_name
;
2193 font_name
= (char *) xrealloc (font_name
, sz
);
2197 font_name
[total_length
] = '-';
2198 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2199 total_length
+= len
;
2202 font_name
[total_length
] = 0;
2207 /* Free an array FONTS of N font_name structures. This frees FONTS
2208 itself and all `name' fields in its elements. */
2211 free_font_names (fonts
, n
)
2212 struct font_name
*fonts
;
2216 xfree (fonts
[--n
].name
);
2221 /* Sort vector FONTS of font_name structures which contains NFONTS
2222 elements using qsort and comparison function CMPFN. F is the frame
2223 on which the fonts will be used. The global variable font_frame
2224 is temporarily set to F to make it available in CMPFN. */
2227 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2229 struct font_name
*fonts
;
2231 int (*cmpfn
) P_ ((const void *, const void *));
2234 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2239 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2240 display in x_display_list. FONTS is a pointer to a vector of
2241 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2242 alternative patterns from Valternate_fontname_alist if no fonts are
2243 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2246 For all fonts found, set FONTS[i].name to the name of the font,
2247 allocated via xmalloc, and split font names into fields. Ignore
2248 fonts that we can't parse. Value is the number of fonts found.
2250 This is similar to x_list_fonts. The differences are:
2252 1. It avoids consing.
2253 2. It never calls XLoadQueryFont. */
2256 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2260 struct font_name
*fonts
;
2261 int nfonts
, try_alternatives_p
;
2262 int scalable_fonts_p
;
2266 #ifdef HAVE_X_WINDOWS
2267 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2269 /* Get the list of fonts matching PATTERN from the X server. */
2271 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2273 #endif /* HAVE_X_WINDOWS */
2274 #if defined (WINDOWSNT) || defined (macintosh)
2275 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2276 better to do it the other way around. */
2278 Lisp_Object lpattern
, tem
;
2283 lpattern
= build_string (pattern
);
2285 /* Get the list of fonts matching PATTERN. */
2288 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2289 #else /* macintosh */
2290 lfonts
= x_list_fonts (f
, lpattern
, 0, nfonts
);
2294 /* Count fonts returned */
2295 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2298 /* Allocate array. */
2300 names
= (char **) xmalloc (n
* sizeof (char *));
2302 /* Extract font names into char * array. */
2304 for (i
= 0; i
< n
; i
++)
2306 names
[i
] = XSTRING (XCAR (tem
))->data
;
2309 #endif /* defined (WINDOWSNT) || defined (macintosh) */
2313 /* Make a copy of the font names we got from X, and
2314 split them into fields. */
2315 for (i
= j
= 0; i
< n
; ++i
)
2317 /* Make a copy of the font name. */
2318 fonts
[j
].name
= xstrdup (names
[i
]);
2320 /* Ignore fonts having a name that we can't parse. */
2321 if (!split_font_name (f
, fonts
+ j
, 1))
2322 xfree (fonts
[j
].name
);
2323 else if (font_scalable_p (fonts
+ j
))
2325 if (!scalable_fonts_p
2326 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2327 xfree (fonts
[j
].name
);
2337 #ifdef HAVE_X_WINDOWS
2338 /* Free font names. */
2340 XFreeFontNames (names
);
2346 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2347 if (n
== 0 && try_alternatives_p
)
2349 Lisp_Object list
= Valternate_fontname_alist
;
2351 while (CONSP (list
))
2353 Lisp_Object entry
= XCAR (list
);
2355 && STRINGP (XCAR (entry
))
2356 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2363 Lisp_Object patterns
= XCAR (list
);
2366 while (CONSP (patterns
)
2367 /* If list is screwed up, give up. */
2368 && (name
= XCAR (patterns
),
2370 /* Ignore patterns equal to PATTERN because we tried that
2371 already with no success. */
2372 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2373 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2377 patterns
= XCDR (patterns
);
2385 /* Determine the first font matching PATTERN on frame F. Return in
2386 *FONT the matching font name, split into fields. Value is non-zero
2387 if a match was found. */
2390 first_font_matching (f
, pattern
, font
)
2393 struct font_name
*font
;
2396 struct font_name
*fonts
;
2398 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2399 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2403 bcopy (&fonts
[0], font
, sizeof *font
);
2405 fonts
[0].name
= NULL
;
2406 free_font_names (fonts
, nfonts
);
2413 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2414 using comparison function CMPFN. Value is the number of fonts
2415 found. If value is non-zero, *FONTS is set to a vector of
2416 font_name structures allocated from the heap containing matching
2417 fonts. Each element of *FONTS contains a name member that is also
2418 allocated from the heap. Font names in these structures are split
2419 into fields. Use free_font_names to free such an array. */
2422 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2425 int (*cmpfn
) P_ ((const void *, const void *));
2426 struct font_name
**fonts
;
2430 /* Get the list of fonts matching pattern. 100 should suffice. */
2431 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2432 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2433 nfonts
= XFASTINT (Vfont_list_limit
);
2435 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2436 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2438 /* Sort the resulting array and return it in *FONTS. If no
2439 fonts were found, make sure to set *FONTS to null. */
2441 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2452 /* Compare two font_name structures *A and *B. Value is analogous to
2453 strcmp. Sort order is given by the global variable
2454 font_sort_order. Font names are sorted so that, everything else
2455 being equal, fonts with a resolution closer to that of the frame on
2456 which they are used are listed first. The global variable
2457 font_frame is the frame on which we operate. */
2460 cmp_font_names (a
, b
)
2463 struct font_name
*x
= (struct font_name
*) a
;
2464 struct font_name
*y
= (struct font_name
*) b
;
2467 /* All strings have been converted to lower-case by split_font_name,
2468 so we can use strcmp here. */
2469 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2474 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2476 int j
= font_sort_order
[i
];
2477 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2482 /* Everything else being equal, we prefer fonts with an
2483 y-resolution closer to that of the frame. */
2484 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2485 int x_resy
= x
->numeric
[XLFD_RESY
];
2486 int y_resy
= y
->numeric
[XLFD_RESY
];
2487 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2495 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2496 is non-nil list fonts matching that pattern. Otherwise, if
2497 REGISTRY is non-nil return only fonts with that registry, otherwise
2498 return fonts of any registry. Set *FONTS to a vector of font_name
2499 structures allocated from the heap containing the fonts found.
2500 Value is the number of fonts found. */
2503 font_list (f
, pattern
, family
, registry
, fonts
)
2505 Lisp_Object pattern
, family
, registry
;
2506 struct font_name
**fonts
;
2508 char *pattern_str
, *family_str
, *registry_str
;
2512 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2513 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2515 pattern_str
= (char *) alloca (strlen (family_str
)
2516 + strlen (registry_str
)
2518 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2519 strcat (pattern_str
, family_str
);
2520 strcat (pattern_str
, "-*-");
2521 strcat (pattern_str
, registry_str
);
2522 if (!index (registry_str
, '-'))
2524 if (registry_str
[strlen (registry_str
) - 1] == '*')
2525 strcat (pattern_str
, "-*");
2527 strcat (pattern_str
, "*-*");
2531 pattern_str
= (char *) XSTRING (pattern
)->data
;
2533 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2537 /* Remove elements from LIST whose cars are `equal'. Called from
2538 x-family-fonts and x-font-family-list to remove duplicate font
2542 remove_duplicates (list
)
2545 Lisp_Object tail
= list
;
2547 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2549 Lisp_Object next
= XCDR (tail
);
2550 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2551 XCDR (tail
) = XCDR (next
);
2558 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2559 "Return a list of available fonts of family FAMILY on FRAME.\n\
2560 If FAMILY is omitted or nil, list all families.\n\
2561 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2563 If FRAME is omitted or nil, use the selected frame.\n\
2564 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2565 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2566 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2567 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2568 width, weight and slant of the font. These symbols are the same as for\n\
2569 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2570 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2571 giving the registry and encoding of the font.\n\
2572 The result list is sorted according to the current setting of\n\
2573 the face font sort order.")
2575 Lisp_Object family
, frame
;
2577 struct frame
*f
= check_x_frame (frame
);
2578 struct font_name
*fonts
;
2581 struct gcpro gcpro1
;
2584 CHECK_STRING (family
, 1);
2588 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2589 for (i
= nfonts
- 1; i
>= 0; --i
)
2591 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2594 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2595 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2596 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2597 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2598 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2599 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2600 tem
= build_font_name (fonts
+ i
);
2601 ASET (v
, 6, build_string (tem
));
2602 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2603 fonts
[i
].fields
[XLFD_ENCODING
]);
2604 ASET (v
, 7, build_string (tem
));
2607 result
= Fcons (v
, result
);
2610 remove_duplicates (result
);
2611 free_font_names (fonts
, nfonts
);
2617 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2619 "Return a list of available font families on FRAME.\n\
2620 If FRAME is omitted or nil, use the selected frame.\n\
2621 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2622 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2627 struct frame
*f
= check_x_frame (frame
);
2629 struct font_name
*fonts
;
2631 struct gcpro gcpro1
;
2632 int count
= specpdl_ptr
- specpdl
;
2635 /* Let's consider all fonts. Increase the limit for matching
2636 fonts until we have them all. */
2639 specbind (intern ("font-list-limit"), make_number (limit
));
2640 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2642 if (nfonts
== limit
)
2644 free_font_names (fonts
, nfonts
);
2653 for (i
= nfonts
- 1; i
>= 0; --i
)
2654 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2655 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2658 remove_duplicates (result
);
2659 free_font_names (fonts
, nfonts
);
2661 return unbind_to (count
, result
);
2665 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2666 "Return a list of the names of available fonts matching PATTERN.\n\
2667 If optional arguments FACE and FRAME are specified, return only fonts\n\
2668 the same size as FACE on FRAME.\n\
2669 PATTERN is a string, perhaps with wildcard characters;\n\
2670 the * character matches any substring, and\n\
2671 the ? character matches any single character.\n\
2672 PATTERN is case-insensitive.\n\
2673 FACE is a face name--a symbol.\n\
2675 The return value is a list of strings, suitable as arguments to\n\
2678 Fonts Emacs can't use may or may not be excluded\n\
2679 even if they match PATTERN and FACE.\n\
2680 The optional fourth argument MAXIMUM sets a limit on how many\n\
2681 fonts to match. The first MAXIMUM fonts are reported.\n\
2682 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2683 occupied by a character of a font. In that case, return only fonts\n\
2684 the WIDTH times as wide as FACE on FRAME.")
2685 (pattern
, face
, frame
, maximum
, width
)
2686 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2693 CHECK_STRING (pattern
, 0);
2699 CHECK_NATNUM (maximum
, 0);
2700 maxnames
= XINT (maximum
);
2704 CHECK_NUMBER (width
, 4);
2706 /* We can't simply call check_x_frame because this function may be
2707 called before any frame is created. */
2708 f
= frame_or_selected_frame (frame
, 2);
2709 if (!FRAME_WINDOW_P (f
))
2711 /* Perhaps we have not yet created any frame. */
2716 /* Determine the width standard for comparison with the fonts we find. */
2722 /* This is of limited utility since it works with character
2723 widths. Keep it for compatibility. --gerd. */
2724 int face_id
= lookup_named_face (f
, face
, 0);
2725 struct face
*face
= FACE_FROM_ID (f
, face_id
);
2728 size
= FONT_WIDTH (face
->font
);
2730 size
= FONT_WIDTH (FRAME_FONT (f
));
2733 size
*= XINT (width
);
2737 Lisp_Object args
[2];
2739 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2741 /* We don't have to check fontsets. */
2743 args
[1] = list_fontsets (f
, pattern
, size
);
2744 return Fnconc (2, args
);
2748 #endif /* HAVE_WINDOW_SYSTEM */
2752 /***********************************************************************
2754 ***********************************************************************/
2756 /* Access face attributes of face FACE, a Lisp vector. */
2758 #define LFACE_FAMILY(LFACE) \
2759 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2760 #define LFACE_HEIGHT(LFACE) \
2761 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2762 #define LFACE_WEIGHT(LFACE) \
2763 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2764 #define LFACE_SLANT(LFACE) \
2765 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2766 #define LFACE_UNDERLINE(LFACE) \
2767 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2768 #define LFACE_INVERSE(LFACE) \
2769 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2770 #define LFACE_FOREGROUND(LFACE) \
2771 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2772 #define LFACE_BACKGROUND(LFACE) \
2773 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2774 #define LFACE_STIPPLE(LFACE) \
2775 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2776 #define LFACE_SWIDTH(LFACE) \
2777 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2778 #define LFACE_OVERLINE(LFACE) \
2779 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2780 #define LFACE_STRIKE_THROUGH(LFACE) \
2781 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2782 #define LFACE_BOX(LFACE) \
2783 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2784 #define LFACE_FONT(LFACE) \
2785 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2786 #define LFACE_INHERIT(LFACE) \
2787 XVECTOR (LFACE)->contents[LFACE_INHERIT_INDEX]
2789 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2790 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2792 #define LFACEP(LFACE) \
2794 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2795 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2800 /* Check consistency of Lisp face attribute vector ATTRS. */
2803 check_lface_attrs (attrs
)
2806 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2807 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2808 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2809 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2810 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2811 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2812 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2813 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2814 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2815 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2816 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2817 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2818 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2819 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2820 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2821 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2822 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2823 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2824 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2825 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2826 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2827 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2828 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2829 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2830 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2831 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2832 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2833 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2834 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2835 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2836 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2837 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2838 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2839 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2840 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2841 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2842 #ifdef HAVE_WINDOW_SYSTEM
2843 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2844 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2845 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2846 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2847 || NILP (attrs
[LFACE_FONT_INDEX
])
2848 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2853 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2861 xassert (LFACEP (lface
));
2862 check_lface_attrs (XVECTOR (lface
)->contents
);
2866 #else /* GLYPH_DEBUG == 0 */
2868 #define check_lface_attrs(attrs) (void) 0
2869 #define check_lface(lface) (void) 0
2871 #endif /* GLYPH_DEBUG == 0 */
2874 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2875 to make it a symvol. If FACE_NAME is an alias for another face,
2876 return that face's name. */
2879 resolve_face_name (face_name
)
2880 Lisp_Object face_name
;
2882 Lisp_Object aliased
;
2884 if (STRINGP (face_name
))
2885 face_name
= intern (XSTRING (face_name
)->data
);
2889 aliased
= Fget (face_name
, Qface_alias
);
2893 face_name
= aliased
;
2900 /* Return the face definition of FACE_NAME on frame F. F null means
2901 return the global definition. FACE_NAME may be a string or a
2902 symbol (apparently Emacs 20.2 allows strings as face names in face
2903 text properties; ediff uses that). If FACE_NAME is an alias for
2904 another face, return that face's definition. If SIGNAL_P is
2905 non-zero, signal an error if FACE_NAME is not a valid face name.
2906 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2909 static INLINE Lisp_Object
2910 lface_from_face_name (f
, face_name
, signal_p
)
2912 Lisp_Object face_name
;
2917 face_name
= resolve_face_name (face_name
);
2920 lface
= assq_no_quit (face_name
, f
->face_alist
);
2922 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2925 lface
= XCDR (lface
);
2927 signal_error ("Invalid face", face_name
);
2929 check_lface (lface
);
2934 /* Get face attributes of face FACE_NAME from frame-local faces on
2935 frame F. Store the resulting attributes in ATTRS which must point
2936 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2937 is non-zero, signal an error if FACE_NAME does not name a face.
2938 Otherwise, value is zero if FACE_NAME is not a face. */
2941 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2943 Lisp_Object face_name
;
2950 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2953 bcopy (XVECTOR (lface
)->contents
, attrs
,
2954 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2964 /* Non-zero if all attributes in face attribute vector ATTRS are
2965 specified, i.e. are non-nil. */
2968 lface_fully_specified_p (attrs
)
2973 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2974 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2975 if (UNSPECIFIEDP (attrs
[i
]))
2978 return i
== LFACE_VECTOR_SIZE
;
2981 #ifdef HAVE_WINDOW_SYSTEM
2983 /* Set font-related attributes of Lisp face LFACE from the fullname of
2984 the font opened by FONTNAME. If FORCE_P is zero, set only
2985 unspecified attributes of LFACE. The exception is `font'
2986 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2988 If FONTNAME is not available on frame F,
2989 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2990 If the fullname is not in a valid XLFD format,
2991 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2992 in LFACE and return 1.
2993 Otherwise, return 1. */
2996 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
2999 Lisp_Object fontname
;
3000 int force_p
, may_fail_p
;
3002 struct font_name font
;
3007 char *font_name
= XSTRING (fontname
)->data
;
3008 struct font_info
*font_info
;
3010 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3011 fontset
= fs_query_fontset (fontname
, 0);
3013 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3015 /* Check if FONT_NAME is surely available on the system. Usually
3016 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3017 returns quickly. But, even if FONT_NAME is not yet cached,
3018 caching it now is not futail because we anyway load the font
3021 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3031 font
.name
= STRDUPA (font_info
->full_name
);
3032 have_xlfd_p
= split_font_name (f
, &font
, 1);
3034 /* Set attributes only if unspecified, otherwise face defaults for
3035 new frames would never take effect. If we couldn't get a font
3036 name conforming to XLFD, set normal values. */
3038 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3043 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3044 + strlen (font
.fields
[XLFD_FOUNDRY
])
3046 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3047 font
.fields
[XLFD_FAMILY
]);
3048 val
= build_string (buffer
);
3051 val
= build_string ("*");
3052 LFACE_FAMILY (lface
) = val
;
3055 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3058 pt
= xlfd_point_size (f
, &font
);
3060 pt
= pixel_point_size (f
, font_info
->height
* 10);
3062 LFACE_HEIGHT (lface
) = make_number (pt
);
3065 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3066 LFACE_SWIDTH (lface
)
3067 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3069 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3070 LFACE_WEIGHT (lface
)
3071 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3073 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3075 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3077 LFACE_FONT (lface
) = fontname
;
3082 #endif /* HAVE_WINDOW_SYSTEM */
3085 /* Merges the face height FROM with the face height TO, and returns the
3086 merged height. If FROM is an invalid height, then INVALID is
3087 returned instead. FROM may be a either an absolute face height or a
3088 `relative' height, and TO must be an absolute height. The returned
3089 value is always an absolute height. GCPRO is a lisp value that will
3090 be protected from garbage-collection if this function makes a call
3094 merge_face_heights (from
, to
, invalid
, gcpro
)
3095 Lisp_Object from
, to
, invalid
, gcpro
;
3099 if (INTEGERP (from
))
3100 result
= XINT (from
);
3101 else if (NUMBERP (from
))
3102 result
= XFLOATINT (from
) * XINT (to
);
3103 #if 0 /* Probably not so useful. */
3104 else if (CONSP (from
) && CONSP (XCDR (from
)))
3106 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3108 if (INTEGERP (XCAR (XCDR (from
))))
3110 int inc
= XINT (XCAR (XCDR (from
)));
3111 if (EQ (XCAR (from
), Qminus
))
3114 result
= XFASTINT (to
);
3115 if (result
+ inc
> 0)
3116 /* Note that `underflows' don't mean FROM is invalid, so
3117 we just pin the result at TO if it would otherwise be
3124 else if (FUNCTIONP (from
))
3126 /* Call function with current height as argument.
3127 From is the new height. */
3128 Lisp_Object args
[2], height
;
3129 struct gcpro gcpro1
;
3135 height
= safe_call (2, args
);
3139 if (NUMBERP (height
))
3140 result
= XFLOATINT (height
);
3144 return make_number (result
);
3150 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3151 store the resulting attributes in TO, which must be already be
3152 completely specified and contain only absolute attributes. Every
3153 specified attribute of FROM overrides the corresponding attribute of
3154 TO; relative attributes in FROM are merged with the absolute value in
3155 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3156 face inheritance; it should be Qnil when called from other places. */
3159 merge_face_vectors (f
, from
, to
, cycle_check
)
3161 Lisp_Object
*from
, *to
;
3162 Lisp_Object cycle_check
;
3166 /* If FROM inherits from some other faces, merge their attributes into
3167 TO before merging FROM's direct attributes. Note that an :inherit
3168 attribute of `unspecified' is the same as one of nil; we never
3169 merge :inherit attributes, so nil is more correct, but lots of
3170 other code uses `unspecified' as a generic value for face attributes. */
3171 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3172 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3173 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3175 /* If TO specifies a :font attribute, and FROM specifies some
3176 font-related attribute, we need to clear TO's :font attribute
3177 (because it will be inconsistent with whatever FROM specifies, and
3178 FROM takes precedence). */
3179 if (!NILP (to
[LFACE_FONT_INDEX
])
3180 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3181 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3182 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3183 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3184 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])))
3185 to
[LFACE_FONT_INDEX
] = Qnil
;
3187 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3188 if (!UNSPECIFIEDP (from
[i
]))
3189 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3190 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3194 /* TO is always an absolute face, which should inherit from nothing.
3195 We blindly copy the :inherit attribute above and fix it up here. */
3196 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3200 /* Checks the `cycle check' variable CHECK to see if it indicates that
3201 EL is part of a cycle; CHECK must be either Qnil or a value returned
3202 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3203 elements after which a cycle might be suspected; after that many
3204 elements, this macro begins consing in order to keep more precise
3207 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3210 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3211 the caller should make sure that's ok. */
3213 #define CYCLE_CHECK(check, el, suspicious) \
3216 : (INTEGERP (check) \
3217 ? (XFASTINT (check) < (suspicious) \
3218 ? make_number (XFASTINT (check) + 1) \
3219 : Fcons (el, Qnil)) \
3220 : (!NILP (Fmemq ((el), (check))) \
3222 : Fcons ((el), (check)))))
3225 /* Merge face attributes from the face on frame F whose name is
3226 INHERITS, into the vector of face attributes TO; INHERITS may also be
3227 a list of face names, in which case they are applied in order.
3228 CYCLE_CHECK is used to detect loops in face inheritance.
3229 Returns true if any of the inherited attributes are `font-related'. */
3232 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3234 Lisp_Object inherit
;
3236 Lisp_Object cycle_check
;
3238 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3239 /* Inherit from the named face INHERIT. */
3243 /* Make sure we're not in an inheritance loop. */
3244 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3245 if (NILP (cycle_check
))
3246 /* Cycle detected, ignore any further inheritance. */
3249 lface
= lface_from_face_name (f
, inherit
, 0);
3251 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3253 else if (CONSP (inherit
))
3254 /* Handle a list of inherited faces by calling ourselves recursively
3255 on each element. Note that we only do so for symbol elements, so
3256 it's not possible to infinitely recurse. */
3258 while (CONSP (inherit
))
3260 if (SYMBOLP (XCAR (inherit
)))
3261 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3263 /* Check for a circular inheritance list. */
3264 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3265 if (NILP (cycle_check
))
3266 /* Cycle detected. */
3269 inherit
= XCDR (inherit
);
3275 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3276 is a face property, determine the resulting face attributes on
3277 frame F, and store them in TO. PROP may be a single face
3278 specification or a list of such specifications. Each face
3279 specification can be
3281 1. A symbol or string naming a Lisp face.
3283 2. A property list of the form (KEYWORD VALUE ...) where each
3284 KEYWORD is a face attribute name, and value is an appropriate value
3287 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3288 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3289 for compatibility with 20.2.
3291 Face specifications earlier in lists take precedence over later
3295 merge_face_vector_with_property (f
, to
, prop
)
3302 Lisp_Object first
= XCAR (prop
);
3304 if (EQ (first
, Qforeground_color
)
3305 || EQ (first
, Qbackground_color
))
3307 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3308 . COLOR). COLOR must be a string. */
3309 Lisp_Object color_name
= XCDR (prop
);
3310 Lisp_Object color
= first
;
3312 if (STRINGP (color_name
))
3314 if (EQ (color
, Qforeground_color
))
3315 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3317 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3320 add_to_log ("Invalid face color", color_name
, Qnil
);
3322 else if (SYMBOLP (first
)
3323 && *XSYMBOL (first
)->name
->data
== ':')
3325 /* Assume this is the property list form. */
3326 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3328 Lisp_Object keyword
= XCAR (prop
);
3329 Lisp_Object value
= XCAR (XCDR (prop
));
3331 if (EQ (keyword
, QCfamily
))
3333 if (STRINGP (value
))
3334 to
[LFACE_FAMILY_INDEX
] = value
;
3336 add_to_log ("Invalid face font family", value
, Qnil
);
3338 else if (EQ (keyword
, QCheight
))
3340 Lisp_Object new_height
=
3341 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3344 if (NILP (new_height
))
3345 add_to_log ("Invalid face font height", value
, Qnil
);
3347 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3349 else if (EQ (keyword
, QCweight
))
3352 && face_numeric_weight (value
) >= 0)
3353 to
[LFACE_WEIGHT_INDEX
] = value
;
3355 add_to_log ("Invalid face weight", value
, Qnil
);
3357 else if (EQ (keyword
, QCslant
))
3360 && face_numeric_slant (value
) >= 0)
3361 to
[LFACE_SLANT_INDEX
] = value
;
3363 add_to_log ("Invalid face slant", value
, Qnil
);
3365 else if (EQ (keyword
, QCunderline
))
3370 to
[LFACE_UNDERLINE_INDEX
] = value
;
3372 add_to_log ("Invalid face underline", value
, Qnil
);
3374 else if (EQ (keyword
, QCoverline
))
3379 to
[LFACE_OVERLINE_INDEX
] = value
;
3381 add_to_log ("Invalid face overline", value
, Qnil
);
3383 else if (EQ (keyword
, QCstrike_through
))
3388 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3390 add_to_log ("Invalid face strike-through", value
, Qnil
);
3392 else if (EQ (keyword
, QCbox
))
3395 value
= make_number (1);
3396 if (INTEGERP (value
)
3400 to
[LFACE_BOX_INDEX
] = value
;
3402 add_to_log ("Invalid face box", value
, Qnil
);
3404 else if (EQ (keyword
, QCinverse_video
)
3405 || EQ (keyword
, QCreverse_video
))
3407 if (EQ (value
, Qt
) || NILP (value
))
3408 to
[LFACE_INVERSE_INDEX
] = value
;
3410 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3412 else if (EQ (keyword
, QCforeground
))
3414 if (STRINGP (value
))
3415 to
[LFACE_FOREGROUND_INDEX
] = value
;
3417 add_to_log ("Invalid face foreground", value
, Qnil
);
3419 else if (EQ (keyword
, QCbackground
))
3421 if (STRINGP (value
))
3422 to
[LFACE_BACKGROUND_INDEX
] = value
;
3424 add_to_log ("Invalid face background", value
, Qnil
);
3426 else if (EQ (keyword
, QCstipple
))
3428 #ifdef HAVE_X_WINDOWS
3429 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3430 if (!NILP (pixmap_p
))
3431 to
[LFACE_STIPPLE_INDEX
] = value
;
3433 add_to_log ("Invalid face stipple", value
, Qnil
);
3436 else if (EQ (keyword
, QCwidth
))
3439 && face_numeric_swidth (value
) >= 0)
3440 to
[LFACE_SWIDTH_INDEX
] = value
;
3442 add_to_log ("Invalid face width", value
, Qnil
);
3444 else if (EQ (keyword
, QCinherit
))
3446 if (SYMBOLP (value
))
3447 to
[LFACE_INHERIT_INDEX
] = value
;
3451 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3452 if (!SYMBOLP (XCAR (tail
)))
3455 to
[LFACE_INHERIT_INDEX
] = value
;
3457 add_to_log ("Invalid face inherit", value
, Qnil
);
3461 add_to_log ("Invalid attribute %s in face property",
3464 prop
= XCDR (XCDR (prop
));
3469 /* This is a list of face specs. Specifications at the
3470 beginning of the list take precedence over later
3471 specifications, so we have to merge starting with the
3472 last specification. */
3473 Lisp_Object next
= XCDR (prop
);
3475 merge_face_vector_with_property (f
, to
, next
);
3476 merge_face_vector_with_property (f
, to
, first
);
3481 /* PROP ought to be a face name. */
3482 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3484 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3486 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3491 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3492 Sinternal_make_lisp_face
, 1, 2, 0,
3493 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3494 If FACE was not known as a face before, create a new one.\n\
3495 If optional argument FRAME is specified, make a frame-local face\n\
3496 for that frame. Otherwise operate on the global face definition.\n\
3497 Value is a vector of face attributes.")
3499 Lisp_Object face
, frame
;
3501 Lisp_Object global_lface
, lface
;
3505 CHECK_SYMBOL (face
, 0);
3506 global_lface
= lface_from_face_name (NULL
, face
, 0);
3510 CHECK_LIVE_FRAME (frame
, 1);
3512 lface
= lface_from_face_name (f
, face
, 0);
3515 f
= NULL
, lface
= Qnil
;
3517 /* Add a global definition if there is none. */
3518 if (NILP (global_lface
))
3520 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3522 XVECTOR (global_lface
)->contents
[0] = Qface
;
3523 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3524 Vface_new_frame_defaults
);
3526 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3527 face id to Lisp face is given by the vector lface_id_to_name.
3528 The mapping from Lisp face to Lisp face id is given by the
3529 property `face' of the Lisp face name. */
3530 if (next_lface_id
== lface_id_to_name_size
)
3532 int new_size
= max (50, 2 * lface_id_to_name_size
);
3533 int sz
= new_size
* sizeof *lface_id_to_name
;
3534 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3535 lface_id_to_name_size
= new_size
;
3538 lface_id_to_name
[next_lface_id
] = face
;
3539 Fput (face
, Qface
, make_number (next_lface_id
));
3543 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3544 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3546 /* Add a frame-local definition. */
3551 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3553 XVECTOR (lface
)->contents
[0] = Qface
;
3554 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3557 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3558 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3561 lface
= global_lface
;
3563 xassert (LFACEP (lface
));
3564 check_lface (lface
);
3569 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3570 Sinternal_lisp_face_p
, 1, 2, 0,
3571 "Return non-nil if FACE names a face.\n\
3572 If optional second parameter FRAME is non-nil, check for the\n\
3573 existence of a frame-local face with name FACE on that frame.\n\
3574 Otherwise check for the existence of a global face.")
3576 Lisp_Object face
, frame
;
3582 CHECK_LIVE_FRAME (frame
, 1);
3583 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3586 lface
= lface_from_face_name (NULL
, face
, 0);
3592 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3593 Sinternal_copy_lisp_face
, 4, 4, 0,
3594 "Copy face FROM to TO.\n\
3595 If FRAME it t, copy the global face definition of FROM to the\n\
3596 global face definition of TO. Otherwise, copy the frame-local\n\
3597 definition of FROM on FRAME to the frame-local definition of TO\n\
3598 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3601 (from
, to
, frame
, new_frame
)
3602 Lisp_Object from
, to
, frame
, new_frame
;
3604 Lisp_Object lface
, copy
;
3606 CHECK_SYMBOL (from
, 0);
3607 CHECK_SYMBOL (to
, 1);
3608 if (NILP (new_frame
))
3613 /* Copy global definition of FROM. We don't make copies of
3614 strings etc. because 20.2 didn't do it either. */
3615 lface
= lface_from_face_name (NULL
, from
, 1);
3616 copy
= Finternal_make_lisp_face (to
, Qnil
);
3620 /* Copy frame-local definition of FROM. */
3621 CHECK_LIVE_FRAME (frame
, 2);
3622 CHECK_LIVE_FRAME (new_frame
, 3);
3623 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3624 copy
= Finternal_make_lisp_face (to
, new_frame
);
3627 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3628 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3634 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3635 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3636 "Set attribute ATTR of FACE to VALUE.\n\
3637 FRAME being a frame means change the face on that frame.\n\
3638 FRAME nil means change change the face of the selected frame.\n\
3639 FRAME t means change the default for new frames.\n\
3640 FRAME 0 means change the face on all frames, and change the default\n\
3642 (face
, attr
, value
, frame
)
3643 Lisp_Object face
, attr
, value
, frame
;
3646 Lisp_Object old_value
= Qnil
;
3647 /* Set 1 if ATTR is QCfont. */
3648 int font_attr_p
= 0;
3649 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3650 int font_related_attr_p
= 0;
3652 CHECK_SYMBOL (face
, 0);
3653 CHECK_SYMBOL (attr
, 1);
3655 face
= resolve_face_name (face
);
3657 /* If FRAME is 0, change face on all frames, and change the
3658 default for new frames. */
3659 if (INTEGERP (frame
) && XINT (frame
) == 0)
3662 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3663 FOR_EACH_FRAME (tail
, frame
)
3664 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3668 /* Set lface to the Lisp attribute vector of FACE. */
3670 lface
= lface_from_face_name (NULL
, face
, 1);
3674 frame
= selected_frame
;
3676 CHECK_LIVE_FRAME (frame
, 3);
3677 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3679 /* If a frame-local face doesn't exist yet, create one. */
3681 lface
= Finternal_make_lisp_face (face
, frame
);
3684 if (EQ (attr
, QCfamily
))
3686 if (!UNSPECIFIEDP (value
))
3688 CHECK_STRING (value
, 3);
3689 if (XSTRING (value
)->size
== 0)
3690 signal_error ("Invalid face family", value
);
3692 old_value
= LFACE_FAMILY (lface
);
3693 LFACE_FAMILY (lface
) = value
;
3694 font_related_attr_p
= 1;
3696 else if (EQ (attr
, QCheight
))
3698 if (!UNSPECIFIEDP (value
))
3701 (EQ (face
, Qdefault
) ? value
:
3702 /* The default face must have an absolute size, otherwise, we do
3703 a test merge with a random height to see if VALUE's ok. */
3704 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3706 if (!INTEGERP(test
) || XINT(test
) <= 0)
3707 signal_error ("Invalid face height", value
);
3710 old_value
= LFACE_HEIGHT (lface
);
3711 LFACE_HEIGHT (lface
) = value
;
3712 font_related_attr_p
= 1;
3714 else if (EQ (attr
, QCweight
))
3716 if (!UNSPECIFIEDP (value
))
3718 CHECK_SYMBOL (value
, 3);
3719 if (face_numeric_weight (value
) < 0)
3720 signal_error ("Invalid face weight", value
);
3722 old_value
= LFACE_WEIGHT (lface
);
3723 LFACE_WEIGHT (lface
) = value
;
3724 font_related_attr_p
= 1;
3726 else if (EQ (attr
, QCslant
))
3728 if (!UNSPECIFIEDP (value
))
3730 CHECK_SYMBOL (value
, 3);
3731 if (face_numeric_slant (value
) < 0)
3732 signal_error ("Invalid face slant", value
);
3734 old_value
= LFACE_SLANT (lface
);
3735 LFACE_SLANT (lface
) = value
;
3736 font_related_attr_p
= 1;
3738 else if (EQ (attr
, QCunderline
))
3740 if (!UNSPECIFIEDP (value
))
3741 if ((SYMBOLP (value
)
3743 && !EQ (value
, Qnil
))
3744 /* Underline color. */
3746 && XSTRING (value
)->size
== 0))
3747 signal_error ("Invalid face underline", value
);
3749 old_value
= LFACE_UNDERLINE (lface
);
3750 LFACE_UNDERLINE (lface
) = value
;
3752 else if (EQ (attr
, QCoverline
))
3754 if (!UNSPECIFIEDP (value
))
3755 if ((SYMBOLP (value
)
3757 && !EQ (value
, Qnil
))
3758 /* Overline color. */
3760 && XSTRING (value
)->size
== 0))
3761 signal_error ("Invalid face overline", value
);
3763 old_value
= LFACE_OVERLINE (lface
);
3764 LFACE_OVERLINE (lface
) = value
;
3766 else if (EQ (attr
, QCstrike_through
))
3768 if (!UNSPECIFIEDP (value
))
3769 if ((SYMBOLP (value
)
3771 && !EQ (value
, Qnil
))
3772 /* Strike-through color. */
3774 && XSTRING (value
)->size
== 0))
3775 signal_error ("Invalid face strike-through", value
);
3777 old_value
= LFACE_STRIKE_THROUGH (lface
);
3778 LFACE_STRIKE_THROUGH (lface
) = value
;
3780 else if (EQ (attr
, QCbox
))
3784 /* Allow t meaning a simple box of width 1 in foreground color
3787 value
= make_number (1);
3789 if (UNSPECIFIEDP (value
))
3791 else if (NILP (value
))
3793 else if (INTEGERP (value
))
3794 valid_p
= XINT (value
) > 0;
3795 else if (STRINGP (value
))
3796 valid_p
= XSTRING (value
)->size
> 0;
3797 else if (CONSP (value
))
3813 if (EQ (k
, QCline_width
))
3815 if (!INTEGERP (v
) || XINT (v
) <= 0)
3818 else if (EQ (k
, QCcolor
))
3820 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3823 else if (EQ (k
, QCstyle
))
3825 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3832 valid_p
= NILP (tem
);
3838 signal_error ("Invalid face box", value
);
3840 old_value
= LFACE_BOX (lface
);
3841 LFACE_BOX (lface
) = value
;
3843 else if (EQ (attr
, QCinverse_video
)
3844 || EQ (attr
, QCreverse_video
))
3846 if (!UNSPECIFIEDP (value
))
3848 CHECK_SYMBOL (value
, 3);
3849 if (!EQ (value
, Qt
) && !NILP (value
))
3850 signal_error ("Invalid inverse-video face attribute value", value
);
3852 old_value
= LFACE_INVERSE (lface
);
3853 LFACE_INVERSE (lface
) = value
;
3855 else if (EQ (attr
, QCforeground
))
3857 if (!UNSPECIFIEDP (value
))
3859 /* Don't check for valid color names here because it depends
3860 on the frame (display) whether the color will be valid
3861 when the face is realized. */
3862 CHECK_STRING (value
, 3);
3863 if (XSTRING (value
)->size
== 0)
3864 signal_error ("Empty foreground color value", value
);
3866 old_value
= LFACE_FOREGROUND (lface
);
3867 LFACE_FOREGROUND (lface
) = value
;
3869 else if (EQ (attr
, QCbackground
))
3871 if (!UNSPECIFIEDP (value
))
3873 /* Don't check for valid color names here because it depends
3874 on the frame (display) whether the color will be valid
3875 when the face is realized. */
3876 CHECK_STRING (value
, 3);
3877 if (XSTRING (value
)->size
== 0)
3878 signal_error ("Empty background color value", value
);
3880 old_value
= LFACE_BACKGROUND (lface
);
3881 LFACE_BACKGROUND (lface
) = value
;
3883 else if (EQ (attr
, QCstipple
))
3885 #ifdef HAVE_X_WINDOWS
3886 if (!UNSPECIFIEDP (value
)
3888 && NILP (Fbitmap_spec_p (value
)))
3889 signal_error ("Invalid stipple attribute", value
);
3890 old_value
= LFACE_STIPPLE (lface
);
3891 LFACE_STIPPLE (lface
) = value
;
3892 #endif /* HAVE_X_WINDOWS */
3894 else if (EQ (attr
, QCwidth
))
3896 if (!UNSPECIFIEDP (value
))
3898 CHECK_SYMBOL (value
, 3);
3899 if (face_numeric_swidth (value
) < 0)
3900 signal_error ("Invalid face width", value
);
3902 old_value
= LFACE_SWIDTH (lface
);
3903 LFACE_SWIDTH (lface
) = value
;
3904 font_related_attr_p
= 1;
3906 else if (EQ (attr
, QCfont
))
3908 #ifdef HAVE_WINDOW_SYSTEM
3909 /* Set font-related attributes of the Lisp face from an
3914 CHECK_STRING (value
, 3);
3916 f
= SELECTED_FRAME ();
3918 f
= check_x_frame (frame
);
3920 /* VALUE may be a fontset name or an alias of fontset. In such
3921 a case, use the base fontset name. */
3922 tmp
= Fquery_fontset (value
, Qnil
);
3926 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3927 signal_error ("Invalid font or fontset name", value
);
3930 #endif /* HAVE_WINDOW_SYSTEM */
3932 else if (EQ (attr
, QCinherit
))
3935 if (SYMBOLP (value
))
3938 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3939 if (!SYMBOLP (XCAR (tail
)))
3942 LFACE_INHERIT (lface
) = value
;
3944 signal_error ("Invalid face inheritance", value
);
3946 else if (EQ (attr
, QCbold
))
3948 old_value
= LFACE_WEIGHT (lface
);
3949 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3950 font_related_attr_p
= 1;
3952 else if (EQ (attr
, QCitalic
))
3954 old_value
= LFACE_SLANT (lface
);
3955 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3956 font_related_attr_p
= 1;
3959 signal_error ("Invalid face attribute name", attr
);
3961 if (font_related_attr_p
3962 && !UNSPECIFIEDP (value
))
3963 /* If a font-related attribute other than QCfont is specified, the
3964 original `font' attribute nor that of default face is useless
3965 to determine a new font. Thus, we set it to nil so that font
3966 selection mechanism doesn't use it. */
3967 LFACE_FONT (lface
) = Qnil
;
3969 /* Changing a named face means that all realized faces depending on
3970 that face are invalid. Since we cannot tell which realized faces
3971 depend on the face, make sure they are all removed. This is done
3972 by incrementing face_change_count. The next call to
3973 init_iterator will then free realized faces. */
3975 && (EQ (attr
, QCfont
)
3976 || NILP (Fequal (old_value
, value
))))
3978 ++face_change_count
;
3979 ++windows_or_buffers_changed
;
3982 #ifdef HAVE_WINDOW_SYSTEM
3985 && !UNSPECIFIEDP (value
)
3986 && NILP (Fequal (old_value
, value
)))
3992 if (EQ (face
, Qdefault
))
3994 /* Changed font-related attributes of the `default' face are
3995 reflected in changed `font' frame parameters. */
3996 if ((font_related_attr_p
|| font_attr_p
)
3997 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
3998 set_font_frame_param (frame
, lface
);
3999 else if (EQ (attr
, QCforeground
))
4000 param
= Qforeground_color
;
4001 else if (EQ (attr
, QCbackground
))
4002 param
= Qbackground_color
;
4005 else if (EQ (face
, Qscroll_bar
))
4007 /* Changing the colors of `scroll-bar' sets frame parameters
4008 `scroll-bar-foreground' and `scroll-bar-background'. */
4009 if (EQ (attr
, QCforeground
))
4010 param
= Qscroll_bar_foreground
;
4011 else if (EQ (attr
, QCbackground
))
4012 param
= Qscroll_bar_background
;
4014 #endif /* not WINDOWSNT */
4015 else if (EQ (face
, Qborder
))
4017 /* Changing background color of `border' sets frame parameter
4019 if (EQ (attr
, QCbackground
))
4020 param
= Qborder_color
;
4022 else if (EQ (face
, Qcursor
))
4024 /* Changing background color of `cursor' sets frame parameter
4026 if (EQ (attr
, QCbackground
))
4027 param
= Qcursor_color
;
4029 else if (EQ (face
, Qmouse
))
4031 /* Changing background color of `mouse' sets frame parameter
4033 if (EQ (attr
, QCbackground
))
4034 param
= Qmouse_color
;
4040 cons
= XCAR (Vparam_value_alist
);
4041 XCAR (cons
) = param
;
4042 XCDR (cons
) = value
;
4043 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4047 #endif /* HAVE_WINDOW_SYSTEM */
4053 #ifdef HAVE_WINDOW_SYSTEM
4055 /* Set the `font' frame parameter of FRAME determined from `default'
4056 face attributes LFACE. If a face or fontset name is explicitely
4057 specfied in LFACE, use it as is. Otherwise, determine a font name
4058 from the other font-related atrributes of LFACE. In that case, if
4059 there's no matching font, signals an error. */
4062 set_font_frame_param (frame
, lface
)
4063 Lisp_Object frame
, lface
;
4065 struct frame
*f
= XFRAME (frame
);
4066 Lisp_Object font_name
;
4069 if (STRINGP (LFACE_FONT (lface
)))
4070 font_name
= LFACE_FONT (lface
);
4073 /* Choose a font name that reflects LFACE's attributes and has
4074 the registry and encoding pattern specified in the default
4075 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4076 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4078 error ("No font matches the specified attribute");
4079 font_name
= build_string (font
);
4083 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4087 /* Update the corresponding face when frame parameter PARAM on frame F
4088 has been assigned the value NEW_VALUE. */
4091 update_face_from_frame_parameter (f
, param
, new_value
)
4093 Lisp_Object param
, new_value
;
4097 /* If there are no faces yet, give up. This is the case when called
4098 from Fx_create_frame, and we do the necessary things later in
4099 face-set-after-frame-defaults. */
4100 if (NILP (f
->face_alist
))
4103 if (EQ (param
, Qforeground_color
))
4105 lface
= lface_from_face_name (f
, Qdefault
, 1);
4106 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4107 ? new_value
: Qunspecified
);
4108 realize_basic_faces (f
);
4110 else if (EQ (param
, Qbackground_color
))
4114 /* Changing the background color might change the background
4115 mode, so that we have to load new defface specs. Call
4116 frame-update-face-colors to do that. */
4117 XSETFRAME (frame
, f
);
4118 call1 (Qframe_update_face_colors
, frame
);
4120 lface
= lface_from_face_name (f
, Qdefault
, 1);
4121 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4122 ? new_value
: Qunspecified
);
4123 realize_basic_faces (f
);
4125 if (EQ (param
, Qborder_color
))
4127 lface
= lface_from_face_name (f
, Qborder
, 1);
4128 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4129 ? new_value
: Qunspecified
);
4131 else if (EQ (param
, Qcursor_color
))
4133 lface
= lface_from_face_name (f
, Qcursor
, 1);
4134 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4135 ? new_value
: Qunspecified
);
4137 else if (EQ (param
, Qmouse_color
))
4139 lface
= lface_from_face_name (f
, Qmouse
, 1);
4140 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4141 ? new_value
: Qunspecified
);
4146 /* Get the value of X resource RESOURCE, class CLASS for the display
4147 of frame FRAME. This is here because ordinary `x-get-resource'
4148 doesn't take a frame argument. */
4150 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4151 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4152 (resource
, class, frame
)
4153 Lisp_Object resource
, class, frame
;
4155 Lisp_Object value
= Qnil
;
4158 CHECK_STRING (resource
, 0);
4159 CHECK_STRING (class, 1);
4160 CHECK_LIVE_FRAME (frame
, 2);
4162 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4163 resource
, class, Qnil
, Qnil
);
4165 #endif /* not macintosh */
4166 #endif /* not WINDOWSNT */
4171 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4172 If VALUE is "on" or "true", return t. If VALUE is "off" or
4173 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4174 error; if SIGNAL_P is zero, return 0. */
4177 face_boolean_x_resource_value (value
, signal_p
)
4181 Lisp_Object result
= make_number (0);
4183 xassert (STRINGP (value
));
4185 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4186 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4188 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4189 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4191 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4192 result
= Qunspecified
;
4194 signal_error ("Invalid face attribute value from X resource", value
);
4200 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4201 Finternal_set_lisp_face_attribute_from_resource
,
4202 Sinternal_set_lisp_face_attribute_from_resource
,
4204 (face
, attr
, value
, frame
)
4205 Lisp_Object face
, attr
, value
, frame
;
4207 CHECK_SYMBOL (face
, 0);
4208 CHECK_SYMBOL (attr
, 1);
4209 CHECK_STRING (value
, 2);
4211 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4212 value
= Qunspecified
;
4213 else if (EQ (attr
, QCheight
))
4215 value
= Fstring_to_number (value
, make_number (10));
4216 if (XINT (value
) <= 0)
4217 signal_error ("Invalid face height from X resource", value
);
4219 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4220 value
= face_boolean_x_resource_value (value
, 1);
4221 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4222 value
= intern (XSTRING (value
)->data
);
4223 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4224 value
= face_boolean_x_resource_value (value
, 1);
4225 else if (EQ (attr
, QCunderline
)
4226 || EQ (attr
, QCoverline
)
4227 || EQ (attr
, QCstrike_through
)
4228 || EQ (attr
, QCbox
))
4230 Lisp_Object boolean_value
;
4232 /* If the result of face_boolean_x_resource_value is t or nil,
4233 VALUE does NOT specify a color. */
4234 boolean_value
= face_boolean_x_resource_value (value
, 0);
4235 if (SYMBOLP (boolean_value
))
4236 value
= boolean_value
;
4239 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4242 #endif /* HAVE_WINDOW_SYSTEM */
4245 #ifdef HAVE_X_WINDOWS
4246 /***********************************************************************
4248 ***********************************************************************/
4250 #ifdef USE_X_TOOLKIT
4252 #include "../lwlib/lwlib-utils.h"
4254 /* Structure used to pass X resources to functions called via
4255 XtApplyToWidgets. */
4266 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4267 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4270 /* Set widget W's X resources from P which points to an x_resources
4271 structure. If W is a cascade button, apply resources to W's
4275 xm_apply_resources (w
, p
)
4280 struct x_resources
*res
= (struct x_resources
*) p
;
4282 XtSetValues (w
, res
->av
, res
->ac
);
4283 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4286 XtSetValues (submenu
, res
->av
, res
->ac
);
4287 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4292 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4293 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4296 1. Setting the XmNfontList resource leads to an infinite loop
4297 somewhere in LessTif. */
4300 xm_set_menu_resources_from_menu_face (f
, widget
)
4310 lface
= lface_from_face_name (f
, Qmenu
, 1);
4311 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4313 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4315 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4319 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4321 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4325 /* If any font-related attribute of `menu' is set, set the font. */
4327 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4328 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4329 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4330 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4331 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4333 #if 0 /* Setting the font leads to an infinite loop somewhere
4334 in LessTif during geometry computation. */
4336 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4337 fl
= XmFontListAppendEntry (NULL
, fe
);
4338 XtSetArg (av
[ac
], XmNfontList
, fl
);
4343 xassert (ac
<= sizeof av
/ sizeof *av
);
4347 struct x_resources res
;
4349 XtSetValues (widget
, av
, ac
);
4350 res
.av
= av
, res
.ac
= ac
;
4351 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4353 XmFontListFree (fl
);
4357 #endif /* USE_MOTIF */
4361 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4362 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4365 /* Set widget W's resources from P which points to an x_resources
4369 xl_apply_resources (widget
, p
)
4373 struct x_resources
*res
= (struct x_resources
*) p
;
4374 XtSetValues (widget
, res
->av
, res
->ac
);
4378 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4379 This is the Lucid version. */
4382 xl_set_menu_resources_from_menu_face (f
, widget
)
4391 lface
= lface_from_face_name (f
, Qmenu
, 1);
4392 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4394 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4396 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4400 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4402 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4407 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4408 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4409 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4410 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4411 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4413 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4419 struct x_resources res
;
4421 XtSetValues (widget
, av
, ac
);
4423 /* We must do children here in case we're handling a pop-up menu
4424 in which case WIDGET is a popup shell. XtApplyToWidgets
4425 is a function from lwlib. */
4426 res
.av
= av
, res
.ac
= ac
;
4427 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4431 #endif /* USE_LUCID */
4434 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4437 x_set_menu_resources_from_menu_face (f
, widget
)
4441 /* Realized faces may have been removed on frame F, e.g. because of
4442 face attribute changes. Recompute them, if necessary, since we
4443 will need the `menu' face. */
4444 if (f
->face_cache
->used
== 0)
4445 recompute_basic_faces (f
);
4448 xl_set_menu_resources_from_menu_face (f
, widget
);
4451 xm_set_menu_resources_from_menu_face (f
, widget
);
4455 #endif /* USE_X_TOOLKIT */
4457 #endif /* HAVE_X_WINDOWS */
4461 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4462 Sinternal_get_lisp_face_attribute
,
4464 "Return face attribute KEYWORD of face SYMBOL.\n\
4465 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4466 face attribute name, signal an error.\n\
4467 If the optional argument FRAME is given, report on face FACE in that\n\
4468 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4469 frames). If FRAME is omitted or nil, use the selected frame.")
4470 (symbol
, keyword
, frame
)
4471 Lisp_Object symbol
, keyword
, frame
;
4473 Lisp_Object lface
, value
= Qnil
;
4475 CHECK_SYMBOL (symbol
, 0);
4476 CHECK_SYMBOL (keyword
, 1);
4479 lface
= lface_from_face_name (NULL
, symbol
, 1);
4483 frame
= selected_frame
;
4484 CHECK_LIVE_FRAME (frame
, 2);
4485 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4488 if (EQ (keyword
, QCfamily
))
4489 value
= LFACE_FAMILY (lface
);
4490 else if (EQ (keyword
, QCheight
))
4491 value
= LFACE_HEIGHT (lface
);
4492 else if (EQ (keyword
, QCweight
))
4493 value
= LFACE_WEIGHT (lface
);
4494 else if (EQ (keyword
, QCslant
))
4495 value
= LFACE_SLANT (lface
);
4496 else if (EQ (keyword
, QCunderline
))
4497 value
= LFACE_UNDERLINE (lface
);
4498 else if (EQ (keyword
, QCoverline
))
4499 value
= LFACE_OVERLINE (lface
);
4500 else if (EQ (keyword
, QCstrike_through
))
4501 value
= LFACE_STRIKE_THROUGH (lface
);
4502 else if (EQ (keyword
, QCbox
))
4503 value
= LFACE_BOX (lface
);
4504 else if (EQ (keyword
, QCinverse_video
)
4505 || EQ (keyword
, QCreverse_video
))
4506 value
= LFACE_INVERSE (lface
);
4507 else if (EQ (keyword
, QCforeground
))
4508 value
= LFACE_FOREGROUND (lface
);
4509 else if (EQ (keyword
, QCbackground
))
4510 value
= LFACE_BACKGROUND (lface
);
4511 else if (EQ (keyword
, QCstipple
))
4512 value
= LFACE_STIPPLE (lface
);
4513 else if (EQ (keyword
, QCwidth
))
4514 value
= LFACE_SWIDTH (lface
);
4515 else if (EQ (keyword
, QCinherit
))
4516 value
= LFACE_INHERIT (lface
);
4517 else if (EQ (keyword
, QCfont
))
4518 value
= LFACE_FONT (lface
);
4520 signal_error ("Invalid face attribute name", keyword
);
4526 DEFUN ("internal-lisp-face-attribute-values",
4527 Finternal_lisp_face_attribute_values
,
4528 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4529 "Return a list of valid discrete values for face attribute ATTR.\n\
4530 Value is nil if ATTR doesn't have a discrete set of valid values.")
4534 Lisp_Object result
= Qnil
;
4536 CHECK_SYMBOL (attr
, 0);
4538 if (EQ (attr
, QCweight
)
4539 || EQ (attr
, QCslant
)
4540 || EQ (attr
, QCwidth
))
4542 /* Extract permissible symbols from tables. */
4543 struct table_entry
*table
;
4546 if (EQ (attr
, QCweight
))
4547 table
= weight_table
, dim
= DIM (weight_table
);
4548 else if (EQ (attr
, QCslant
))
4549 table
= slant_table
, dim
= DIM (slant_table
);
4551 table
= swidth_table
, dim
= DIM (swidth_table
);
4553 for (i
= 0; i
< dim
; ++i
)
4555 Lisp_Object symbol
= *table
[i
].symbol
;
4556 Lisp_Object tail
= result
;
4559 && !EQ (XCAR (tail
), symbol
))
4563 result
= Fcons (symbol
, result
);
4566 else if (EQ (attr
, QCunderline
))
4567 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4568 else if (EQ (attr
, QCoverline
))
4569 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4570 else if (EQ (attr
, QCstrike_through
))
4571 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4572 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4573 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4579 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4580 Sinternal_merge_in_global_face
, 2, 2, 0,
4581 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4582 Default face attributes override any local face attributes.")
4584 Lisp_Object face
, frame
;
4587 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4589 CHECK_LIVE_FRAME (frame
, 1);
4590 global_lface
= lface_from_face_name (NULL
, face
, 1);
4591 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4592 if (NILP (local_lface
))
4593 local_lface
= Finternal_make_lisp_face (face
, frame
);
4595 /* Make every specified global attribute override the local one.
4596 BEWARE!! This is only used from `face-set-after-frame-default' where
4597 the local frame is defined from default specs in `face-defface-spec'
4598 and those should be overridden by global settings. Hence the strange
4599 "global before local" priority. */
4600 lvec
= XVECTOR (local_lface
)->contents
;
4601 gvec
= XVECTOR (global_lface
)->contents
;
4602 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4603 if (! UNSPECIFIEDP (gvec
[i
]))
4610 /* The following function is implemented for compatibility with 20.2.
4611 The function is used in x-resolve-fonts when it is asked to
4612 return fonts with the same size as the font of a face. This is
4613 done in fontset.el. */
4615 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4616 "Return the font name of face FACE, or nil if it is unspecified.\n\
4617 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4618 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4619 The font default for a face is either nil, or a list\n\
4620 of the form (bold), (italic) or (bold italic).\n\
4621 If FRAME is omitted or nil, use the selected frame.")
4623 Lisp_Object face
, frame
;
4627 Lisp_Object result
= Qnil
;
4628 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4630 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4631 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4632 result
= Fcons (Qbold
, result
);
4634 if (!NILP (LFACE_SLANT (lface
))
4635 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4636 result
= Fcons (Qitalic
, result
);
4642 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4643 int face_id
= lookup_named_face (f
, face
, 0);
4644 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4645 return build_string (face
->font_name
);
4650 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4651 all attributes are `equal'. Tries to be fast because this function
4652 is called quite often. */
4655 lface_equal_p (v1
, v2
)
4656 Lisp_Object
*v1
, *v2
;
4660 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4662 Lisp_Object a
= v1
[i
];
4663 Lisp_Object b
= v2
[i
];
4665 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4666 and the other is specified. */
4667 equal_p
= XTYPE (a
) == XTYPE (b
);
4676 equal_p
= ((STRING_BYTES (XSTRING (a
))
4677 == STRING_BYTES (XSTRING (b
)))
4678 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4679 STRING_BYTES (XSTRING (a
))) == 0);
4688 equal_p
= !NILP (Fequal (a
, b
));
4698 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4699 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4700 "True if FACE1 and FACE2 are equal.\n\
4701 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4702 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4703 If FRAME is omitted or nil, use the selected frame.")
4704 (face1
, face2
, frame
)
4705 Lisp_Object face1
, face2
, frame
;
4709 Lisp_Object lface1
, lface2
;
4714 /* Don't use check_x_frame here because this function is called
4715 before X frames exist. At that time, if FRAME is nil,
4716 selected_frame will be used which is the frame dumped with
4717 Emacs. That frame is not an X frame. */
4718 f
= frame_or_selected_frame (frame
, 2);
4720 lface1
= lface_from_face_name (NULL
, face1
, 1);
4721 lface2
= lface_from_face_name (NULL
, face2
, 1);
4722 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4723 XVECTOR (lface2
)->contents
);
4724 return equal_p
? Qt
: Qnil
;
4728 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4729 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4730 "True if FACE has no attribute specified.\n\
4731 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4732 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4733 If FRAME is omitted or nil, use the selected frame.")
4735 Lisp_Object face
, frame
;
4742 frame
= selected_frame
;
4743 CHECK_LIVE_FRAME (frame
, 0);
4747 lface
= lface_from_face_name (NULL
, face
, 1);
4749 lface
= lface_from_face_name (f
, face
, 1);
4751 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4752 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4755 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4759 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4761 "Return an alist of frame-local faces defined on FRAME.\n\
4762 For internal use only.")
4766 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4767 return f
->face_alist
;
4771 /* Return a hash code for Lisp string STRING with case ignored. Used
4772 below in computing a hash value for a Lisp face. */
4774 static INLINE
unsigned
4775 hash_string_case_insensitive (string
)
4780 xassert (STRINGP (string
));
4781 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4782 hash
= (hash
<< 1) ^ tolower (*s
);
4787 /* Return a hash code for face attribute vector V. */
4789 static INLINE
unsigned
4793 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4794 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4795 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4796 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4797 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4798 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4799 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4803 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4804 considering charsets/registries). They do if they specify the same
4805 family, point size, weight, width, slant, and fontset. Both LFACE1
4806 and LFACE2 must be fully-specified. */
4809 lface_same_font_attributes_p (lface1
, lface2
)
4810 Lisp_Object
*lface1
, *lface2
;
4812 xassert (lface_fully_specified_p (lface1
)
4813 && lface_fully_specified_p (lface2
));
4814 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4815 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4816 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4817 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4818 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4819 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4820 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4821 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4822 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4823 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4824 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4829 /***********************************************************************
4831 ***********************************************************************/
4833 /* Allocate and return a new realized face for Lisp face attribute
4836 static struct face
*
4837 make_realized_face (attr
)
4840 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4841 bzero (face
, sizeof *face
);
4842 face
->ascii_face
= face
;
4843 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4848 /* Free realized face FACE, including its X resources. FACE may
4852 free_realized_face (f
, face
)
4858 #ifdef HAVE_WINDOW_SYSTEM
4859 if (FRAME_WINDOW_P (f
))
4861 /* Free fontset of FACE if it is ASCII face. */
4862 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4863 free_face_fontset (f
, face
);
4866 x_free_gc (f
, face
->gc
);
4870 free_face_colors (f
, face
);
4871 x_destroy_bitmap (f
, face
->stipple
);
4873 #endif /* HAVE_WINDOW_SYSTEM */
4880 /* Prepare face FACE for subsequent display on frame F. This
4881 allocated GCs if they haven't been allocated yet or have been freed
4882 by clearing the face cache. */
4885 prepare_face_for_display (f
, face
)
4889 #ifdef HAVE_WINDOW_SYSTEM
4890 xassert (FRAME_WINDOW_P (f
));
4895 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4897 xgcv
.foreground
= face
->foreground
;
4898 xgcv
.background
= face
->background
;
4899 #ifdef HAVE_X_WINDOWS
4900 xgcv
.graphics_exposures
= False
;
4902 /* The font of FACE may be null if we couldn't load it. */
4905 #ifdef HAVE_X_WINDOWS
4906 xgcv
.font
= face
->font
->fid
;
4909 xgcv
.font
= face
->font
;
4912 xgcv
.font
= face
->font
;
4918 #ifdef HAVE_X_WINDOWS
4921 xgcv
.fill_style
= FillOpaqueStippled
;
4922 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4923 mask
|= GCFillStyle
| GCStipple
;
4926 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4929 #endif /* HAVE_WINDOW_SYSTEM */
4933 /***********************************************************************
4935 ***********************************************************************/
4937 /* Return a new face cache for frame F. */
4939 static struct face_cache
*
4943 struct face_cache
*c
;
4946 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4947 bzero (c
, sizeof *c
);
4948 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4949 c
->buckets
= (struct face
**) xmalloc (size
);
4950 bzero (c
->buckets
, size
);
4952 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4958 /* Clear out all graphics contexts for all realized faces, except for
4959 the basic faces. This should be done from time to time just to avoid
4960 keeping too many graphics contexts that are no longer needed. */
4964 struct face_cache
*c
;
4966 if (c
&& FRAME_WINDOW_P (c
->f
))
4968 #ifdef HAVE_WINDOW_SYSTEM
4970 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4972 struct face
*face
= c
->faces_by_id
[i
];
4973 if (face
&& face
->gc
)
4975 x_free_gc (c
->f
, face
->gc
);
4979 #endif /* HAVE_WINDOW_SYSTEM */
4984 /* Free all realized faces in face cache C, including basic faces. C
4985 may be null. If faces are freed, make sure the frame's current
4986 matrix is marked invalid, so that a display caused by an expose
4987 event doesn't try to use faces we destroyed. */
4990 free_realized_faces (c
)
4991 struct face_cache
*c
;
4996 struct frame
*f
= c
->f
;
4998 /* We must block input here because we can't process X events
4999 safely while only some faces are freed, or when the frame's
5000 current matrix still references freed faces. */
5003 for (i
= 0; i
< c
->used
; ++i
)
5005 free_realized_face (f
, c
->faces_by_id
[i
]);
5006 c
->faces_by_id
[i
] = NULL
;
5010 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5011 bzero (c
->buckets
, size
);
5013 /* Must do a thorough redisplay the next time. Mark current
5014 matrices as invalid because they will reference faces freed
5015 above. This function is also called when a frame is
5016 destroyed. In this case, the root window of F is nil. */
5017 if (WINDOWP (f
->root_window
))
5019 clear_current_matrices (f
);
5020 ++windows_or_buffers_changed
;
5028 /* Free all faces realized for multibyte characters on frame F that
5032 free_realized_multibyte_face (f
, fontset
)
5036 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5040 /* We must block input here because we can't process X events safely
5041 while only some faces are freed, or when the frame's current
5042 matrix still references freed faces. */
5045 for (i
= 0; i
< cache
->used
; i
++)
5047 face
= cache
->faces_by_id
[i
];
5049 && face
!= face
->ascii_face
5050 && face
->fontset
== fontset
)
5052 uncache_face (cache
, face
);
5053 free_realized_face (f
, face
);
5057 /* Must do a thorough redisplay the next time. Mark current
5058 matrices as invalid because they will reference faces freed
5059 above. This function is also called when a frame is destroyed.
5060 In this case, the root window of F is nil. */
5061 if (WINDOWP (f
->root_window
))
5063 clear_current_matrices (f
);
5064 ++windows_or_buffers_changed
;
5071 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5072 This is done after attributes of a named face have been changed,
5073 because we can't tell which realized faces depend on that face. */
5076 free_all_realized_faces (frame
)
5082 FOR_EACH_FRAME (rest
, frame
)
5083 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5086 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5090 /* Free face cache C and faces in it, including their X resources. */
5094 struct face_cache
*c
;
5098 free_realized_faces (c
);
5100 xfree (c
->faces_by_id
);
5106 /* Cache realized face FACE in face cache C. HASH is the hash value
5107 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5108 collision list of the face hash table of C. This is done because
5109 otherwise lookup_face would find FACE for every character, even if
5110 faces with the same attributes but for specific characters exist. */
5113 cache_face (c
, face
, hash
)
5114 struct face_cache
*c
;
5118 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5122 if (face
->fontset
>= 0)
5124 struct face
*last
= c
->buckets
[i
];
5135 c
->buckets
[i
] = face
;
5136 face
->prev
= face
->next
= NULL
;
5142 face
->next
= c
->buckets
[i
];
5144 face
->next
->prev
= face
;
5145 c
->buckets
[i
] = face
;
5148 /* Find a free slot in C->faces_by_id and use the index of the free
5149 slot as FACE->id. */
5150 for (i
= 0; i
< c
->used
; ++i
)
5151 if (c
->faces_by_id
[i
] == NULL
)
5155 /* Maybe enlarge C->faces_by_id. */
5156 if (i
== c
->used
&& c
->used
== c
->size
)
5158 int new_size
= 2 * c
->size
;
5159 int sz
= new_size
* sizeof *c
->faces_by_id
;
5160 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5165 /* Check that FACE got a unique id. */
5170 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5171 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5177 #endif /* GLYPH_DEBUG */
5179 c
->faces_by_id
[i
] = face
;
5185 /* Remove face FACE from cache C. */
5188 uncache_face (c
, face
)
5189 struct face_cache
*c
;
5192 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5195 face
->prev
->next
= face
->next
;
5197 c
->buckets
[i
] = face
->next
;
5200 face
->next
->prev
= face
->prev
;
5202 c
->faces_by_id
[face
->id
] = NULL
;
5203 if (face
->id
== c
->used
)
5208 /* Look up a realized face with face attributes ATTR in the face cache
5209 of frame F. The face will be used to display character C. Value
5210 is the ID of the face found. If no suitable face is found, realize
5211 a new one. In that case, if C is a multibyte character, BASE_FACE
5212 is a face that has the same attributes. */
5215 lookup_face (f
, attr
, c
, base_face
)
5219 struct face
*base_face
;
5221 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5226 xassert (cache
!= NULL
);
5227 check_lface_attrs (attr
);
5229 /* Look up ATTR in the face cache. */
5230 hash
= lface_hash (attr
);
5231 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5233 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5234 if (face
->hash
== hash
5235 && (!FRAME_WINDOW_P (f
)
5236 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5237 && lface_equal_p (face
->lface
, attr
))
5240 /* If not found, realize a new face. */
5242 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5245 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5247 /* When this function is called from face_for_char (in this case, C is
5248 a multibyte character), a fontset of a face returned by
5249 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5250 C) is not sutisfied. The fontset is set for this face by
5251 face_for_char later. */
5253 if (FRAME_WINDOW_P (f
))
5254 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5256 #endif /* GLYPH_DEBUG */
5262 /* Return the face id of the realized face for named face SYMBOL on
5263 frame F suitable for displaying character C. */
5266 lookup_named_face (f
, symbol
, c
)
5271 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5272 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5273 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5275 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5276 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5277 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5278 return lookup_face (f
, attrs
, c
, NULL
);
5282 /* Return the ID of the realized ASCII face of Lisp face with ID
5283 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5286 ascii_face_of_lisp_face (f
, lface_id
)
5292 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5294 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5295 face_id
= lookup_named_face (f
, face_name
, 0);
5304 /* Return a face for charset ASCII that is like the face with id
5305 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5306 STEPS < 0 means larger. Value is the id of the face. */
5309 smaller_face (f
, face_id
, steps
)
5313 #ifdef HAVE_WINDOW_SYSTEM
5315 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5316 int pt
, last_pt
, last_height
;
5319 struct face
*new_face
;
5321 /* If not called for an X frame, just return the original face. */
5322 if (FRAME_TERMCAP_P (f
))
5325 /* Try in increments of 1/2 pt. */
5326 delta
= steps
< 0 ? 5 : -5;
5327 steps
= abs (steps
);
5329 face
= FACE_FROM_ID (f
, face_id
);
5330 bcopy (face
->lface
, attrs
, sizeof attrs
);
5331 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5332 new_face_id
= face_id
;
5333 last_height
= FONT_HEIGHT (face
->font
);
5337 /* Give up if we cannot find a font within 10pt. */
5338 && abs (last_pt
- pt
) < 100)
5340 /* Look up a face for a slightly smaller/larger font. */
5342 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5343 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5344 new_face
= FACE_FROM_ID (f
, new_face_id
);
5346 /* If height changes, count that as one step. */
5347 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5348 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5351 last_height
= FONT_HEIGHT (new_face
->font
);
5358 #else /* not HAVE_WINDOW_SYSTEM */
5362 #endif /* not HAVE_WINDOW_SYSTEM */
5366 /* Return a face for charset ASCII that is like the face with id
5367 FACE_ID on frame F, but has height HEIGHT. */
5370 face_with_height (f
, face_id
, height
)
5375 #ifdef HAVE_WINDOW_SYSTEM
5377 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5379 if (FRAME_TERMCAP_P (f
)
5383 face
= FACE_FROM_ID (f
, face_id
);
5384 bcopy (face
->lface
, attrs
, sizeof attrs
);
5385 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5386 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5387 #endif /* HAVE_WINDOW_SYSTEM */
5392 /* Return the face id of the realized face for named face SYMBOL on
5393 frame F suitable for displaying character C, and use attributes of
5394 the face FACE_ID for attributes that aren't completely specified by
5395 SYMBOL. This is like lookup_named_face, except that the default
5396 attributes come from FACE_ID, not from the default face. FACE_ID
5397 is assumed to be already realized. */
5400 lookup_derived_face (f
, symbol
, c
, face_id
)
5406 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5407 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5408 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5413 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5414 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5415 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5416 return lookup_face (f
, attrs
, c
, default_face
);
5421 /***********************************************************************
5423 ***********************************************************************/
5425 DEFUN ("internal-set-font-selection-order",
5426 Finternal_set_font_selection_order
,
5427 Sinternal_set_font_selection_order
, 1, 1, 0,
5428 "Set font selection order for face font selection to ORDER.\n\
5429 ORDER must be a list of length 4 containing the symbols `:width',\n\
5430 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5431 first in ORDER are matched first, e.g. if `:height' appears before\n\
5432 `:weight' in ORDER, font selection first tries to find a font with\n\
5433 a suitable height, and then tries to match the font weight.\n\
5442 CHECK_LIST (order
, 0);
5443 bzero (indices
, sizeof indices
);
5447 CONSP (list
) && i
< DIM (indices
);
5448 list
= XCDR (list
), ++i
)
5450 Lisp_Object attr
= XCAR (list
);
5453 if (EQ (attr
, QCwidth
))
5455 else if (EQ (attr
, QCheight
))
5456 xlfd
= XLFD_POINT_SIZE
;
5457 else if (EQ (attr
, QCweight
))
5459 else if (EQ (attr
, QCslant
))
5464 if (indices
[i
] != 0)
5470 || i
!= DIM (indices
)
5475 signal_error ("Invalid font sort order", order
);
5477 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5479 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5480 free_all_realized_faces (Qnil
);
5487 DEFUN ("internal-set-alternative-font-family-alist",
5488 Finternal_set_alternative_font_family_alist
,
5489 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5490 "Define alternative font families to try in face font selection.\n\
5491 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5492 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5493 be found. Value is ALIST.")
5497 CHECK_LIST (alist
, 0);
5498 Vface_alternative_font_family_alist
= alist
;
5499 free_all_realized_faces (Qnil
);
5504 #ifdef HAVE_WINDOW_SYSTEM
5506 /* Value is non-zero if FONT is the name of a scalable font. The
5507 X11R6 XLFD spec says that point size, pixel size, and average width
5508 are zero for scalable fonts. Intlfonts contain at least one
5509 scalable font ("*-muleindian-1") for which this isn't true, so we
5510 just test average width. */
5513 font_scalable_p (font
)
5514 struct font_name
*font
;
5516 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5517 return (*s
== '0' && *(s
+ 1) == '\0')
5519 /* Windows implementation of XLFD is slightly broken for backward
5520 compatibility with previous broken versions, so test for
5521 wildcards as well as 0. */
5528 /* Value is non-zero if FONT1 is a better match for font attributes
5529 VALUES than FONT2. VALUES is an array of face attribute values in
5530 font sort order. COMPARE_PT_P zero means don't compare point
5534 better_font_p (values
, font1
, font2
, compare_pt_p
)
5536 struct font_name
*font1
, *font2
;
5541 for (i
= 0; i
< 4; ++i
)
5543 int xlfd_idx
= font_sort_order
[i
];
5545 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5547 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5548 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5550 if (delta1
> delta2
)
5552 else if (delta1
< delta2
)
5556 /* The difference may be equal because, e.g., the face
5557 specifies `italic' but we have only `regular' and
5558 `oblique'. Prefer `oblique' in this case. */
5559 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5560 && font1
->numeric
[xlfd_idx
] > values
[i
]
5561 && font2
->numeric
[xlfd_idx
] < values
[i
])
5571 /* Value is non-zero if FONT is an exact match for face attributes in
5572 SPECIFIED. SPECIFIED is an array of face attribute values in font
5576 exact_face_match_p (specified
, font
)
5578 struct font_name
*font
;
5582 for (i
= 0; i
< 4; ++i
)
5583 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5590 /* Value is the name of a scaled font, generated from scalable font
5591 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5592 Value is allocated from heap. */
5595 build_scalable_font_name (f
, font
, specified_pt
)
5597 struct font_name
*font
;
5600 char point_size
[20], pixel_size
[20];
5602 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5605 /* If scalable font is for a specific resolution, compute
5606 the point size we must specify from the resolution of
5607 the display and the specified resolution of the font. */
5608 if (font
->numeric
[XLFD_RESY
] != 0)
5610 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5611 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5616 pixel_value
= resy
/ 720.0 * pt
;
5619 /* Set point size of the font. */
5620 sprintf (point_size
, "%d", (int) pt
);
5621 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5622 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5624 /* Set pixel size. */
5625 sprintf (pixel_size
, "%d", pixel_value
);
5626 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5627 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5629 /* If font doesn't specify its resolution, use the
5630 resolution of the display. */
5631 if (font
->numeric
[XLFD_RESY
] == 0)
5634 sprintf (buffer
, "%d", (int) resy
);
5635 font
->fields
[XLFD_RESY
] = buffer
;
5636 font
->numeric
[XLFD_RESY
] = resy
;
5639 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5642 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5643 sprintf (buffer
, "%d", resx
);
5644 font
->fields
[XLFD_RESX
] = buffer
;
5645 font
->numeric
[XLFD_RESX
] = resx
;
5648 return build_font_name (font
);
5652 /* Value is non-zero if we are allowed to use scalable font FONT. We
5653 can't run a Lisp function here since this function may be called
5654 with input blocked. */
5657 may_use_scalable_font_p (font
, name
)
5658 struct font_name
*font
;
5661 if (EQ (Vscalable_fonts_allowed
, Qt
))
5663 else if (CONSP (Vscalable_fonts_allowed
))
5665 Lisp_Object tail
, regexp
;
5667 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5669 regexp
= XCAR (tail
);
5670 if (STRINGP (regexp
)
5671 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5681 /* Return the name of the best matching font for face attributes
5682 ATTRS in the array of font_name structures FONTS which contains
5683 NFONTS elements. Value is a font name which is allocated from
5684 the heap. FONTS is freed by this function. */
5687 best_matching_font (f
, attrs
, fonts
, nfonts
)
5690 struct font_name
*fonts
;
5694 struct font_name
*best
;
5702 /* Make specified font attributes available in `specified',
5703 indexed by sort order. */
5704 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5706 int xlfd_idx
= font_sort_order
[i
];
5708 if (xlfd_idx
== XLFD_SWIDTH
)
5709 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5710 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5711 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5712 else if (xlfd_idx
== XLFD_WEIGHT
)
5713 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5714 else if (xlfd_idx
== XLFD_SLANT
)
5715 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5722 /* Start with the first non-scalable font in the list. */
5723 for (i
= 0; i
< nfonts
; ++i
)
5724 if (!font_scalable_p (fonts
+ i
))
5727 /* Find the best match among the non-scalable fonts. */
5732 for (i
= 1; i
< nfonts
; ++i
)
5733 if (!font_scalable_p (fonts
+ i
)
5734 && better_font_p (specified
, fonts
+ i
, best
, 1))
5738 exact_p
= exact_face_match_p (specified
, best
);
5747 /* Unless we found an exact match among non-scalable fonts, see if
5748 we can find a better match among scalable fonts. */
5751 /* A scalable font is better if
5753 1. its weight, slant, swidth attributes are better, or.
5755 2. the best non-scalable font doesn't have the required
5756 point size, and the scalable fonts weight, slant, swidth
5759 int non_scalable_has_exact_height_p
;
5761 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5762 non_scalable_has_exact_height_p
= 1;
5764 non_scalable_has_exact_height_p
= 0;
5766 for (i
= 0; i
< nfonts
; ++i
)
5767 if (font_scalable_p (fonts
+ i
))
5770 || better_font_p (specified
, fonts
+ i
, best
, 0)
5771 || (!non_scalable_has_exact_height_p
5772 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5777 if (font_scalable_p (best
))
5778 font_name
= build_scalable_font_name (f
, best
, pt
);
5780 font_name
= build_font_name (best
);
5782 /* Free font_name structures. */
5783 free_font_names (fonts
, nfonts
);
5789 /* Try to get a list of fonts on frame F with font family FAMILY and
5790 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5791 of font_name structures for the fonts matched. Value is the number
5795 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5798 Lisp_Object pattern
, family
, registry
;
5799 struct font_name
**fonts
;
5803 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5804 family
= attrs
[LFACE_FAMILY_INDEX
];
5806 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5808 if (nfonts
== 0 && !NILP (family
))
5812 /* Try alternative font families from
5813 Vface_alternative_font_family_alist. */
5814 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5816 for (alter
= XCDR (alter
);
5817 CONSP (alter
) && nfonts
== 0;
5818 alter
= XCDR (alter
))
5820 if (STRINGP (XCAR (alter
)))
5821 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5824 /* Try font family of the default face or "fixed". */
5827 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5829 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5831 family
= build_string ("fixed");
5832 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5835 /* Try any family with the given registry. */
5837 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5844 /* Return the fontset id of the base fontset name or alias name given
5845 by the fontset attribute of ATTRS. Value is -1 if the fontset
5846 attribute of ATTRS doesn't name a fontset. */
5849 face_fontset (attrs
)
5855 name
= attrs
[LFACE_FONT_INDEX
];
5856 if (!STRINGP (name
))
5858 return fs_query_fontset (name
, 0);
5862 /* Choose a name of font to use on frame F to display character C with
5863 Lisp face attributes specified by ATTRS. The font name is
5864 determined by the font-related attributes in ATTRS and the name
5865 pattern for C in FONTSET. Value is the font name which is
5866 allocated from the heap and must be freed by the caller, or NULL if
5867 we can get no information about the font name of C. It is assured
5868 that we always get some information for a single byte
5872 choose_face_font (f
, attrs
, fontset
, c
)
5877 Lisp_Object pattern
;
5878 char *font_name
= NULL
;
5879 struct font_name
*fonts
;
5882 /* Get (foundry and) family name and registry (and encoding) name of
5884 pattern
= fontset_font_pattern (f
, fontset
, c
);
5887 xassert (!SINGLE_BYTE_CHAR_P (c
));
5890 /* If what we got is a name pattern, return it. */
5891 if (STRINGP (pattern
))
5892 return xstrdup (XSTRING (pattern
)->data
);
5894 /* Family name may be specified both in ATTRS and car part of
5895 PATTERN. The former has higher priority if C is a single byte
5897 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5898 && SINGLE_BYTE_CHAR_P (c
))
5899 XCAR (pattern
) = Qnil
;
5901 /* Get a list of fonts matching that pattern and choose the
5902 best match for the specified face attributes from it. */
5903 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5905 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5909 #endif /* HAVE_WINDOW_SYSTEM */
5913 /***********************************************************************
5915 ***********************************************************************/
5917 /* Realize basic faces on frame F. Value is zero if frame parameters
5918 of F don't contain enough information needed to realize the default
5922 realize_basic_faces (f
)
5927 /* Block input there so that we won't be surprised by an X expose
5928 event, for instance without having the faces set up. */
5931 if (realize_default_face (f
))
5933 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5934 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5935 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5936 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5937 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5938 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5939 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5940 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5941 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5950 /* Realize the default face on frame F. If the face is not fully
5951 specified, make it fully-specified. Attributes of the default face
5952 that are not explicitly specified are taken from frame parameters. */
5955 realize_default_face (f
)
5958 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5960 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5961 Lisp_Object frame_font
;
5965 /* If the `default' face is not yet known, create it. */
5966 lface
= lface_from_face_name (f
, Qdefault
, 0);
5970 XSETFRAME (frame
, f
);
5971 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
5974 #ifdef HAVE_WINDOW_SYSTEM
5975 if (FRAME_WINDOW_P (f
))
5977 /* Set frame_font to the value of the `font' frame parameter. */
5978 frame_font
= Fassq (Qfont
, f
->param_alist
);
5979 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
5980 frame_font
= XCDR (frame_font
);
5981 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
5983 #endif /* HAVE_WINDOW_SYSTEM */
5985 if (!FRAME_WINDOW_P (f
))
5987 LFACE_FAMILY (lface
) = build_string ("default");
5988 LFACE_SWIDTH (lface
) = Qnormal
;
5989 LFACE_HEIGHT (lface
) = make_number (1);
5990 LFACE_WEIGHT (lface
) = Qnormal
;
5991 LFACE_SLANT (lface
) = Qnormal
;
5994 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
5995 LFACE_UNDERLINE (lface
) = Qnil
;
5997 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
5998 LFACE_OVERLINE (lface
) = Qnil
;
6000 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6001 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6003 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6004 LFACE_BOX (lface
) = Qnil
;
6006 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6007 LFACE_INVERSE (lface
) = Qnil
;
6009 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6011 /* This function is called so early that colors are not yet
6012 set in the frame parameter list. */
6013 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6015 if (CONSP (color
) && STRINGP (XCDR (color
)))
6016 LFACE_FOREGROUND (lface
) = XCDR (color
);
6017 else if (FRAME_WINDOW_P (f
))
6019 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6020 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6025 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6027 /* This function is called so early that colors are not yet
6028 set in the frame parameter list. */
6029 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6030 if (CONSP (color
) && STRINGP (XCDR (color
)))
6031 LFACE_BACKGROUND (lface
) = XCDR (color
);
6032 else if (FRAME_WINDOW_P (f
))
6034 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6035 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6040 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6041 LFACE_STIPPLE (lface
) = Qnil
;
6043 /* Realize the face; it must be fully-specified now. */
6044 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6045 check_lface (lface
);
6046 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6047 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6052 /* Realize basic faces other than the default face in face cache C.
6053 SYMBOL is the face name, ID is the face id the realized face must
6054 have. The default face must have been realized already. */
6057 realize_named_face (f
, symbol
, id
)
6062 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6063 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6064 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6065 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6066 struct face
*new_face
;
6068 /* The default face must exist and be fully specified. */
6069 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6070 check_lface_attrs (attrs
);
6071 xassert (lface_fully_specified_p (attrs
));
6073 /* If SYMBOL isn't know as a face, create it. */
6077 XSETFRAME (frame
, f
);
6078 lface
= Finternal_make_lisp_face (symbol
, frame
);
6081 /* Merge SYMBOL's face with the default face. */
6082 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6083 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6085 /* Realize the face. */
6086 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6090 /* Realize the fully-specified face with attributes ATTRS in face
6091 cache CACHE for character C. If C is a multibyte character,
6092 BASE_FACE is a face that has the same attributes. Otherwise,
6093 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6094 ID of face to remove before caching the new face. Value is a
6095 pointer to the newly created realized face. */
6097 static struct face
*
6098 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6099 struct face_cache
*cache
;
6102 struct face
*base_face
;
6107 /* LFACE must be fully specified. */
6108 xassert (cache
!= NULL
);
6109 check_lface_attrs (attrs
);
6111 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6113 /* Remove the former face. */
6114 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6115 uncache_face (cache
, former_face
);
6116 free_realized_face (cache
->f
, former_face
);
6119 if (FRAME_WINDOW_P (cache
->f
))
6120 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6121 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6122 face
= realize_tty_face (cache
, attrs
, c
);
6126 /* Insert the new face. */
6127 cache_face (cache
, face
, lface_hash (attrs
));
6128 #ifdef HAVE_WINDOW_SYSTEM
6129 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6130 load_face_font (cache
->f
, face
, c
);
6131 #endif /* HAVE_WINDOW_SYSTEM */
6136 /* Realize the fully-specified face with attributes ATTRS in face
6137 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6138 a multibyte character, BASE_FACE is a face that has the same
6139 attributes. Otherwise, BASE_FACE is ignored. If the new face
6140 doesn't share font with the default face, a fontname is allocated
6141 from the heap and set in `font_name' of the new face, but it is not
6142 yet loaded here. Value is a pointer to the newly created realized
6145 static struct face
*
6146 realize_x_face (cache
, attrs
, c
, base_face
)
6147 struct face_cache
*cache
;
6150 struct face
*base_face
;
6152 #ifdef HAVE_WINDOW_SYSTEM
6153 struct face
*face
, *default_face
;
6155 Lisp_Object stipple
, overline
, strike_through
, box
;
6157 xassert (FRAME_WINDOW_P (cache
->f
));
6158 xassert (SINGLE_BYTE_CHAR_P (c
)
6161 /* Allocate a new realized face. */
6162 face
= make_realized_face (attrs
);
6166 /* If C is a multibyte character, we share all face attirbutes with
6167 BASE_FACE including the realized fontset. But, we must load a
6169 if (!SINGLE_BYTE_CHAR_P (c
))
6171 bcopy (base_face
, face
, sizeof *face
);
6174 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6175 face
->foreground_defaulted_p
= 1;
6176 face
->background_defaulted_p
= 1;
6177 face
->underline_defaulted_p
= 1;
6178 face
->overline_color_defaulted_p
= 1;
6179 face
->strike_through_color_defaulted_p
= 1;
6180 face
->box_color_defaulted_p
= 1;
6182 /* to force realize_face to load font */
6187 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6189 /* Determine the font to use. Most of the time, the font will be
6190 the same as the font of the default face, so try that first. */
6191 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6193 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6194 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6196 face
->font
= default_face
->font
;
6197 face
->fontset
= default_face
->fontset
;
6198 face
->font_info_id
= default_face
->font_info_id
;
6199 face
->font_name
= default_face
->font_name
;
6200 face
->ascii_face
= face
;
6202 /* But, as we can't share the fontset, make a new realized
6203 fontset that has the same base fontset as of the default
6206 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6210 /* If the face attribute ATTRS specifies a fontset, use it as
6211 the base of a new realized fontset. Otherwise, use the same
6212 base fontset as of the default face. The base determines
6213 registry and encoding of a font. It may also determine
6214 foundry and family. The other fields of font name pattern
6215 are constructed from ATTRS. */
6216 int fontset
= face_fontset (attrs
);
6218 if ((fontset
== -1) && default_face
)
6219 fontset
= default_face
->fontset
;
6220 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6221 face
->font
= NULL
; /* to force realize_face to load font */
6224 /* Load the font if it is specified in ATTRS. This fixes
6225 changing frame font on the Mac. */
6226 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6228 struct font_info
*font_info
=
6229 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6231 face
->font
= font_info
->font
;
6236 /* Load colors, and set remaining attributes. */
6238 load_face_colors (f
, face
, attrs
);
6241 box
= attrs
[LFACE_BOX_INDEX
];
6244 /* A simple box of line width 1 drawn in color given by
6246 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6248 face
->box
= FACE_SIMPLE_BOX
;
6249 face
->box_line_width
= 1;
6251 else if (INTEGERP (box
))
6253 /* Simple box of specified line width in foreground color of the
6255 xassert (XINT (box
) > 0);
6256 face
->box
= FACE_SIMPLE_BOX
;
6257 face
->box_line_width
= XFASTINT (box
);
6258 face
->box_color
= face
->foreground
;
6259 face
->box_color_defaulted_p
= 1;
6261 else if (CONSP (box
))
6263 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6264 being one of `raised' or `sunken'. */
6265 face
->box
= FACE_SIMPLE_BOX
;
6266 face
->box_color
= face
->foreground
;
6267 face
->box_color_defaulted_p
= 1;
6268 face
->box_line_width
= 1;
6272 Lisp_Object keyword
, value
;
6274 keyword
= XCAR (box
);
6282 if (EQ (keyword
, QCline_width
))
6284 if (INTEGERP (value
) && XINT (value
) > 0)
6285 face
->box_line_width
= XFASTINT (value
);
6287 else if (EQ (keyword
, QCcolor
))
6289 if (STRINGP (value
))
6291 face
->box_color
= load_color (f
, face
, value
,
6293 face
->use_box_color_for_shadows_p
= 1;
6296 else if (EQ (keyword
, QCstyle
))
6298 if (EQ (value
, Qreleased_button
))
6299 face
->box
= FACE_RAISED_BOX
;
6300 else if (EQ (value
, Qpressed_button
))
6301 face
->box
= FACE_SUNKEN_BOX
;
6306 /* Text underline, overline, strike-through. */
6308 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6310 /* Use default color (same as foreground color). */
6311 face
->underline_p
= 1;
6312 face
->underline_defaulted_p
= 1;
6313 face
->underline_color
= 0;
6315 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6317 /* Use specified color. */
6318 face
->underline_p
= 1;
6319 face
->underline_defaulted_p
= 0;
6320 face
->underline_color
6321 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6322 LFACE_UNDERLINE_INDEX
);
6324 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6326 face
->underline_p
= 0;
6327 face
->underline_defaulted_p
= 0;
6328 face
->underline_color
= 0;
6331 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6332 if (STRINGP (overline
))
6334 face
->overline_color
6335 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6336 LFACE_OVERLINE_INDEX
);
6337 face
->overline_p
= 1;
6339 else if (EQ (overline
, Qt
))
6341 face
->overline_color
= face
->foreground
;
6342 face
->overline_color_defaulted_p
= 1;
6343 face
->overline_p
= 1;
6346 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6347 if (STRINGP (strike_through
))
6349 face
->strike_through_color
6350 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6351 LFACE_STRIKE_THROUGH_INDEX
);
6352 face
->strike_through_p
= 1;
6354 else if (EQ (strike_through
, Qt
))
6356 face
->strike_through_color
= face
->foreground
;
6357 face
->strike_through_color_defaulted_p
= 1;
6358 face
->strike_through_p
= 1;
6361 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6362 if (!NILP (stipple
))
6363 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6365 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6367 #endif /* HAVE_WINDOW_SYSTEM */
6371 /* Map a specified color of face FACE on frame F to a tty color index.
6372 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6373 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6374 default foreground/background colors. */
6377 map_tty_color (f
, face
, idx
, defaulted
)
6380 enum lface_attribute_index idx
;
6383 Lisp_Object frame
, color
, def
;
6384 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6385 unsigned long default_pixel
, default_other_pixel
, pixel
;
6387 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6391 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6392 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6396 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6397 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6400 XSETFRAME (frame
, f
);
6401 color
= face
->lface
[idx
];
6404 && XSTRING (color
)->size
6405 && CONSP (Vtty_defined_color_alist
)
6406 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6409 /* Associations in tty-defined-color-alist are of the form
6410 (NAME INDEX R G B). We need the INDEX part. */
6411 pixel
= XINT (XCAR (XCDR (def
)));
6414 if (pixel
== default_pixel
&& STRINGP (color
))
6416 pixel
= load_color (f
, face
, color
, idx
);
6418 #if defined (MSDOS) || defined (WINDOWSNT)
6419 /* If the foreground of the default face is the default color,
6420 use the foreground color defined by the frame. */
6422 if (FRAME_MSDOS_P (f
))
6425 if (pixel
== default_pixel
6426 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6429 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6431 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6432 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6435 else if (pixel
== default_other_pixel
)
6438 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6440 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6441 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6447 #endif /* MSDOS or WINDOWSNT */
6451 face
->foreground
= pixel
;
6453 face
->background
= pixel
;
6457 /* Realize the fully-specified face with attributes ATTRS in face
6458 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6459 pointer to the newly created realized face. */
6461 static struct face
*
6462 realize_tty_face (cache
, attrs
, c
)
6463 struct face_cache
*cache
;
6469 int face_colors_defaulted
= 0;
6470 struct frame
*f
= cache
->f
;
6472 /* Frame must be a termcap frame. */
6473 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6475 /* Allocate a new realized face. */
6476 face
= make_realized_face (attrs
);
6477 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6479 /* Map face attributes to TTY appearances. We map slant to
6480 dimmed text because we want italic text to appear differently
6481 and because dimmed text is probably used infrequently. */
6482 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6483 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6485 if (weight
> XLFD_WEIGHT_MEDIUM
)
6486 face
->tty_bold_p
= 1;
6487 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6488 face
->tty_dim_p
= 1;
6489 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6490 face
->tty_underline_p
= 1;
6491 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6492 face
->tty_reverse_p
= 1;
6494 /* Map color names to color indices. */
6495 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6496 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6498 /* Swap colors if face is inverse-video. If the colors are taken
6499 from the frame colors, they are already inverted, since the
6500 frame-creation function calls x-handle-reverse-video. */
6501 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6503 unsigned long tem
= face
->foreground
;
6504 face
->foreground
= face
->background
;
6505 face
->background
= tem
;
6508 if (tty_suppress_bold_inverse_default_colors_p
6510 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6511 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6512 face
->tty_bold_p
= 0;
6518 DEFUN ("tty-suppress-bold-inverse-default-colors",
6519 Ftty_suppress_bold_inverse_default_colors
,
6520 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6521 "Suppress/allow boldness of faces with inverse default colors.\n\
6522 SUPPRESS non-nil means suppress it.\n\
6523 This affects bold faces on TTYs whose foreground is the default background\n\
6524 color of the display and whose background is the default foreground color.\n\
6525 For such faces, the bold face attribute is ignored if this variable\n\
6528 Lisp_Object suppress
;
6530 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6531 ++face_change_count
;
6537 /***********************************************************************
6539 ***********************************************************************/
6541 /* Return the ID of the face to use to display character CH with face
6542 property PROP on frame F in current_buffer. */
6545 compute_char_face (f
, ch
, prop
)
6552 if (NILP (current_buffer
->enable_multibyte_characters
))
6557 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6558 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6562 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6563 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6564 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6565 merge_face_vector_with_property (f
, attrs
, prop
);
6566 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6573 /* Return the face ID associated with buffer position POS for
6574 displaying ASCII characters. Return in *ENDPTR the position at
6575 which a different face is needed, as far as text properties and
6576 overlays are concerned. W is a window displaying current_buffer.
6578 REGION_BEG, REGION_END delimit the region, so it can be
6581 LIMIT is a position not to scan beyond. That is to limit the time
6582 this function can take.
6584 If MOUSE is non-zero, use the character's mouse-face, not its face.
6586 The face returned is suitable for displaying ASCII characters. */
6589 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6590 endptr
, limit
, mouse
)
6593 int region_beg
, region_end
;
6598 struct frame
*f
= XFRAME (w
->frame
);
6599 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6600 Lisp_Object prop
, position
;
6602 Lisp_Object
*overlay_vec
;
6605 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6606 Lisp_Object limit1
, end
;
6607 struct face
*default_face
;
6608 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6610 /* W must display the current buffer. We could write this function
6611 to use the frame and buffer of W, but right now it doesn't. */
6612 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6614 XSETFRAME (frame
, f
);
6615 XSETFASTINT (position
, pos
);
6618 if (pos
< region_beg
&& region_beg
< endpos
)
6619 endpos
= region_beg
;
6621 /* Get the `face' or `mouse_face' text property at POS, and
6622 determine the next position at which the property changes. */
6623 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6624 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6625 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6627 endpos
= XINT (end
);
6629 /* Look at properties from overlays. */
6634 /* First try with room for 40 overlays. */
6636 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6637 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6638 &next_overlay
, NULL
, 0);
6640 /* If there are more than 40, make enough space for all, and try
6642 if (noverlays
> len
)
6645 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6646 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6647 &next_overlay
, NULL
, 0);
6650 if (next_overlay
< endpos
)
6651 endpos
= next_overlay
;
6656 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6658 /* Optimize common cases where we can use the default face. */
6661 && !(pos
>= region_beg
&& pos
< region_end
))
6662 return DEFAULT_FACE_ID
;
6664 /* Begin with attributes from the default face. */
6665 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6667 /* Merge in attributes specified via text properties. */
6669 merge_face_vector_with_property (f
, attrs
, prop
);
6671 /* Now merge the overlay data. */
6672 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6673 for (i
= 0; i
< noverlays
; i
++)
6678 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6680 merge_face_vector_with_property (f
, attrs
, prop
);
6682 oend
= OVERLAY_END (overlay_vec
[i
]);
6683 oendpos
= OVERLAY_POSITION (oend
);
6684 if (oendpos
< endpos
)
6688 /* If in the region, merge in the region face. */
6689 if (pos
>= region_beg
&& pos
< region_end
)
6691 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6692 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6694 if (region_end
< endpos
)
6695 endpos
= region_end
;
6700 /* Look up a realized face with the given face attributes,
6701 or realize a new one for ASCII characters. */
6702 return lookup_face (f
, attrs
, 0, NULL
);
6706 /* Compute the face at character position POS in Lisp string STRING on
6707 window W, for ASCII characters.
6709 If STRING is an overlay string, it comes from position BUFPOS in
6710 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6711 not an overlay string. W must display the current buffer.
6712 REGION_BEG and REGION_END give the start and end positions of the
6713 region; both are -1 if no region is visible. BASE_FACE_ID is the
6714 id of the basic face to merge with. It is usually equal to
6715 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6716 for strings displayed in the mode or top line.
6718 Set *ENDPTR to the next position where to check for faces in
6719 STRING; -1 if the face is constant from POS to the end of the
6722 Value is the id of the face to use. The face returned is suitable
6723 for displaying ASCII characters. */
6726 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6727 region_end
, endptr
, base_face_id
)
6731 int region_beg
, region_end
;
6733 enum face_id base_face_id
;
6735 Lisp_Object prop
, position
, end
, limit
;
6736 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6737 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6738 struct face
*base_face
;
6739 int multibyte_p
= STRING_MULTIBYTE (string
);
6741 /* Get the value of the face property at the current position within
6742 STRING. Value is nil if there is no face property. */
6743 XSETFASTINT (position
, pos
);
6744 prop
= Fget_text_property (position
, Qface
, string
);
6746 /* Get the next position at which to check for faces. Value of end
6747 is nil if face is constant all the way to the end of the string.
6748 Otherwise it is a string position where to check faces next.
6749 Limit is the maximum position up to which to check for property
6750 changes in Fnext_single_property_change. Strings are usually
6751 short, so set the limit to the end of the string. */
6752 XSETFASTINT (limit
, XSTRING (string
)->size
);
6753 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6755 *endptr
= XFASTINT (end
);
6759 base_face
= FACE_FROM_ID (f
, base_face_id
);
6760 xassert (base_face
);
6762 /* Optimize the default case that there is no face property and we
6763 are not in the region. */
6765 && (base_face_id
!= DEFAULT_FACE_ID
6766 /* BUFPOS <= 0 means STRING is not an overlay string, so
6767 that the region doesn't have to be taken into account. */
6769 || bufpos
< region_beg
6770 || bufpos
>= region_end
)
6772 /* We can't realize faces for different charsets differently
6773 if we don't have fonts, so we can stop here if not working
6774 on a window-system frame. */
6775 || !FRAME_WINDOW_P (f
)
6776 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6777 return base_face
->id
;
6779 /* Begin with attributes from the base face. */
6780 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6782 /* Merge in attributes specified via text properties. */
6784 merge_face_vector_with_property (f
, attrs
, prop
);
6786 /* If in the region, merge in the region face. */
6788 && bufpos
>= region_beg
6789 && bufpos
< region_end
)
6791 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6792 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6795 /* Look up a realized face with the given face attributes,
6796 or realize a new one for ASCII characters. */
6797 return lookup_face (f
, attrs
, 0, NULL
);
6802 /***********************************************************************
6804 ***********************************************************************/
6808 /* Print the contents of the realized face FACE to stderr. */
6811 dump_realized_face (face
)
6814 fprintf (stderr
, "ID: %d\n", face
->id
);
6815 #ifdef HAVE_X_WINDOWS
6816 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6818 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6820 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6821 fprintf (stderr
, "background: 0x%lx (%s)\n",
6823 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6824 fprintf (stderr
, "font_name: %s (%s)\n",
6826 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6827 #ifdef HAVE_X_WINDOWS
6828 fprintf (stderr
, "font = %p\n", face
->font
);
6830 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6831 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6832 fprintf (stderr
, "underline: %d (%s)\n",
6834 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6835 fprintf (stderr
, "hash: %d\n", face
->hash
);
6836 fprintf (stderr
, "charset: %d\n", face
->charset
);
6840 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6848 fprintf (stderr
, "font selection order: ");
6849 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6850 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6851 fprintf (stderr
, "\n");
6853 fprintf (stderr
, "alternative fonts: ");
6854 debug_print (Vface_alternative_font_family_alist
);
6855 fprintf (stderr
, "\n");
6857 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6858 Fdump_face (make_number (i
));
6863 CHECK_NUMBER (n
, 0);
6864 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6866 error ("Not a valid face");
6867 dump_realized_face (face
);
6874 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6878 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6879 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6880 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6884 #endif /* GLYPH_DEBUG != 0 */
6888 /***********************************************************************
6890 ***********************************************************************/
6895 Qface
= intern ("face");
6897 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6898 staticpro (&Qbitmap_spec_p
);
6899 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6900 staticpro (&Qframe_update_face_colors
);
6902 /* Lisp face attribute keywords. */
6903 QCfamily
= intern (":family");
6904 staticpro (&QCfamily
);
6905 QCheight
= intern (":height");
6906 staticpro (&QCheight
);
6907 QCweight
= intern (":weight");
6908 staticpro (&QCweight
);
6909 QCslant
= intern (":slant");
6910 staticpro (&QCslant
);
6911 QCunderline
= intern (":underline");
6912 staticpro (&QCunderline
);
6913 QCinverse_video
= intern (":inverse-video");
6914 staticpro (&QCinverse_video
);
6915 QCreverse_video
= intern (":reverse-video");
6916 staticpro (&QCreverse_video
);
6917 QCforeground
= intern (":foreground");
6918 staticpro (&QCforeground
);
6919 QCbackground
= intern (":background");
6920 staticpro (&QCbackground
);
6921 QCstipple
= intern (":stipple");;
6922 staticpro (&QCstipple
);
6923 QCwidth
= intern (":width");
6924 staticpro (&QCwidth
);
6925 QCfont
= intern (":font");
6926 staticpro (&QCfont
);
6927 QCbold
= intern (":bold");
6928 staticpro (&QCbold
);
6929 QCitalic
= intern (":italic");
6930 staticpro (&QCitalic
);
6931 QCoverline
= intern (":overline");
6932 staticpro (&QCoverline
);
6933 QCstrike_through
= intern (":strike-through");
6934 staticpro (&QCstrike_through
);
6935 QCbox
= intern (":box");
6937 QCinherit
= intern (":inherit");
6938 staticpro (&QCinherit
);
6940 /* Symbols used for Lisp face attribute values. */
6941 QCcolor
= intern (":color");
6942 staticpro (&QCcolor
);
6943 QCline_width
= intern (":line-width");
6944 staticpro (&QCline_width
);
6945 QCstyle
= intern (":style");
6946 staticpro (&QCstyle
);
6947 Qreleased_button
= intern ("released-button");
6948 staticpro (&Qreleased_button
);
6949 Qpressed_button
= intern ("pressed-button");
6950 staticpro (&Qpressed_button
);
6951 Qnormal
= intern ("normal");
6952 staticpro (&Qnormal
);
6953 Qultra_light
= intern ("ultra-light");
6954 staticpro (&Qultra_light
);
6955 Qextra_light
= intern ("extra-light");
6956 staticpro (&Qextra_light
);
6957 Qlight
= intern ("light");
6958 staticpro (&Qlight
);
6959 Qsemi_light
= intern ("semi-light");
6960 staticpro (&Qsemi_light
);
6961 Qsemi_bold
= intern ("semi-bold");
6962 staticpro (&Qsemi_bold
);
6963 Qbold
= intern ("bold");
6965 Qextra_bold
= intern ("extra-bold");
6966 staticpro (&Qextra_bold
);
6967 Qultra_bold
= intern ("ultra-bold");
6968 staticpro (&Qultra_bold
);
6969 Qoblique
= intern ("oblique");
6970 staticpro (&Qoblique
);
6971 Qitalic
= intern ("italic");
6972 staticpro (&Qitalic
);
6973 Qreverse_oblique
= intern ("reverse-oblique");
6974 staticpro (&Qreverse_oblique
);
6975 Qreverse_italic
= intern ("reverse-italic");
6976 staticpro (&Qreverse_italic
);
6977 Qultra_condensed
= intern ("ultra-condensed");
6978 staticpro (&Qultra_condensed
);
6979 Qextra_condensed
= intern ("extra-condensed");
6980 staticpro (&Qextra_condensed
);
6981 Qcondensed
= intern ("condensed");
6982 staticpro (&Qcondensed
);
6983 Qsemi_condensed
= intern ("semi-condensed");
6984 staticpro (&Qsemi_condensed
);
6985 Qsemi_expanded
= intern ("semi-expanded");
6986 staticpro (&Qsemi_expanded
);
6987 Qexpanded
= intern ("expanded");
6988 staticpro (&Qexpanded
);
6989 Qextra_expanded
= intern ("extra-expanded");
6990 staticpro (&Qextra_expanded
);
6991 Qultra_expanded
= intern ("ultra-expanded");
6992 staticpro (&Qultra_expanded
);
6993 Qbackground_color
= intern ("background-color");
6994 staticpro (&Qbackground_color
);
6995 Qforeground_color
= intern ("foreground-color");
6996 staticpro (&Qforeground_color
);
6997 Qunspecified
= intern ("unspecified");
6998 staticpro (&Qunspecified
);
7000 Qface_alias
= intern ("face-alias");
7001 staticpro (&Qface_alias
);
7002 Qdefault
= intern ("default");
7003 staticpro (&Qdefault
);
7004 Qtool_bar
= intern ("tool-bar");
7005 staticpro (&Qtool_bar
);
7006 Qregion
= intern ("region");
7007 staticpro (&Qregion
);
7008 Qfringe
= intern ("fringe");
7009 staticpro (&Qfringe
);
7010 Qheader_line
= intern ("header-line");
7011 staticpro (&Qheader_line
);
7012 Qscroll_bar
= intern ("scroll-bar");
7013 staticpro (&Qscroll_bar
);
7014 Qmenu
= intern ("menu");
7016 Qcursor
= intern ("cursor");
7017 staticpro (&Qcursor
);
7018 Qborder
= intern ("border");
7019 staticpro (&Qborder
);
7020 Qmouse
= intern ("mouse");
7021 staticpro (&Qmouse
);
7022 Qtty_color_desc
= intern ("tty-color-desc");
7023 staticpro (&Qtty_color_desc
);
7024 Qtty_color_by_index
= intern ("tty-color-by-index");
7025 staticpro (&Qtty_color_by_index
);
7026 Qtty_color_alist
= intern ("tty-color-alist");
7027 staticpro (&Qtty_color_alist
);
7029 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7030 staticpro (&Vparam_value_alist
);
7031 Vface_alternative_font_family_alist
= Qnil
;
7032 staticpro (&Vface_alternative_font_family_alist
);
7034 defsubr (&Sinternal_make_lisp_face
);
7035 defsubr (&Sinternal_lisp_face_p
);
7036 defsubr (&Sinternal_set_lisp_face_attribute
);
7037 #ifdef HAVE_WINDOW_SYSTEM
7038 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7040 defsubr (&Scolor_gray_p
);
7041 defsubr (&Scolor_supported_p
);
7042 defsubr (&Sinternal_get_lisp_face_attribute
);
7043 defsubr (&Sinternal_lisp_face_attribute_values
);
7044 defsubr (&Sinternal_lisp_face_equal_p
);
7045 defsubr (&Sinternal_lisp_face_empty_p
);
7046 defsubr (&Sinternal_copy_lisp_face
);
7047 defsubr (&Sinternal_merge_in_global_face
);
7048 defsubr (&Sface_font
);
7049 defsubr (&Sframe_face_alist
);
7050 defsubr (&Sinternal_set_font_selection_order
);
7051 defsubr (&Sinternal_set_alternative_font_family_alist
);
7053 defsubr (&Sdump_face
);
7054 defsubr (&Sshow_face_resources
);
7055 #endif /* GLYPH_DEBUG */
7056 defsubr (&Sclear_face_cache
);
7057 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7059 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7060 defsubr (&Sdump_colors
);
7063 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7064 "*Limit for font matching.\n\
7065 If an integer > 0, font matching functions won't load more than\n\
7066 that number of fonts when searching for a matching font.");
7067 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7069 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7070 "List of global face definitions (for internal use only.)");
7071 Vface_new_frame_defaults
= Qnil
;
7073 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7074 "*Default stipple pattern used on monochrome displays.\n\
7075 This stipple pattern is used on monochrome displays\n\
7076 instead of shades of gray for a face background color.\n\
7077 See `set-face-stipple' for possible values for this variable.");
7078 Vface_default_stipple
= build_string ("gray3");
7080 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7081 "An alist of defined terminal colors and their RGB values.");
7082 Vtty_defined_color_alist
= Qnil
;
7084 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7085 "Allowed scalable fonts.\n\
7086 A value of nil means don't allow any scalable fonts.\n\
7087 A value of t means allow any scalable font.\n\
7088 Otherwise, value must be a list of regular expressions. A font may be\n\
7089 scaled if its name matches a regular expression in the list.");
7090 #if defined (WINDOWSNT) || defined (macintosh)
7091 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7092 by default limits the fonts available severely. */
7093 Vscalable_fonts_allowed
= Qt
;
7095 Vscalable_fonts_allowed
= Qnil
;
7098 #ifdef HAVE_WINDOW_SYSTEM
7099 defsubr (&Sbitmap_spec_p
);
7100 defsubr (&Sx_list_fonts
);
7101 defsubr (&Sinternal_face_x_get_resource
);
7102 defsubr (&Sx_family_fonts
);
7103 defsubr (&Sx_font_family_list
);
7104 #endif /* HAVE_WINDOW_SYSTEM */