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 /* Incremented for every change in the `menu' face. */
450 int menu_face_change_count
;
452 /* Non-zero means don't display bold text if a face's foreground
453 and background colors are the inverse of the default colors of the
454 display. This is a kluge to suppress `bold black' foreground text
455 which is hard to read on an LCD monitor. */
457 int tty_suppress_bold_inverse_default_colors_p
;
459 /* A list of the form `((x . y))' used to avoid consing in
460 Finternal_set_lisp_face_attribute. */
462 static Lisp_Object Vparam_value_alist
;
464 /* The total number of colors currently allocated. */
467 static int ncolors_allocated
;
468 static int npixmaps_allocated
;
474 /* Function prototypes. */
479 static void map_tty_color
P_ ((struct frame
*, struct face
*,
480 enum lface_attribute_index
, int *));
481 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
482 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
483 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
484 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
486 static int first_font_matching
P_ ((struct frame
*f
, char *,
487 struct font_name
*));
488 static int x_face_list_fonts
P_ ((struct frame
*, char *,
489 struct font_name
*, int, int, int));
490 static int font_scalable_p
P_ ((struct font_name
*));
491 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
492 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
493 static unsigned char *xstrlwr
P_ ((unsigned char *));
494 static void signal_error
P_ ((char *, Lisp_Object
));
495 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
496 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
497 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
498 static void free_face_colors
P_ ((struct frame
*, struct face
*));
499 static int face_color_gray_p
P_ ((struct frame
*, char *));
500 static char *build_font_name
P_ ((struct font_name
*));
501 static void free_font_names
P_ ((struct font_name
*, int));
502 static int sorted_font_list
P_ ((struct frame
*, char *,
503 int (*cmpfn
) P_ ((const void *, const void *)),
504 struct font_name
**));
505 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
506 Lisp_Object
, struct font_name
**));
507 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
508 Lisp_Object
, Lisp_Object
, struct font_name
**));
509 static int cmp_font_names
P_ ((const void *, const void *));
510 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
511 struct face
*, int));
512 static struct face
*realize_x_face
P_ ((struct face_cache
*,
513 Lisp_Object
*, int, struct face
*));
514 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
515 Lisp_Object
*, int));
516 static int realize_basic_faces
P_ ((struct frame
*));
517 static int realize_default_face
P_ ((struct frame
*));
518 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
519 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
520 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
521 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
522 static unsigned lface_hash
P_ ((Lisp_Object
*));
523 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
524 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
525 static void free_realized_face
P_ ((struct frame
*, struct face
*));
526 static void clear_face_gcs
P_ ((struct face_cache
*));
527 static void free_face_cache
P_ ((struct face_cache
*));
528 static int face_numeric_weight
P_ ((Lisp_Object
));
529 static int face_numeric_slant
P_ ((Lisp_Object
));
530 static int face_numeric_swidth
P_ ((Lisp_Object
));
531 static int face_fontset
P_ ((Lisp_Object
*));
532 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
533 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
534 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
535 Lisp_Object
*, Lisp_Object
));
536 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
538 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
539 Lisp_Object
, int, int));
540 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
541 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
542 static void free_realized_faces
P_ ((struct face_cache
*));
543 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
544 struct font_name
*, int));
545 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
546 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
547 static int xlfd_numeric_slant
P_ ((struct font_name
*));
548 static int xlfd_numeric_weight
P_ ((struct font_name
*));
549 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
550 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
551 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
552 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
553 static int xlfd_fixed_p
P_ ((struct font_name
*));
554 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
556 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
557 struct font_name
*, int,
559 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
560 struct font_name
*, int));
562 #ifdef HAVE_WINDOW_SYSTEM
564 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
565 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
566 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
567 int (*cmpfn
) P_ ((const void *, const void *))));
568 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
569 static void x_free_gc
P_ ((struct frame
*, GC
));
570 static void clear_font_table
P_ ((struct frame
*));
573 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
574 #endif /* WINDOWSNT */
576 #endif /* HAVE_WINDOW_SYSTEM */
579 /***********************************************************************
581 ***********************************************************************/
583 #ifdef HAVE_X_WINDOWS
585 #ifdef DEBUG_X_COLORS
587 /* The following is a poor mans infrastructure for debugging X color
588 allocation problems on displays with PseudoColor-8. Some X servers
589 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
590 color reference counts completely so that they don't signal an
591 error when a color is freed whose reference count is already 0.
592 Other X servers do. To help me debug this, the following code
593 implements a simple reference counting schema of its own, for a
594 single display/screen. --gerd. */
596 /* Reference counts for pixel colors. */
598 int color_count
[256];
600 /* Register color PIXEL as allocated. */
603 register_color (pixel
)
606 xassert (pixel
< 256);
607 ++color_count
[pixel
];
611 /* Register color PIXEL as deallocated. */
614 unregister_color (pixel
)
617 xassert (pixel
< 256);
618 if (color_count
[pixel
] > 0)
619 --color_count
[pixel
];
625 /* Register N colors from PIXELS as deallocated. */
628 unregister_colors (pixels
, n
)
629 unsigned long *pixels
;
633 for (i
= 0; i
< n
; ++i
)
634 unregister_color (pixels
[i
]);
638 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
639 "Dump currently allocated colors and their reference counts to stderr.")
644 fputc ('\n', stderr
);
646 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
649 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
652 fputc ('\n', stderr
);
654 fputc ('\t', stderr
);
658 fputc ('\n', stderr
);
662 #endif /* DEBUG_X_COLORS */
665 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
666 color values. Interrupt input must be blocked when this function
670 x_free_colors (f
, pixels
, npixels
)
672 unsigned long *pixels
;
675 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
677 /* If display has an immutable color map, freeing colors is not
678 necessary and some servers don't allow it. So don't do it. */
679 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
681 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
683 #ifdef DEBUG_X_COLORS
684 unregister_colors (pixels
, npixels
);
690 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
691 color values. Interrupt input must be blocked when this function
695 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
699 unsigned long *pixels
;
702 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
703 int class = dpyinfo
->visual
->class;
705 /* If display has an immutable color map, freeing colors is not
706 necessary and some servers don't allow it. So don't do it. */
707 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
709 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
710 #ifdef DEBUG_X_COLORS
711 unregister_colors (pixels
, npixels
);
717 /* Create and return a GC for use on frame F. GC values and mask
718 are given by XGCV and MASK. */
721 x_create_gc (f
, mask
, xgcv
)
728 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
735 /* Free GC which was used on frame F. */
743 xassert (--ngcs
>= 0);
744 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
748 #endif /* HAVE_X_WINDOWS */
751 /* W32 emulation of GCs */
754 x_create_gc (f
, mask
, xgcv
)
761 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
768 /* Free GC which was used on frame F. */
776 xassert (--ngcs
>= 0);
781 #endif /* WINDOWSNT */
783 /* Like stricmp. Used to compare parts of font names which are in
788 unsigned char *s1
, *s2
;
792 unsigned char c1
= tolower (*s1
);
793 unsigned char c2
= tolower (*s2
);
795 return c1
< c2
? -1 : 1;
800 return *s2
== 0 ? 0 : -1;
805 /* Like strlwr, which might not always be available. */
807 static unsigned char *
811 unsigned char *p
= s
;
820 /* Signal `error' with message S, and additional argument ARG. */
823 signal_error (s
, arg
)
827 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
831 /* If FRAME is nil, return a pointer to the selected frame.
832 Otherwise, check that FRAME is a live frame, and return a pointer
833 to it. NPARAM is the parameter number of FRAME, for
834 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
835 Lisp function definitions. */
837 static INLINE
struct frame
*
838 frame_or_selected_frame (frame
, nparam
)
843 frame
= selected_frame
;
845 CHECK_LIVE_FRAME (frame
, nparam
);
846 return XFRAME (frame
);
850 /***********************************************************************
852 ***********************************************************************/
854 /* Initialize face cache and basic faces for frame F. */
860 /* Make a face cache, if F doesn't have one. */
861 if (FRAME_FACE_CACHE (f
) == NULL
)
862 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
864 #ifdef HAVE_WINDOW_SYSTEM
865 /* Make the image cache. */
866 if (FRAME_WINDOW_P (f
))
868 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
869 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
870 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
872 #endif /* HAVE_WINDOW_SYSTEM */
874 /* Realize basic faces. Must have enough information in frame
875 parameters to realize basic faces at this point. */
876 #ifdef HAVE_X_WINDOWS
877 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
880 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
882 if (!realize_basic_faces (f
))
887 /* Free face cache of frame F. Called from Fdelete_frame. */
893 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
897 free_face_cache (face_cache
);
898 FRAME_FACE_CACHE (f
) = NULL
;
901 #ifdef HAVE_WINDOW_SYSTEM
902 if (FRAME_WINDOW_P (f
))
904 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
907 --image_cache
->refcount
;
908 if (image_cache
->refcount
== 0)
909 free_image_cache (f
);
912 #endif /* HAVE_WINDOW_SYSTEM */
916 /* Clear face caches, and recompute basic faces for frame F. Call
917 this after changing frame parameters on which those faces depend,
918 or when realized faces have been freed due to changing attributes
922 recompute_basic_faces (f
)
925 if (FRAME_FACE_CACHE (f
))
927 clear_face_cache (0);
928 if (!realize_basic_faces (f
))
934 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
935 try to free unused fonts, too. */
938 clear_face_cache (clear_fonts_p
)
941 #ifdef HAVE_WINDOW_SYSTEM
942 Lisp_Object tail
, frame
;
946 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
948 /* From time to time see if we can unload some fonts. This also
949 frees all realized faces on all frames. Fonts needed by
950 faces will be loaded again when faces are realized again. */
951 clear_font_table_count
= 0;
953 FOR_EACH_FRAME (tail
, frame
)
956 if (FRAME_WINDOW_P (f
)
957 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
959 free_all_realized_faces (frame
);
960 clear_font_table (f
);
966 /* Clear GCs of realized faces. */
967 FOR_EACH_FRAME (tail
, frame
)
970 if (FRAME_WINDOW_P (f
))
972 clear_face_gcs (FRAME_FACE_CACHE (f
));
973 clear_image_cache (f
, 0);
977 #endif /* HAVE_WINDOW_SYSTEM */
981 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
982 "Clear face caches on all frames.\n\
983 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
985 Lisp_Object thorougly
;
987 clear_face_cache (!NILP (thorougly
));
989 ++windows_or_buffers_changed
;
995 #ifdef HAVE_WINDOW_SYSTEM
998 /* Remove those fonts from the font table of frame F exept for the
999 default ASCII font for the frame. Called from clear_face_cache
1000 from time to time. */
1003 clear_font_table (f
)
1006 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1009 xassert (FRAME_WINDOW_P (f
));
1011 /* Free those fonts that are not used by the frame F as the default. */
1012 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1014 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1016 if (!font_info
->name
1017 || font_info
->font
== FRAME_FONT (f
))
1021 if (font_info
->full_name
!= font_info
->name
)
1022 xfree (font_info
->full_name
);
1023 xfree (font_info
->name
);
1025 /* Free the font. */
1027 #ifdef HAVE_X_WINDOWS
1028 XFreeFont (dpyinfo
->display
, font_info
->font
);
1031 w32_unload_font (dpyinfo
, font_info
->font
);
1035 /* Mark font table slot free. */
1036 font_info
->font
= NULL
;
1037 font_info
->name
= font_info
->full_name
= NULL
;
1041 #endif /* HAVE_WINDOW_SYSTEM */
1045 /***********************************************************************
1047 ***********************************************************************/
1049 #ifdef HAVE_WINDOW_SYSTEM
1051 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1052 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1053 A bitmap specification is either a string, a file name, or a list\n\
1054 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1055 HEIGHT is its height, and DATA is a string containing the bits of\n\
1056 the pixmap. Bits are stored row by row, each row occupies\n\
1057 (WIDTH + 7)/8 bytes.")
1063 if (STRINGP (object
))
1064 /* If OBJECT is a string, it's a file name. */
1066 else if (CONSP (object
))
1068 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1069 HEIGHT must be integers > 0, and DATA must be string large
1070 enough to hold a bitmap of the specified size. */
1071 Lisp_Object width
, height
, data
;
1073 height
= width
= data
= Qnil
;
1077 width
= XCAR (object
);
1078 object
= XCDR (object
);
1081 height
= XCAR (object
);
1082 object
= XCDR (object
);
1084 data
= XCAR (object
);
1088 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1090 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1092 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1097 return pixmap_p
? Qt
: Qnil
;
1101 /* Load a bitmap according to NAME (which is either a file name or a
1102 pixmap spec) for use on frame F. Value is the bitmap_id (see
1103 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1104 bitmap cannot be loaded, display a message saying so, and return
1105 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1106 if these pointers are not null. */
1109 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1112 unsigned int *w_ptr
, *h_ptr
;
1120 tem
= Fbitmap_spec_p (name
);
1122 wrong_type_argument (Qbitmap_spec_p
, name
);
1127 /* Decode a bitmap spec into a bitmap. */
1132 w
= XINT (Fcar (name
));
1133 h
= XINT (Fcar (Fcdr (name
)));
1134 bits
= Fcar (Fcdr (Fcdr (name
)));
1136 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1141 /* It must be a string -- a file name. */
1142 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1148 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1159 ++npixmaps_allocated
;
1162 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1165 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1171 #endif /* HAVE_WINDOW_SYSTEM */
1175 /***********************************************************************
1177 ***********************************************************************/
1179 #ifdef HAVE_WINDOW_SYSTEM
1181 /* Update the line_height of frame F. Return non-zero if line height
1185 frame_update_line_height (f
)
1188 int line_height
, changed_p
;
1190 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1191 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1192 FRAME_LINE_HEIGHT (f
) = line_height
;
1196 #endif /* HAVE_WINDOW_SYSTEM */
1199 /***********************************************************************
1201 ***********************************************************************/
1203 #ifdef HAVE_WINDOW_SYSTEM
1205 /* Load font of face FACE which is used on frame F to display
1206 character C. The name of the font to load is determined by lface
1207 and fontset of FACE. */
1210 load_face_font (f
, face
, c
)
1215 struct font_info
*font_info
= NULL
;
1218 face
->font_info_id
= -1;
1221 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1226 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1231 face
->font_info_id
= font_info
->font_idx
;
1232 face
->font
= font_info
->font
;
1233 face
->font_name
= font_info
->full_name
;
1236 x_free_gc (f
, face
->gc
);
1241 add_to_log ("Unable to load font %s",
1242 build_string (font_name
), Qnil
);
1246 #endif /* HAVE_WINDOW_SYSTEM */
1250 /***********************************************************************
1252 ***********************************************************************/
1254 /* A version of defined_color for non-X frames. */
1257 tty_defined_color (f
, color_name
, color_def
, alloc
)
1263 Lisp_Object color_desc
;
1264 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1265 unsigned long red
= 0, green
= 0, blue
= 0;
1268 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1272 XSETFRAME (frame
, f
);
1274 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1275 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1277 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1278 if (CONSP (XCDR (XCDR (color_desc
))))
1280 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1281 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1282 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1286 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1287 /* We were called early during startup, and the colors are not
1288 yet set up in tty-defined-color-alist. Don't return a failure
1289 indication, since this produces the annoying "Unable to
1290 load color" messages in the *Messages* buffer. */
1293 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1295 if (strcmp (color_name
, "unspecified-fg") == 0)
1296 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1297 else if (strcmp (color_name
, "unspecified-bg") == 0)
1298 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1301 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1304 color_def
->pixel
= color_idx
;
1305 color_def
->red
= red
;
1306 color_def
->green
= green
;
1307 color_def
->blue
= blue
;
1313 /* Decide if color named COLOR_NAME is valid for the display
1314 associated with the frame F; if so, return the rgb values in
1315 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1317 This does the right thing for any type of frame. */
1320 defined_color (f
, color_name
, color_def
, alloc
)
1326 if (!FRAME_WINDOW_P (f
))
1327 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1328 #ifdef HAVE_X_WINDOWS
1329 else if (FRAME_X_P (f
))
1330 return x_defined_color (f
, color_name
, color_def
, alloc
);
1333 else if (FRAME_W32_P (f
))
1334 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1337 else if (FRAME_MAC_P (f
))
1338 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1345 /* Given the index IDX of a tty color on frame F, return its name, a
1349 tty_color_name (f
, idx
)
1353 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1356 Lisp_Object coldesc
;
1358 XSETFRAME (frame
, f
);
1359 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1361 if (!NILP (coldesc
))
1362 return XCAR (coldesc
);
1365 /* We can have an MSDOG frame under -nw for a short window of
1366 opportunity before internal_terminal_init is called. DTRT. */
1367 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1368 return msdos_stdcolor_name (idx
);
1371 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1372 return build_string (unspecified_fg
);
1373 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1374 return build_string (unspecified_bg
);
1377 return vga_stdcolor_name (idx
);
1380 return Qunspecified
;
1384 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1385 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1388 face_color_gray_p (f
, color_name
)
1395 if (defined_color (f
, color_name
, &color
, 0))
1396 gray_p
= ((abs (color
.red
- color
.green
)
1397 < max (color
.red
, color
.green
) / 20)
1398 && (abs (color
.green
- color
.blue
)
1399 < max (color
.green
, color
.blue
) / 20)
1400 && (abs (color
.blue
- color
.red
)
1401 < max (color
.blue
, color
.red
) / 20));
1409 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1410 BACKGROUND_P non-zero means the color will be used as background
1414 face_color_supported_p (f
, color_name
, background_p
)
1422 XSETFRAME (frame
, f
);
1423 return (FRAME_WINDOW_P (f
)
1424 ? (!NILP (Fxw_display_color_p (frame
))
1425 || xstricmp (color_name
, "black") == 0
1426 || xstricmp (color_name
, "white") == 0
1428 && face_color_gray_p (f
, color_name
))
1429 || (!NILP (Fx_display_grayscale_p (frame
))
1430 && face_color_gray_p (f
, color_name
)))
1431 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1435 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1436 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1437 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1438 If FRAME is nil or omitted, use the selected frame.")
1440 Lisp_Object color
, frame
;
1444 CHECK_FRAME (frame
, 0);
1445 CHECK_STRING (color
, 0);
1447 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1451 DEFUN ("color-supported-p", Fcolor_supported_p
,
1452 Scolor_supported_p
, 2, 3, 0,
1453 "Return non-nil if COLOR can be displayed on FRAME.\n\
1454 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1455 If FRAME is nil or omitted, use the selected frame.\n\
1456 COLOR must be a valid color name.")
1457 (color
, frame
, background_p
)
1458 Lisp_Object frame
, color
, background_p
;
1462 CHECK_FRAME (frame
, 0);
1463 CHECK_STRING (color
, 0);
1465 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1471 /* Load color with name NAME for use by face FACE on frame F.
1472 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1473 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1474 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1475 pixel color. If color cannot be loaded, display a message, and
1476 return the foreground, background or underline color of F, but
1477 record that fact in flags of the face so that we don't try to free
1481 load_color (f
, face
, name
, target_index
)
1485 enum lface_attribute_index target_index
;
1489 xassert (STRINGP (name
));
1490 xassert (target_index
== LFACE_FOREGROUND_INDEX
1491 || target_index
== LFACE_BACKGROUND_INDEX
1492 || target_index
== LFACE_UNDERLINE_INDEX
1493 || target_index
== LFACE_OVERLINE_INDEX
1494 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1495 || target_index
== LFACE_BOX_INDEX
);
1497 /* if the color map is full, defined_color will return a best match
1498 to the values in an existing cell. */
1499 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1501 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1503 switch (target_index
)
1505 case LFACE_FOREGROUND_INDEX
:
1506 face
->foreground_defaulted_p
= 1;
1507 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1510 case LFACE_BACKGROUND_INDEX
:
1511 face
->background_defaulted_p
= 1;
1512 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1515 case LFACE_UNDERLINE_INDEX
:
1516 face
->underline_defaulted_p
= 1;
1517 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1520 case LFACE_OVERLINE_INDEX
:
1521 face
->overline_color_defaulted_p
= 1;
1522 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1525 case LFACE_STRIKE_THROUGH_INDEX
:
1526 face
->strike_through_color_defaulted_p
= 1;
1527 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1530 case LFACE_BOX_INDEX
:
1531 face
->box_color_defaulted_p
= 1;
1532 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1541 ++ncolors_allocated
;
1548 #ifdef HAVE_WINDOW_SYSTEM
1550 /* Load colors for face FACE which is used on frame F. Colors are
1551 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1552 of ATTRS. If the background color specified is not supported on F,
1553 try to emulate gray colors with a stipple from Vface_default_stipple. */
1556 load_face_colors (f
, face
, attrs
)
1563 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1564 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1566 /* Swap colors if face is inverse-video. */
1567 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1575 /* Check for support for foreground, not for background because
1576 face_color_supported_p is smart enough to know that grays are
1577 "supported" as background because we are supposed to use stipple
1579 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1580 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1582 x_destroy_bitmap (f
, face
->stipple
);
1583 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1584 &face
->pixmap_w
, &face
->pixmap_h
);
1587 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1588 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1592 /* Free color PIXEL on frame F. */
1595 unload_color (f
, pixel
)
1597 unsigned long pixel
;
1599 #ifdef HAVE_X_WINDOWS
1601 x_free_colors (f
, &pixel
, 1);
1607 /* Free colors allocated for FACE. */
1610 free_face_colors (f
, face
)
1614 #ifdef HAVE_X_WINDOWS
1617 if (!face
->foreground_defaulted_p
)
1619 x_free_colors (f
, &face
->foreground
, 1);
1620 IF_DEBUG (--ncolors_allocated
);
1623 if (!face
->background_defaulted_p
)
1625 x_free_colors (f
, &face
->background
, 1);
1626 IF_DEBUG (--ncolors_allocated
);
1629 if (face
->underline_p
1630 && !face
->underline_defaulted_p
)
1632 x_free_colors (f
, &face
->underline_color
, 1);
1633 IF_DEBUG (--ncolors_allocated
);
1636 if (face
->overline_p
1637 && !face
->overline_color_defaulted_p
)
1639 x_free_colors (f
, &face
->overline_color
, 1);
1640 IF_DEBUG (--ncolors_allocated
);
1643 if (face
->strike_through_p
1644 && !face
->strike_through_color_defaulted_p
)
1646 x_free_colors (f
, &face
->strike_through_color
, 1);
1647 IF_DEBUG (--ncolors_allocated
);
1650 if (face
->box
!= FACE_NO_BOX
1651 && !face
->box_color_defaulted_p
)
1653 x_free_colors (f
, &face
->box_color
, 1);
1654 IF_DEBUG (--ncolors_allocated
);
1658 #endif /* HAVE_X_WINDOWS */
1661 #endif /* HAVE_WINDOW_SYSTEM */
1665 /***********************************************************************
1667 ***********************************************************************/
1669 /* An enumerator for each field of an XLFD font name. */
1690 /* An enumerator for each possible slant value of a font. Taken from
1691 the XLFD specification. */
1699 XLFD_SLANT_REVERSE_ITALIC
,
1700 XLFD_SLANT_REVERSE_OBLIQUE
,
1704 /* Relative font weight according to XLFD documentation. */
1708 XLFD_WEIGHT_UNKNOWN
,
1709 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1710 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1711 XLFD_WEIGHT_LIGHT
, /* 30 */
1712 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1713 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1714 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1715 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1716 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1717 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1720 /* Relative proportionate width. */
1724 XLFD_SWIDTH_UNKNOWN
,
1725 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1726 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1727 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1728 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1729 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1730 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1731 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1732 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1733 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1736 /* Structure used for tables mapping XLFD weight, slant, and width
1737 names to numeric and symbolic values. */
1743 Lisp_Object
*symbol
;
1746 /* Table of XLFD slant names and their numeric and symbolic
1747 representations. This table must be sorted by slant names in
1750 static struct table_entry slant_table
[] =
1752 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1753 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1754 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1755 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1756 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1757 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1760 /* Table of XLFD weight names. This table must be sorted by weight
1761 names in ascending order. */
1763 static struct table_entry weight_table
[] =
1765 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1766 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1767 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1768 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1769 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1770 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1771 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1772 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1773 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1774 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1775 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1776 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1777 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1778 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1779 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1782 /* Table of XLFD width names. This table must be sorted by width
1783 names in ascending order. */
1785 static struct table_entry swidth_table
[] =
1787 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1788 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1789 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1790 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1791 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1792 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1793 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1794 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1795 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1796 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1797 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1798 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1799 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1800 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1801 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1804 /* Structure used to hold the result of splitting font names in XLFD
1805 format into their fields. */
1809 /* The original name which is modified destructively by
1810 split_font_name. The pointer is kept here to be able to free it
1811 if it was allocated from the heap. */
1814 /* Font name fields. Each vector element points into `name' above.
1815 Fields are NUL-terminated. */
1816 char *fields
[XLFD_LAST
];
1818 /* Numeric values for those fields that interest us. See
1819 split_font_name for which these are. */
1820 int numeric
[XLFD_LAST
];
1823 /* The frame in effect when sorting font names. Set temporarily in
1824 sort_fonts so that it is available in font comparison functions. */
1826 static struct frame
*font_frame
;
1828 /* Order by which font selection chooses fonts. The default values
1829 mean `first, find a best match for the font width, then for the
1830 font height, then for weight, then for slant.' This variable can be
1831 set via set-face-font-sort-order. */
1834 static int font_sort_order
[4] = { XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
};
1836 static int font_sort_order
[4];
1839 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1840 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1841 is a pointer to the matching table entry or null if no table entry
1844 static struct table_entry
*
1845 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1846 struct table_entry
*table
;
1848 struct font_name
*font
;
1851 /* Function split_font_name converts fields to lower-case, so there
1852 is no need to use xstrlwr or xstricmp here. */
1853 char *s
= font
->fields
[field_index
];
1854 int low
, mid
, high
, cmp
;
1861 mid
= (low
+ high
) / 2;
1862 cmp
= strcmp (table
[mid
].name
, s
);
1876 /* Return a numeric representation for font name field
1877 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1878 has DIM entries. Value is the numeric value found or DFLT if no
1879 table entry matches. This function is used to translate weight,
1880 slant, and swidth names of XLFD font names to numeric values. */
1883 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1884 struct table_entry
*table
;
1886 struct font_name
*font
;
1890 struct table_entry
*p
;
1891 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1892 return p
? p
->numeric
: dflt
;
1896 /* Return a symbolic representation for font name field
1897 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1898 has DIM entries. Value is the symbolic value found or DFLT if no
1899 table entry matches. This function is used to translate weight,
1900 slant, and swidth names of XLFD font names to symbols. */
1902 static INLINE Lisp_Object
1903 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1904 struct table_entry
*table
;
1906 struct font_name
*font
;
1910 struct table_entry
*p
;
1911 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1912 return p
? *p
->symbol
: dflt
;
1916 /* Return a numeric value for the slant of the font given by FONT. */
1919 xlfd_numeric_slant (font
)
1920 struct font_name
*font
;
1922 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1923 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1927 /* Return a symbol representing the weight of the font given by FONT. */
1929 static INLINE Lisp_Object
1930 xlfd_symbolic_slant (font
)
1931 struct font_name
*font
;
1933 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1934 font
, XLFD_SLANT
, Qnormal
);
1938 /* Return a numeric value for the weight of the font given by FONT. */
1941 xlfd_numeric_weight (font
)
1942 struct font_name
*font
;
1944 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1945 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1949 /* Return a symbol representing the slant of the font given by FONT. */
1951 static INLINE Lisp_Object
1952 xlfd_symbolic_weight (font
)
1953 struct font_name
*font
;
1955 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1956 font
, XLFD_WEIGHT
, Qnormal
);
1960 /* Return a numeric value for the swidth of the font whose XLFD font
1961 name fields are found in FONT. */
1964 xlfd_numeric_swidth (font
)
1965 struct font_name
*font
;
1967 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1968 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1972 /* Return a symbolic value for the swidth of FONT. */
1974 static INLINE Lisp_Object
1975 xlfd_symbolic_swidth (font
)
1976 struct font_name
*font
;
1978 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1979 font
, XLFD_SWIDTH
, Qnormal
);
1983 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1984 entries. Value is a pointer to the matching table entry or null if
1985 no element of TABLE contains SYMBOL. */
1987 static struct table_entry
*
1988 face_value (table
, dim
, symbol
)
1989 struct table_entry
*table
;
1995 xassert (SYMBOLP (symbol
));
1997 for (i
= 0; i
< dim
; ++i
)
1998 if (EQ (*table
[i
].symbol
, symbol
))
2001 return i
< dim
? table
+ i
: NULL
;
2005 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2006 entries. Value is -1 if SYMBOL is not found in TABLE. */
2009 face_numeric_value (table
, dim
, symbol
)
2010 struct table_entry
*table
;
2014 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2015 return p
? p
->numeric
: -1;
2019 /* Return a numeric value representing the weight specified by Lisp
2020 symbol WEIGHT. Value is one of the enumerators of enum
2024 face_numeric_weight (weight
)
2027 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2031 /* Return a numeric value representing the slant specified by Lisp
2032 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2035 face_numeric_slant (slant
)
2038 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2042 /* Return a numeric value representing the swidth specified by Lisp
2043 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2046 face_numeric_swidth (width
)
2049 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2053 #ifdef HAVE_WINDOW_SYSTEM
2055 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2059 struct font_name
*font
;
2061 /* Function split_font_name converts fields to lower-case, so there
2062 is no need to use tolower here. */
2063 return *font
->fields
[XLFD_SPACING
] != 'p';
2067 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2069 The actual height of the font when displayed on F depends on the
2070 resolution of both the font and frame. For example, a 10pt font
2071 designed for a 100dpi display will display larger than 10pt on a
2072 75dpi display. (It's not unusual to use fonts not designed for the
2073 display one is using. For example, some intlfonts are available in
2074 72dpi versions, only.)
2076 Value is the real point size of FONT on frame F, or 0 if it cannot
2080 xlfd_point_size (f
, font
)
2082 struct font_name
*font
;
2084 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2085 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2086 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2089 if (font_resy
== 0 || font_pt
== 0)
2092 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2098 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2099 of frame F. This function is used to guess a point size of font
2100 when only the pixel height of the font is available. */
2103 pixel_point_size (f
, pixel
)
2107 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2111 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2112 real_pt
= pixel
* 72 / resy
;
2113 int_pt
= real_pt
+ 0.5;
2119 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2120 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2121 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2122 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2123 zero if the font name doesn't have the format we expect. The
2124 expected format is a font name that starts with a `-' and has
2125 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2126 forms of font names where certain field contents are enclosed in
2127 square brackets. We don't support that, for now. */
2130 split_font_name (f
, font
, numeric_p
)
2132 struct font_name
*font
;
2138 if (*font
->name
== '-')
2140 char *p
= xstrlwr (font
->name
) + 1;
2142 while (i
< XLFD_LAST
)
2144 font
->fields
[i
] = p
;
2147 while (*p
&& *p
!= '-')
2157 success_p
= i
== XLFD_LAST
;
2159 /* If requested, and font name was in the expected format,
2160 compute numeric values for some fields. */
2161 if (numeric_p
&& success_p
)
2163 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2164 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2165 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2166 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2167 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2174 /* Build an XLFD font name from font name fields in FONT. Value is a
2175 pointer to the font name, which is allocated via xmalloc. */
2178 build_font_name (font
)
2179 struct font_name
*font
;
2183 char *font_name
= (char *) xmalloc (size
);
2184 int total_length
= 0;
2186 for (i
= 0; i
< XLFD_LAST
; ++i
)
2188 /* Add 1 because of the leading `-'. */
2189 int len
= strlen (font
->fields
[i
]) + 1;
2191 /* Reallocate font_name if necessary. Add 1 for the final
2193 if (total_length
+ len
+ 1 >= size
)
2195 int new_size
= max (2 * size
, size
+ len
+ 1);
2196 int sz
= new_size
* sizeof *font_name
;
2197 font_name
= (char *) xrealloc (font_name
, sz
);
2201 font_name
[total_length
] = '-';
2202 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2203 total_length
+= len
;
2206 font_name
[total_length
] = 0;
2211 /* Free an array FONTS of N font_name structures. This frees FONTS
2212 itself and all `name' fields in its elements. */
2215 free_font_names (fonts
, n
)
2216 struct font_name
*fonts
;
2220 xfree (fonts
[--n
].name
);
2225 /* Sort vector FONTS of font_name structures which contains NFONTS
2226 elements using qsort and comparison function CMPFN. F is the frame
2227 on which the fonts will be used. The global variable font_frame
2228 is temporarily set to F to make it available in CMPFN. */
2231 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2233 struct font_name
*fonts
;
2235 int (*cmpfn
) P_ ((const void *, const void *));
2238 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2243 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2244 display in x_display_list. FONTS is a pointer to a vector of
2245 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2246 alternative patterns from Valternate_fontname_alist if no fonts are
2247 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2250 For all fonts found, set FONTS[i].name to the name of the font,
2251 allocated via xmalloc, and split font names into fields. Ignore
2252 fonts that we can't parse. Value is the number of fonts found.
2254 This is similar to x_list_fonts. The differences are:
2256 1. It avoids consing.
2257 2. It never calls XLoadQueryFont. */
2260 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2264 struct font_name
*fonts
;
2265 int nfonts
, try_alternatives_p
;
2266 int scalable_fonts_p
;
2270 #ifdef HAVE_X_WINDOWS
2271 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2273 /* Get the list of fonts matching PATTERN from the X server. */
2275 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2277 #endif /* HAVE_X_WINDOWS */
2278 #if defined (WINDOWSNT) || defined (macintosh)
2279 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2280 better to do it the other way around. */
2282 Lisp_Object lpattern
, tem
;
2287 lpattern
= build_string (pattern
);
2289 /* Get the list of fonts matching PATTERN. */
2292 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2293 #else /* macintosh */
2294 lfonts
= x_list_fonts (f
, lpattern
, 0, nfonts
);
2298 /* Count fonts returned */
2299 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2302 /* Allocate array. */
2304 names
= (char **) xmalloc (n
* sizeof (char *));
2306 /* Extract font names into char * array. */
2308 for (i
= 0; i
< n
; i
++)
2310 names
[i
] = XSTRING (XCAR (tem
))->data
;
2313 #endif /* defined (WINDOWSNT) || defined (macintosh) */
2317 /* Make a copy of the font names we got from X, and
2318 split them into fields. */
2319 for (i
= j
= 0; i
< n
; ++i
)
2321 /* Make a copy of the font name. */
2322 fonts
[j
].name
= xstrdup (names
[i
]);
2324 /* Ignore fonts having a name that we can't parse. */
2325 if (!split_font_name (f
, fonts
+ j
, 1))
2326 xfree (fonts
[j
].name
);
2327 else if (font_scalable_p (fonts
+ j
))
2329 if (!scalable_fonts_p
2330 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2331 xfree (fonts
[j
].name
);
2341 #ifdef HAVE_X_WINDOWS
2342 /* Free font names. */
2344 XFreeFontNames (names
);
2350 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2351 if (n
== 0 && try_alternatives_p
)
2353 Lisp_Object list
= Valternate_fontname_alist
;
2355 while (CONSP (list
))
2357 Lisp_Object entry
= XCAR (list
);
2359 && STRINGP (XCAR (entry
))
2360 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2367 Lisp_Object patterns
= XCAR (list
);
2370 while (CONSP (patterns
)
2371 /* If list is screwed up, give up. */
2372 && (name
= XCAR (patterns
),
2374 /* Ignore patterns equal to PATTERN because we tried that
2375 already with no success. */
2376 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2377 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2381 patterns
= XCDR (patterns
);
2389 /* Determine the first font matching PATTERN on frame F. Return in
2390 *FONT the matching font name, split into fields. Value is non-zero
2391 if a match was found. */
2394 first_font_matching (f
, pattern
, font
)
2397 struct font_name
*font
;
2400 struct font_name
*fonts
;
2402 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2403 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2407 bcopy (&fonts
[0], font
, sizeof *font
);
2409 fonts
[0].name
= NULL
;
2410 free_font_names (fonts
, nfonts
);
2417 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2418 using comparison function CMPFN. Value is the number of fonts
2419 found. If value is non-zero, *FONTS is set to a vector of
2420 font_name structures allocated from the heap containing matching
2421 fonts. Each element of *FONTS contains a name member that is also
2422 allocated from the heap. Font names in these structures are split
2423 into fields. Use free_font_names to free such an array. */
2426 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2429 int (*cmpfn
) P_ ((const void *, const void *));
2430 struct font_name
**fonts
;
2434 /* Get the list of fonts matching pattern. 100 should suffice. */
2435 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2436 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2437 nfonts
= XFASTINT (Vfont_list_limit
);
2439 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2440 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2442 /* Sort the resulting array and return it in *FONTS. If no
2443 fonts were found, make sure to set *FONTS to null. */
2445 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2456 /* Compare two font_name structures *A and *B. Value is analogous to
2457 strcmp. Sort order is given by the global variable
2458 font_sort_order. Font names are sorted so that, everything else
2459 being equal, fonts with a resolution closer to that of the frame on
2460 which they are used are listed first. The global variable
2461 font_frame is the frame on which we operate. */
2464 cmp_font_names (a
, b
)
2467 struct font_name
*x
= (struct font_name
*) a
;
2468 struct font_name
*y
= (struct font_name
*) b
;
2471 /* All strings have been converted to lower-case by split_font_name,
2472 so we can use strcmp here. */
2473 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2478 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2480 int j
= font_sort_order
[i
];
2481 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2486 /* Everything else being equal, we prefer fonts with an
2487 y-resolution closer to that of the frame. */
2488 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2489 int x_resy
= x
->numeric
[XLFD_RESY
];
2490 int y_resy
= y
->numeric
[XLFD_RESY
];
2491 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2499 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2500 is non-nil list fonts matching that pattern. Otherwise, if
2501 REGISTRY is non-nil return only fonts with that registry, otherwise
2502 return fonts of any registry. Set *FONTS to a vector of font_name
2503 structures allocated from the heap containing the fonts found.
2504 Value is the number of fonts found. */
2507 font_list (f
, pattern
, family
, registry
, fonts
)
2509 Lisp_Object pattern
, family
, registry
;
2510 struct font_name
**fonts
;
2512 char *pattern_str
, *family_str
, *registry_str
;
2516 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2517 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2519 pattern_str
= (char *) alloca (strlen (family_str
)
2520 + strlen (registry_str
)
2522 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2523 strcat (pattern_str
, family_str
);
2524 strcat (pattern_str
, "-*-");
2525 strcat (pattern_str
, registry_str
);
2526 if (!index (registry_str
, '-'))
2528 if (registry_str
[strlen (registry_str
) - 1] == '*')
2529 strcat (pattern_str
, "-*");
2531 strcat (pattern_str
, "*-*");
2535 pattern_str
= (char *) XSTRING (pattern
)->data
;
2537 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2541 /* Remove elements from LIST whose cars are `equal'. Called from
2542 x-family-fonts and x-font-family-list to remove duplicate font
2546 remove_duplicates (list
)
2549 Lisp_Object tail
= list
;
2551 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2553 Lisp_Object next
= XCDR (tail
);
2554 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2555 XCDR (tail
) = XCDR (next
);
2562 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2563 "Return a list of available fonts of family FAMILY on FRAME.\n\
2564 If FAMILY is omitted or nil, list all families.\n\
2565 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2567 If FRAME is omitted or nil, use the selected frame.\n\
2568 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2569 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2570 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2571 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2572 width, weight and slant of the font. These symbols are the same as for\n\
2573 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2574 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2575 giving the registry and encoding of the font.\n\
2576 The result list is sorted according to the current setting of\n\
2577 the face font sort order.")
2579 Lisp_Object family
, frame
;
2581 struct frame
*f
= check_x_frame (frame
);
2582 struct font_name
*fonts
;
2585 struct gcpro gcpro1
;
2588 CHECK_STRING (family
, 1);
2592 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2593 for (i
= nfonts
- 1; i
>= 0; --i
)
2595 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2598 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2599 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2600 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2601 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2602 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2603 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2604 tem
= build_font_name (fonts
+ i
);
2605 ASET (v
, 6, build_string (tem
));
2606 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2607 fonts
[i
].fields
[XLFD_ENCODING
]);
2608 ASET (v
, 7, build_string (tem
));
2611 result
= Fcons (v
, result
);
2614 remove_duplicates (result
);
2615 free_font_names (fonts
, nfonts
);
2621 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2623 "Return a list of available font families on FRAME.\n\
2624 If FRAME is omitted or nil, use the selected frame.\n\
2625 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2626 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2631 struct frame
*f
= check_x_frame (frame
);
2633 struct font_name
*fonts
;
2635 struct gcpro gcpro1
;
2636 int count
= specpdl_ptr
- specpdl
;
2639 /* Let's consider all fonts. Increase the limit for matching
2640 fonts until we have them all. */
2643 specbind (intern ("font-list-limit"), make_number (limit
));
2644 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2646 if (nfonts
== limit
)
2648 free_font_names (fonts
, nfonts
);
2657 for (i
= nfonts
- 1; i
>= 0; --i
)
2658 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2659 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2662 remove_duplicates (result
);
2663 free_font_names (fonts
, nfonts
);
2665 return unbind_to (count
, result
);
2669 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2670 "Return a list of the names of available fonts matching PATTERN.\n\
2671 If optional arguments FACE and FRAME are specified, return only fonts\n\
2672 the same size as FACE on FRAME.\n\
2673 PATTERN is a string, perhaps with wildcard characters;\n\
2674 the * character matches any substring, and\n\
2675 the ? character matches any single character.\n\
2676 PATTERN is case-insensitive.\n\
2677 FACE is a face name--a symbol.\n\
2679 The return value is a list of strings, suitable as arguments to\n\
2682 Fonts Emacs can't use may or may not be excluded\n\
2683 even if they match PATTERN and FACE.\n\
2684 The optional fourth argument MAXIMUM sets a limit on how many\n\
2685 fonts to match. The first MAXIMUM fonts are reported.\n\
2686 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2687 occupied by a character of a font. In that case, return only fonts\n\
2688 the WIDTH times as wide as FACE on FRAME.")
2689 (pattern
, face
, frame
, maximum
, width
)
2690 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2697 CHECK_STRING (pattern
, 0);
2703 CHECK_NATNUM (maximum
, 0);
2704 maxnames
= XINT (maximum
);
2708 CHECK_NUMBER (width
, 4);
2710 /* We can't simply call check_x_frame because this function may be
2711 called before any frame is created. */
2712 f
= frame_or_selected_frame (frame
, 2);
2713 if (!FRAME_WINDOW_P (f
))
2715 /* Perhaps we have not yet created any frame. */
2720 /* Determine the width standard for comparison with the fonts we find. */
2726 /* This is of limited utility since it works with character
2727 widths. Keep it for compatibility. --gerd. */
2728 int face_id
= lookup_named_face (f
, face
, 0);
2729 struct face
*face
= (face_id
< 0
2731 : FACE_FROM_ID (f
, face_id
));
2733 if (face
&& face
->font
)
2734 size
= FONT_WIDTH (face
->font
);
2736 size
= FONT_WIDTH (FRAME_FONT (f
));
2739 size
*= XINT (width
);
2743 Lisp_Object args
[2];
2745 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2747 /* We don't have to check fontsets. */
2749 args
[1] = list_fontsets (f
, pattern
, size
);
2750 return Fnconc (2, args
);
2754 #endif /* HAVE_WINDOW_SYSTEM */
2758 /***********************************************************************
2760 ***********************************************************************/
2762 /* Access face attributes of face FACE, a Lisp vector. */
2764 #define LFACE_FAMILY(LFACE) \
2765 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2766 #define LFACE_HEIGHT(LFACE) \
2767 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2768 #define LFACE_WEIGHT(LFACE) \
2769 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2770 #define LFACE_SLANT(LFACE) \
2771 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2772 #define LFACE_UNDERLINE(LFACE) \
2773 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2774 #define LFACE_INVERSE(LFACE) \
2775 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2776 #define LFACE_FOREGROUND(LFACE) \
2777 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2778 #define LFACE_BACKGROUND(LFACE) \
2779 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2780 #define LFACE_STIPPLE(LFACE) \
2781 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2782 #define LFACE_SWIDTH(LFACE) \
2783 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2784 #define LFACE_OVERLINE(LFACE) \
2785 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2786 #define LFACE_STRIKE_THROUGH(LFACE) \
2787 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2788 #define LFACE_BOX(LFACE) \
2789 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2790 #define LFACE_FONT(LFACE) \
2791 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2792 #define LFACE_INHERIT(LFACE) \
2793 XVECTOR (LFACE)->contents[LFACE_INHERIT_INDEX]
2795 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2796 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2798 #define LFACEP(LFACE) \
2800 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2801 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2806 /* Check consistency of Lisp face attribute vector ATTRS. */
2809 check_lface_attrs (attrs
)
2812 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2813 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2814 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2815 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2816 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2817 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2818 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2819 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2820 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2821 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2822 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2823 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2824 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2825 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2826 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2827 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2828 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2829 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2830 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2831 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2832 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2833 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2834 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2835 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2836 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2837 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2838 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2839 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2840 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2841 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2842 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2843 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2844 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2845 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2846 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2847 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2848 #ifdef HAVE_WINDOW_SYSTEM
2849 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2850 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2851 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2852 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2853 || NILP (attrs
[LFACE_FONT_INDEX
])
2854 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2859 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2867 xassert (LFACEP (lface
));
2868 check_lface_attrs (XVECTOR (lface
)->contents
);
2872 #else /* GLYPH_DEBUG == 0 */
2874 #define check_lface_attrs(attrs) (void) 0
2875 #define check_lface(lface) (void) 0
2877 #endif /* GLYPH_DEBUG == 0 */
2880 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2881 to make it a symvol. If FACE_NAME is an alias for another face,
2882 return that face's name. */
2885 resolve_face_name (face_name
)
2886 Lisp_Object face_name
;
2888 Lisp_Object aliased
;
2890 if (STRINGP (face_name
))
2891 face_name
= intern (XSTRING (face_name
)->data
);
2893 while (SYMBOLP (face_name
))
2895 aliased
= Fget (face_name
, Qface_alias
);
2899 face_name
= aliased
;
2906 /* Return the face definition of FACE_NAME on frame F. F null means
2907 return the global definition. FACE_NAME may be a string or a
2908 symbol (apparently Emacs 20.2 allows strings as face names in face
2909 text properties; ediff uses that). If FACE_NAME is an alias for
2910 another face, return that face's definition. If SIGNAL_P is
2911 non-zero, signal an error if FACE_NAME is not a valid face name.
2912 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2915 static INLINE Lisp_Object
2916 lface_from_face_name (f
, face_name
, signal_p
)
2918 Lisp_Object face_name
;
2923 face_name
= resolve_face_name (face_name
);
2926 lface
= assq_no_quit (face_name
, f
->face_alist
);
2928 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2931 lface
= XCDR (lface
);
2933 signal_error ("Invalid face", face_name
);
2935 check_lface (lface
);
2940 /* Get face attributes of face FACE_NAME from frame-local faces on
2941 frame F. Store the resulting attributes in ATTRS which must point
2942 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2943 is non-zero, signal an error if FACE_NAME does not name a face.
2944 Otherwise, value is zero if FACE_NAME is not a face. */
2947 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
2949 Lisp_Object face_name
;
2956 lface
= lface_from_face_name (f
, face_name
, signal_p
);
2959 bcopy (XVECTOR (lface
)->contents
, attrs
,
2960 LFACE_VECTOR_SIZE
* sizeof *attrs
);
2970 /* Non-zero if all attributes in face attribute vector ATTRS are
2971 specified, i.e. are non-nil. */
2974 lface_fully_specified_p (attrs
)
2979 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
2980 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
2981 if (UNSPECIFIEDP (attrs
[i
]))
2984 return i
== LFACE_VECTOR_SIZE
;
2987 #ifdef HAVE_WINDOW_SYSTEM
2989 /* Set font-related attributes of Lisp face LFACE from the fullname of
2990 the font opened by FONTNAME. If FORCE_P is zero, set only
2991 unspecified attributes of LFACE. The exception is `font'
2992 attribute. It is set to FONTNAME as is regardless of FORCE_P.
2994 If FONTNAME is not available on frame F,
2995 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
2996 If the fullname is not in a valid XLFD format,
2997 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
2998 in LFACE and return 1.
2999 Otherwise, return 1. */
3002 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3005 Lisp_Object fontname
;
3006 int force_p
, may_fail_p
;
3008 struct font_name font
;
3013 char *font_name
= XSTRING (fontname
)->data
;
3014 struct font_info
*font_info
;
3016 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3017 fontset
= fs_query_fontset (fontname
, 0);
3019 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3021 /* Check if FONT_NAME is surely available on the system. Usually
3022 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3023 returns quickly. But, even if FONT_NAME is not yet cached,
3024 caching it now is not futail because we anyway load the font
3027 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3037 font
.name
= STRDUPA (font_info
->full_name
);
3038 have_xlfd_p
= split_font_name (f
, &font
, 1);
3040 /* Set attributes only if unspecified, otherwise face defaults for
3041 new frames would never take effect. If we couldn't get a font
3042 name conforming to XLFD, set normal values. */
3044 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3049 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3050 + strlen (font
.fields
[XLFD_FOUNDRY
])
3052 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3053 font
.fields
[XLFD_FAMILY
]);
3054 val
= build_string (buffer
);
3057 val
= build_string ("*");
3058 LFACE_FAMILY (lface
) = val
;
3061 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3064 pt
= xlfd_point_size (f
, &font
);
3066 pt
= pixel_point_size (f
, font_info
->height
* 10);
3068 LFACE_HEIGHT (lface
) = make_number (pt
);
3071 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3072 LFACE_SWIDTH (lface
)
3073 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3075 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3076 LFACE_WEIGHT (lface
)
3077 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3079 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3081 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3083 LFACE_FONT (lface
) = fontname
;
3088 #endif /* HAVE_WINDOW_SYSTEM */
3091 /* Merges the face height FROM with the face height TO, and returns the
3092 merged height. If FROM is an invalid height, then INVALID is
3093 returned instead. FROM may be a either an absolute face height or a
3094 `relative' height, and TO must be an absolute height. The returned
3095 value is always an absolute height. GCPRO is a lisp value that will
3096 be protected from garbage-collection if this function makes a call
3100 merge_face_heights (from
, to
, invalid
, gcpro
)
3101 Lisp_Object from
, to
, invalid
, gcpro
;
3105 if (INTEGERP (from
))
3106 result
= XINT (from
);
3107 else if (NUMBERP (from
))
3108 result
= XFLOATINT (from
) * XINT (to
);
3109 #if 0 /* Probably not so useful. */
3110 else if (CONSP (from
) && CONSP (XCDR (from
)))
3112 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3114 if (INTEGERP (XCAR (XCDR (from
))))
3116 int inc
= XINT (XCAR (XCDR (from
)));
3117 if (EQ (XCAR (from
), Qminus
))
3120 result
= XFASTINT (to
);
3121 if (result
+ inc
> 0)
3122 /* Note that `underflows' don't mean FROM is invalid, so
3123 we just pin the result at TO if it would otherwise be
3130 else if (FUNCTIONP (from
))
3132 /* Call function with current height as argument.
3133 From is the new height. */
3134 Lisp_Object args
[2], height
;
3135 struct gcpro gcpro1
;
3141 height
= safe_call (2, args
);
3145 if (NUMBERP (height
))
3146 result
= XFLOATINT (height
);
3150 return make_number (result
);
3156 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3157 store the resulting attributes in TO, which must be already be
3158 completely specified and contain only absolute attributes. Every
3159 specified attribute of FROM overrides the corresponding attribute of
3160 TO; relative attributes in FROM are merged with the absolute value in
3161 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3162 face inheritance; it should be Qnil when called from other places. */
3165 merge_face_vectors (f
, from
, to
, cycle_check
)
3167 Lisp_Object
*from
, *to
;
3168 Lisp_Object cycle_check
;
3172 /* If FROM inherits from some other faces, merge their attributes into
3173 TO before merging FROM's direct attributes. Note that an :inherit
3174 attribute of `unspecified' is the same as one of nil; we never
3175 merge :inherit attributes, so nil is more correct, but lots of
3176 other code uses `unspecified' as a generic value for face attributes. */
3177 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3178 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3179 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3181 /* If TO specifies a :font attribute, and FROM specifies some
3182 font-related attribute, we need to clear TO's :font attribute
3183 (because it will be inconsistent with whatever FROM specifies, and
3184 FROM takes precedence). */
3185 if (!NILP (to
[LFACE_FONT_INDEX
])
3186 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3187 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3188 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3189 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3190 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])))
3191 to
[LFACE_FONT_INDEX
] = Qnil
;
3193 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3194 if (!UNSPECIFIEDP (from
[i
]))
3195 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3196 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3200 /* TO is always an absolute face, which should inherit from nothing.
3201 We blindly copy the :inherit attribute above and fix it up here. */
3202 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3206 /* Checks the `cycle check' variable CHECK to see if it indicates that
3207 EL is part of a cycle; CHECK must be either Qnil or a value returned
3208 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3209 elements after which a cycle might be suspected; after that many
3210 elements, this macro begins consing in order to keep more precise
3213 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3216 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3217 the caller should make sure that's ok. */
3219 #define CYCLE_CHECK(check, el, suspicious) \
3222 : (INTEGERP (check) \
3223 ? (XFASTINT (check) < (suspicious) \
3224 ? make_number (XFASTINT (check) + 1) \
3225 : Fcons (el, Qnil)) \
3226 : (!NILP (Fmemq ((el), (check))) \
3228 : Fcons ((el), (check)))))
3231 /* Merge face attributes from the face on frame F whose name is
3232 INHERITS, into the vector of face attributes TO; INHERITS may also be
3233 a list of face names, in which case they are applied in order.
3234 CYCLE_CHECK is used to detect loops in face inheritance.
3235 Returns true if any of the inherited attributes are `font-related'. */
3238 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3240 Lisp_Object inherit
;
3242 Lisp_Object cycle_check
;
3244 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3245 /* Inherit from the named face INHERIT. */
3249 /* Make sure we're not in an inheritance loop. */
3250 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3251 if (NILP (cycle_check
))
3252 /* Cycle detected, ignore any further inheritance. */
3255 lface
= lface_from_face_name (f
, inherit
, 0);
3257 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3259 else if (CONSP (inherit
))
3260 /* Handle a list of inherited faces by calling ourselves recursively
3261 on each element. Note that we only do so for symbol elements, so
3262 it's not possible to infinitely recurse. */
3264 while (CONSP (inherit
))
3266 if (SYMBOLP (XCAR (inherit
)))
3267 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3269 /* Check for a circular inheritance list. */
3270 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3271 if (NILP (cycle_check
))
3272 /* Cycle detected. */
3275 inherit
= XCDR (inherit
);
3281 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3282 is a face property, determine the resulting face attributes on
3283 frame F, and store them in TO. PROP may be a single face
3284 specification or a list of such specifications. Each face
3285 specification can be
3287 1. A symbol or string naming a Lisp face.
3289 2. A property list of the form (KEYWORD VALUE ...) where each
3290 KEYWORD is a face attribute name, and value is an appropriate value
3293 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3294 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3295 for compatibility with 20.2.
3297 Face specifications earlier in lists take precedence over later
3301 merge_face_vector_with_property (f
, to
, prop
)
3308 Lisp_Object first
= XCAR (prop
);
3310 if (EQ (first
, Qforeground_color
)
3311 || EQ (first
, Qbackground_color
))
3313 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3314 . COLOR). COLOR must be a string. */
3315 Lisp_Object color_name
= XCDR (prop
);
3316 Lisp_Object color
= first
;
3318 if (STRINGP (color_name
))
3320 if (EQ (color
, Qforeground_color
))
3321 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3323 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3326 add_to_log ("Invalid face color", color_name
, Qnil
);
3328 else if (SYMBOLP (first
)
3329 && *XSYMBOL (first
)->name
->data
== ':')
3331 /* Assume this is the property list form. */
3332 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3334 Lisp_Object keyword
= XCAR (prop
);
3335 Lisp_Object value
= XCAR (XCDR (prop
));
3337 if (EQ (keyword
, QCfamily
))
3339 if (STRINGP (value
))
3340 to
[LFACE_FAMILY_INDEX
] = value
;
3342 add_to_log ("Invalid face font family", value
, Qnil
);
3344 else if (EQ (keyword
, QCheight
))
3346 Lisp_Object new_height
=
3347 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3350 if (NILP (new_height
))
3351 add_to_log ("Invalid face font height", value
, Qnil
);
3353 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3355 else if (EQ (keyword
, QCweight
))
3358 && face_numeric_weight (value
) >= 0)
3359 to
[LFACE_WEIGHT_INDEX
] = value
;
3361 add_to_log ("Invalid face weight", value
, Qnil
);
3363 else if (EQ (keyword
, QCslant
))
3366 && face_numeric_slant (value
) >= 0)
3367 to
[LFACE_SLANT_INDEX
] = value
;
3369 add_to_log ("Invalid face slant", value
, Qnil
);
3371 else if (EQ (keyword
, QCunderline
))
3376 to
[LFACE_UNDERLINE_INDEX
] = value
;
3378 add_to_log ("Invalid face underline", value
, Qnil
);
3380 else if (EQ (keyword
, QCoverline
))
3385 to
[LFACE_OVERLINE_INDEX
] = value
;
3387 add_to_log ("Invalid face overline", value
, Qnil
);
3389 else if (EQ (keyword
, QCstrike_through
))
3394 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3396 add_to_log ("Invalid face strike-through", value
, Qnil
);
3398 else if (EQ (keyword
, QCbox
))
3401 value
= make_number (1);
3402 if (INTEGERP (value
)
3406 to
[LFACE_BOX_INDEX
] = value
;
3408 add_to_log ("Invalid face box", value
, Qnil
);
3410 else if (EQ (keyword
, QCinverse_video
)
3411 || EQ (keyword
, QCreverse_video
))
3413 if (EQ (value
, Qt
) || NILP (value
))
3414 to
[LFACE_INVERSE_INDEX
] = value
;
3416 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3418 else if (EQ (keyword
, QCforeground
))
3420 if (STRINGP (value
))
3421 to
[LFACE_FOREGROUND_INDEX
] = value
;
3423 add_to_log ("Invalid face foreground", value
, Qnil
);
3425 else if (EQ (keyword
, QCbackground
))
3427 if (STRINGP (value
))
3428 to
[LFACE_BACKGROUND_INDEX
] = value
;
3430 add_to_log ("Invalid face background", value
, Qnil
);
3432 else if (EQ (keyword
, QCstipple
))
3434 #ifdef HAVE_X_WINDOWS
3435 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3436 if (!NILP (pixmap_p
))
3437 to
[LFACE_STIPPLE_INDEX
] = value
;
3439 add_to_log ("Invalid face stipple", value
, Qnil
);
3442 else if (EQ (keyword
, QCwidth
))
3445 && face_numeric_swidth (value
) >= 0)
3446 to
[LFACE_SWIDTH_INDEX
] = value
;
3448 add_to_log ("Invalid face width", value
, Qnil
);
3450 else if (EQ (keyword
, QCinherit
))
3452 if (SYMBOLP (value
))
3453 to
[LFACE_INHERIT_INDEX
] = value
;
3457 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3458 if (!SYMBOLP (XCAR (tail
)))
3461 to
[LFACE_INHERIT_INDEX
] = value
;
3463 add_to_log ("Invalid face inherit", value
, Qnil
);
3467 add_to_log ("Invalid attribute %s in face property",
3470 prop
= XCDR (XCDR (prop
));
3475 /* This is a list of face specs. Specifications at the
3476 beginning of the list take precedence over later
3477 specifications, so we have to merge starting with the
3478 last specification. */
3479 Lisp_Object next
= XCDR (prop
);
3481 merge_face_vector_with_property (f
, to
, next
);
3482 merge_face_vector_with_property (f
, to
, first
);
3487 /* PROP ought to be a face name. */
3488 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3490 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3492 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3497 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3498 Sinternal_make_lisp_face
, 1, 2, 0,
3499 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3500 If FACE was not known as a face before, create a new one.\n\
3501 If optional argument FRAME is specified, make a frame-local face\n\
3502 for that frame. Otherwise operate on the global face definition.\n\
3503 Value is a vector of face attributes.")
3505 Lisp_Object face
, frame
;
3507 Lisp_Object global_lface
, lface
;
3511 CHECK_SYMBOL (face
, 0);
3512 global_lface
= lface_from_face_name (NULL
, face
, 0);
3516 CHECK_LIVE_FRAME (frame
, 1);
3518 lface
= lface_from_face_name (f
, face
, 0);
3521 f
= NULL
, lface
= Qnil
;
3523 /* Add a global definition if there is none. */
3524 if (NILP (global_lface
))
3526 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3528 XVECTOR (global_lface
)->contents
[0] = Qface
;
3529 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3530 Vface_new_frame_defaults
);
3532 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3533 face id to Lisp face is given by the vector lface_id_to_name.
3534 The mapping from Lisp face to Lisp face id is given by the
3535 property `face' of the Lisp face name. */
3536 if (next_lface_id
== lface_id_to_name_size
)
3538 int new_size
= max (50, 2 * lface_id_to_name_size
);
3539 int sz
= new_size
* sizeof *lface_id_to_name
;
3540 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3541 lface_id_to_name_size
= new_size
;
3544 lface_id_to_name
[next_lface_id
] = face
;
3545 Fput (face
, Qface
, make_number (next_lface_id
));
3549 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3550 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3552 /* Add a frame-local definition. */
3557 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3559 XVECTOR (lface
)->contents
[0] = Qface
;
3560 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3563 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3564 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3567 lface
= global_lface
;
3569 xassert (LFACEP (lface
));
3570 check_lface (lface
);
3575 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3576 Sinternal_lisp_face_p
, 1, 2, 0,
3577 "Return non-nil if FACE names a face.\n\
3578 If optional second parameter FRAME is non-nil, check for the\n\
3579 existence of a frame-local face with name FACE on that frame.\n\
3580 Otherwise check for the existence of a global face.")
3582 Lisp_Object face
, frame
;
3588 CHECK_LIVE_FRAME (frame
, 1);
3589 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3592 lface
= lface_from_face_name (NULL
, face
, 0);
3598 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3599 Sinternal_copy_lisp_face
, 4, 4, 0,
3600 "Copy face FROM to TO.\n\
3601 If FRAME it t, copy the global face definition of FROM to the\n\
3602 global face definition of TO. Otherwise, copy the frame-local\n\
3603 definition of FROM on FRAME to the frame-local definition of TO\n\
3604 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3607 (from
, to
, frame
, new_frame
)
3608 Lisp_Object from
, to
, frame
, new_frame
;
3610 Lisp_Object lface
, copy
;
3612 CHECK_SYMBOL (from
, 0);
3613 CHECK_SYMBOL (to
, 1);
3614 if (NILP (new_frame
))
3619 /* Copy global definition of FROM. We don't make copies of
3620 strings etc. because 20.2 didn't do it either. */
3621 lface
= lface_from_face_name (NULL
, from
, 1);
3622 copy
= Finternal_make_lisp_face (to
, Qnil
);
3626 /* Copy frame-local definition of FROM. */
3627 CHECK_LIVE_FRAME (frame
, 2);
3628 CHECK_LIVE_FRAME (new_frame
, 3);
3629 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3630 copy
= Finternal_make_lisp_face (to
, new_frame
);
3633 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3634 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3640 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3641 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3642 "Set attribute ATTR of FACE to VALUE.\n\
3643 FRAME being a frame means change the face on that frame.\n\
3644 FRAME nil means change change the face of the selected frame.\n\
3645 FRAME t means change the default for new frames.\n\
3646 FRAME 0 means change the face on all frames, and change the default\n\
3648 (face
, attr
, value
, frame
)
3649 Lisp_Object face
, attr
, value
, frame
;
3652 Lisp_Object old_value
= Qnil
;
3653 /* Set 1 if ATTR is QCfont. */
3654 int font_attr_p
= 0;
3655 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3656 int font_related_attr_p
= 0;
3658 CHECK_SYMBOL (face
, 0);
3659 CHECK_SYMBOL (attr
, 1);
3661 face
= resolve_face_name (face
);
3663 /* If FRAME is 0, change face on all frames, and change the
3664 default for new frames. */
3665 if (INTEGERP (frame
) && XINT (frame
) == 0)
3668 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3669 FOR_EACH_FRAME (tail
, frame
)
3670 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3674 /* Set lface to the Lisp attribute vector of FACE. */
3676 lface
= lface_from_face_name (NULL
, face
, 1);
3680 frame
= selected_frame
;
3682 CHECK_LIVE_FRAME (frame
, 3);
3683 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3685 /* If a frame-local face doesn't exist yet, create one. */
3687 lface
= Finternal_make_lisp_face (face
, frame
);
3690 if (EQ (attr
, QCfamily
))
3692 if (!UNSPECIFIEDP (value
))
3694 CHECK_STRING (value
, 3);
3695 if (XSTRING (value
)->size
== 0)
3696 signal_error ("Invalid face family", value
);
3698 old_value
= LFACE_FAMILY (lface
);
3699 LFACE_FAMILY (lface
) = value
;
3700 font_related_attr_p
= 1;
3702 else if (EQ (attr
, QCheight
))
3704 if (!UNSPECIFIEDP (value
))
3707 (EQ (face
, Qdefault
) ? value
:
3708 /* The default face must have an absolute size, otherwise, we do
3709 a test merge with a random height to see if VALUE's ok. */
3710 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3712 if (!INTEGERP(test
) || XINT(test
) <= 0)
3713 signal_error ("Invalid face height", value
);
3716 old_value
= LFACE_HEIGHT (lface
);
3717 LFACE_HEIGHT (lface
) = value
;
3718 font_related_attr_p
= 1;
3720 else if (EQ (attr
, QCweight
))
3722 if (!UNSPECIFIEDP (value
))
3724 CHECK_SYMBOL (value
, 3);
3725 if (face_numeric_weight (value
) < 0)
3726 signal_error ("Invalid face weight", value
);
3728 old_value
= LFACE_WEIGHT (lface
);
3729 LFACE_WEIGHT (lface
) = value
;
3730 font_related_attr_p
= 1;
3732 else if (EQ (attr
, QCslant
))
3734 if (!UNSPECIFIEDP (value
))
3736 CHECK_SYMBOL (value
, 3);
3737 if (face_numeric_slant (value
) < 0)
3738 signal_error ("Invalid face slant", value
);
3740 old_value
= LFACE_SLANT (lface
);
3741 LFACE_SLANT (lface
) = value
;
3742 font_related_attr_p
= 1;
3744 else if (EQ (attr
, QCunderline
))
3746 if (!UNSPECIFIEDP (value
))
3747 if ((SYMBOLP (value
)
3749 && !EQ (value
, Qnil
))
3750 /* Underline color. */
3752 && XSTRING (value
)->size
== 0))
3753 signal_error ("Invalid face underline", value
);
3755 old_value
= LFACE_UNDERLINE (lface
);
3756 LFACE_UNDERLINE (lface
) = value
;
3758 else if (EQ (attr
, QCoverline
))
3760 if (!UNSPECIFIEDP (value
))
3761 if ((SYMBOLP (value
)
3763 && !EQ (value
, Qnil
))
3764 /* Overline color. */
3766 && XSTRING (value
)->size
== 0))
3767 signal_error ("Invalid face overline", value
);
3769 old_value
= LFACE_OVERLINE (lface
);
3770 LFACE_OVERLINE (lface
) = value
;
3772 else if (EQ (attr
, QCstrike_through
))
3774 if (!UNSPECIFIEDP (value
))
3775 if ((SYMBOLP (value
)
3777 && !EQ (value
, Qnil
))
3778 /* Strike-through color. */
3780 && XSTRING (value
)->size
== 0))
3781 signal_error ("Invalid face strike-through", value
);
3783 old_value
= LFACE_STRIKE_THROUGH (lface
);
3784 LFACE_STRIKE_THROUGH (lface
) = value
;
3786 else if (EQ (attr
, QCbox
))
3790 /* Allow t meaning a simple box of width 1 in foreground color
3793 value
= make_number (1);
3795 if (UNSPECIFIEDP (value
))
3797 else if (NILP (value
))
3799 else if (INTEGERP (value
))
3800 valid_p
= XINT (value
) > 0;
3801 else if (STRINGP (value
))
3802 valid_p
= XSTRING (value
)->size
> 0;
3803 else if (CONSP (value
))
3819 if (EQ (k
, QCline_width
))
3821 if (!INTEGERP (v
) || XINT (v
) <= 0)
3824 else if (EQ (k
, QCcolor
))
3826 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3829 else if (EQ (k
, QCstyle
))
3831 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3838 valid_p
= NILP (tem
);
3844 signal_error ("Invalid face box", value
);
3846 old_value
= LFACE_BOX (lface
);
3847 LFACE_BOX (lface
) = value
;
3849 else if (EQ (attr
, QCinverse_video
)
3850 || EQ (attr
, QCreverse_video
))
3852 if (!UNSPECIFIEDP (value
))
3854 CHECK_SYMBOL (value
, 3);
3855 if (!EQ (value
, Qt
) && !NILP (value
))
3856 signal_error ("Invalid inverse-video face attribute value", value
);
3858 old_value
= LFACE_INVERSE (lface
);
3859 LFACE_INVERSE (lface
) = value
;
3861 else if (EQ (attr
, QCforeground
))
3863 if (!UNSPECIFIEDP (value
))
3865 /* Don't check for valid color names here because it depends
3866 on the frame (display) whether the color will be valid
3867 when the face is realized. */
3868 CHECK_STRING (value
, 3);
3869 if (XSTRING (value
)->size
== 0)
3870 signal_error ("Empty foreground color value", value
);
3872 old_value
= LFACE_FOREGROUND (lface
);
3873 LFACE_FOREGROUND (lface
) = value
;
3875 else if (EQ (attr
, QCbackground
))
3877 if (!UNSPECIFIEDP (value
))
3879 /* Don't check for valid color names here because it depends
3880 on the frame (display) whether the color will be valid
3881 when the face is realized. */
3882 CHECK_STRING (value
, 3);
3883 if (XSTRING (value
)->size
== 0)
3884 signal_error ("Empty background color value", value
);
3886 old_value
= LFACE_BACKGROUND (lface
);
3887 LFACE_BACKGROUND (lface
) = value
;
3889 else if (EQ (attr
, QCstipple
))
3891 #ifdef HAVE_X_WINDOWS
3892 if (!UNSPECIFIEDP (value
)
3894 && NILP (Fbitmap_spec_p (value
)))
3895 signal_error ("Invalid stipple attribute", value
);
3896 old_value
= LFACE_STIPPLE (lface
);
3897 LFACE_STIPPLE (lface
) = value
;
3898 #endif /* HAVE_X_WINDOWS */
3900 else if (EQ (attr
, QCwidth
))
3902 if (!UNSPECIFIEDP (value
))
3904 CHECK_SYMBOL (value
, 3);
3905 if (face_numeric_swidth (value
) < 0)
3906 signal_error ("Invalid face width", value
);
3908 old_value
= LFACE_SWIDTH (lface
);
3909 LFACE_SWIDTH (lface
) = value
;
3910 font_related_attr_p
= 1;
3912 else if (EQ (attr
, QCfont
))
3914 #ifdef HAVE_WINDOW_SYSTEM
3915 /* Set font-related attributes of the Lisp face from an
3920 CHECK_STRING (value
, 3);
3922 f
= SELECTED_FRAME ();
3924 f
= check_x_frame (frame
);
3926 /* VALUE may be a fontset name or an alias of fontset. In such
3927 a case, use the base fontset name. */
3928 tmp
= Fquery_fontset (value
, Qnil
);
3932 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3933 signal_error ("Invalid font or fontset name", value
);
3936 #endif /* HAVE_WINDOW_SYSTEM */
3938 else if (EQ (attr
, QCinherit
))
3941 if (SYMBOLP (value
))
3944 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3945 if (!SYMBOLP (XCAR (tail
)))
3948 LFACE_INHERIT (lface
) = value
;
3950 signal_error ("Invalid face inheritance", value
);
3952 else if (EQ (attr
, QCbold
))
3954 old_value
= LFACE_WEIGHT (lface
);
3955 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
3956 font_related_attr_p
= 1;
3958 else if (EQ (attr
, QCitalic
))
3960 old_value
= LFACE_SLANT (lface
);
3961 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
3962 font_related_attr_p
= 1;
3965 signal_error ("Invalid face attribute name", attr
);
3967 if (font_related_attr_p
3968 && !UNSPECIFIEDP (value
))
3969 /* If a font-related attribute other than QCfont is specified, the
3970 original `font' attribute nor that of default face is useless
3971 to determine a new font. Thus, we set it to nil so that font
3972 selection mechanism doesn't use it. */
3973 LFACE_FONT (lface
) = Qnil
;
3975 /* Changing a named face means that all realized faces depending on
3976 that face are invalid. Since we cannot tell which realized faces
3977 depend on the face, make sure they are all removed. This is done
3978 by incrementing face_change_count. The next call to
3979 init_iterator will then free realized faces. */
3981 && (EQ (attr
, QCfont
)
3982 || NILP (Fequal (old_value
, value
))))
3984 ++face_change_count
;
3985 ++windows_or_buffers_changed
;
3988 #ifdef HAVE_WINDOW_SYSTEM
3991 && !UNSPECIFIEDP (value
)
3992 && NILP (Fequal (old_value
, value
)))
3998 if (EQ (face
, Qdefault
))
4000 /* Changed font-related attributes of the `default' face are
4001 reflected in changed `font' frame parameters. */
4002 if ((font_related_attr_p
|| font_attr_p
)
4003 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4004 set_font_frame_param (frame
, lface
);
4005 else if (EQ (attr
, QCforeground
))
4006 param
= Qforeground_color
;
4007 else if (EQ (attr
, QCbackground
))
4008 param
= Qbackground_color
;
4011 else if (EQ (face
, Qscroll_bar
))
4013 /* Changing the colors of `scroll-bar' sets frame parameters
4014 `scroll-bar-foreground' and `scroll-bar-background'. */
4015 if (EQ (attr
, QCforeground
))
4016 param
= Qscroll_bar_foreground
;
4017 else if (EQ (attr
, QCbackground
))
4018 param
= Qscroll_bar_background
;
4020 #endif /* not WINDOWSNT */
4021 else if (EQ (face
, Qborder
))
4023 /* Changing background color of `border' sets frame parameter
4025 if (EQ (attr
, QCbackground
))
4026 param
= Qborder_color
;
4028 else if (EQ (face
, Qcursor
))
4030 /* Changing background color of `cursor' sets frame parameter
4032 if (EQ (attr
, QCbackground
))
4033 param
= Qcursor_color
;
4035 else if (EQ (face
, Qmouse
))
4037 /* Changing background color of `mouse' sets frame parameter
4039 if (EQ (attr
, QCbackground
))
4040 param
= Qmouse_color
;
4042 else if (EQ (face
, Qmenu
))
4043 ++menu_face_change_count
;
4048 cons
= XCAR (Vparam_value_alist
);
4049 XCAR (cons
) = param
;
4050 XCDR (cons
) = value
;
4051 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4055 #endif /* HAVE_WINDOW_SYSTEM */
4061 #ifdef HAVE_WINDOW_SYSTEM
4063 /* Set the `font' frame parameter of FRAME determined from `default'
4064 face attributes LFACE. If a face or fontset name is explicitely
4065 specfied in LFACE, use it as is. Otherwise, determine a font name
4066 from the other font-related atrributes of LFACE. In that case, if
4067 there's no matching font, signals an error. */
4070 set_font_frame_param (frame
, lface
)
4071 Lisp_Object frame
, lface
;
4073 struct frame
*f
= XFRAME (frame
);
4074 Lisp_Object font_name
;
4077 if (STRINGP (LFACE_FONT (lface
)))
4078 font_name
= LFACE_FONT (lface
);
4081 /* Choose a font name that reflects LFACE's attributes and has
4082 the registry and encoding pattern specified in the default
4083 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4084 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4086 error ("No font matches the specified attribute");
4087 font_name
= build_string (font
);
4091 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4095 /* Update the corresponding face when frame parameter PARAM on frame F
4096 has been assigned the value NEW_VALUE. */
4099 update_face_from_frame_parameter (f
, param
, new_value
)
4101 Lisp_Object param
, new_value
;
4105 /* If there are no faces yet, give up. This is the case when called
4106 from Fx_create_frame, and we do the necessary things later in
4107 face-set-after-frame-defaults. */
4108 if (NILP (f
->face_alist
))
4111 if (EQ (param
, Qforeground_color
))
4113 lface
= lface_from_face_name (f
, Qdefault
, 1);
4114 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4115 ? new_value
: Qunspecified
);
4116 realize_basic_faces (f
);
4118 else if (EQ (param
, Qbackground_color
))
4122 /* Changing the background color might change the background
4123 mode, so that we have to load new defface specs. Call
4124 frame-update-face-colors to do that. */
4125 XSETFRAME (frame
, f
);
4126 call1 (Qframe_update_face_colors
, frame
);
4128 lface
= lface_from_face_name (f
, Qdefault
, 1);
4129 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4130 ? new_value
: Qunspecified
);
4131 realize_basic_faces (f
);
4133 if (EQ (param
, Qborder_color
))
4135 lface
= lface_from_face_name (f
, Qborder
, 1);
4136 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4137 ? new_value
: Qunspecified
);
4139 else if (EQ (param
, Qcursor_color
))
4141 lface
= lface_from_face_name (f
, Qcursor
, 1);
4142 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4143 ? new_value
: Qunspecified
);
4145 else if (EQ (param
, Qmouse_color
))
4147 lface
= lface_from_face_name (f
, Qmouse
, 1);
4148 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4149 ? new_value
: Qunspecified
);
4154 /* Get the value of X resource RESOURCE, class CLASS for the display
4155 of frame FRAME. This is here because ordinary `x-get-resource'
4156 doesn't take a frame argument. */
4158 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4159 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4160 (resource
, class, frame
)
4161 Lisp_Object resource
, class, frame
;
4163 Lisp_Object value
= Qnil
;
4166 CHECK_STRING (resource
, 0);
4167 CHECK_STRING (class, 1);
4168 CHECK_LIVE_FRAME (frame
, 2);
4170 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4171 resource
, class, Qnil
, Qnil
);
4173 #endif /* not macintosh */
4174 #endif /* not WINDOWSNT */
4179 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4180 If VALUE is "on" or "true", return t. If VALUE is "off" or
4181 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4182 error; if SIGNAL_P is zero, return 0. */
4185 face_boolean_x_resource_value (value
, signal_p
)
4189 Lisp_Object result
= make_number (0);
4191 xassert (STRINGP (value
));
4193 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4194 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4196 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4197 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4199 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4200 result
= Qunspecified
;
4202 signal_error ("Invalid face attribute value from X resource", value
);
4208 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4209 Finternal_set_lisp_face_attribute_from_resource
,
4210 Sinternal_set_lisp_face_attribute_from_resource
,
4212 (face
, attr
, value
, frame
)
4213 Lisp_Object face
, attr
, value
, frame
;
4215 CHECK_SYMBOL (face
, 0);
4216 CHECK_SYMBOL (attr
, 1);
4217 CHECK_STRING (value
, 2);
4219 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4220 value
= Qunspecified
;
4221 else if (EQ (attr
, QCheight
))
4223 value
= Fstring_to_number (value
, make_number (10));
4224 if (XINT (value
) <= 0)
4225 signal_error ("Invalid face height from X resource", value
);
4227 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4228 value
= face_boolean_x_resource_value (value
, 1);
4229 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4230 value
= intern (XSTRING (value
)->data
);
4231 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4232 value
= face_boolean_x_resource_value (value
, 1);
4233 else if (EQ (attr
, QCunderline
)
4234 || EQ (attr
, QCoverline
)
4235 || EQ (attr
, QCstrike_through
)
4236 || EQ (attr
, QCbox
))
4238 Lisp_Object boolean_value
;
4240 /* If the result of face_boolean_x_resource_value is t or nil,
4241 VALUE does NOT specify a color. */
4242 boolean_value
= face_boolean_x_resource_value (value
, 0);
4243 if (SYMBOLP (boolean_value
))
4244 value
= boolean_value
;
4247 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4250 #endif /* HAVE_WINDOW_SYSTEM */
4253 #ifdef HAVE_X_WINDOWS
4254 /***********************************************************************
4256 ***********************************************************************/
4258 #ifdef USE_X_TOOLKIT
4260 #include "../lwlib/lwlib-utils.h"
4262 /* Structure used to pass X resources to functions called via
4263 XtApplyToWidgets. */
4274 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4275 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4278 /* Set widget W's X resources from P which points to an x_resources
4279 structure. If W is a cascade button, apply resources to W's
4283 xm_apply_resources (w
, p
)
4288 struct x_resources
*res
= (struct x_resources
*) p
;
4290 XtSetValues (w
, res
->av
, res
->ac
);
4291 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4294 XtSetValues (submenu
, res
->av
, res
->ac
);
4295 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4300 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4301 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4304 1. Setting the XmNfontList resource leads to an infinite loop
4305 somewhere in LessTif. */
4308 xm_set_menu_resources_from_menu_face (f
, widget
)
4318 lface
= lface_from_face_name (f
, Qmenu
, 1);
4319 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4321 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4323 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4327 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4329 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4333 /* If any font-related attribute of `menu' is set, set the font. */
4335 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4336 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4337 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4338 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4339 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4341 #if 0 /* Setting the font leads to an infinite loop somewhere
4342 in LessTif during geometry computation. */
4344 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4345 fl
= XmFontListAppendEntry (NULL
, fe
);
4346 XtSetArg (av
[ac
], XmNfontList
, fl
);
4351 xassert (ac
<= sizeof av
/ sizeof *av
);
4355 struct x_resources res
;
4357 XtSetValues (widget
, av
, ac
);
4358 res
.av
= av
, res
.ac
= ac
;
4359 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4361 XmFontListFree (fl
);
4365 #endif /* USE_MOTIF */
4369 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4370 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4373 /* Set widget W's resources from P which points to an x_resources
4377 xl_apply_resources (widget
, p
)
4381 struct x_resources
*res
= (struct x_resources
*) p
;
4382 XtSetValues (widget
, res
->av
, res
->ac
);
4386 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4387 This is the Lucid version. */
4390 xl_set_menu_resources_from_menu_face (f
, widget
)
4399 lface
= lface_from_face_name (f
, Qmenu
, 1);
4400 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4402 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4404 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4408 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4410 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4415 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4416 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4417 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4418 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4419 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4421 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4427 struct x_resources res
;
4429 XtSetValues (widget
, av
, ac
);
4431 /* We must do children here in case we're handling a pop-up menu
4432 in which case WIDGET is a popup shell. XtApplyToWidgets
4433 is a function from lwlib. */
4434 res
.av
= av
, res
.ac
= ac
;
4435 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4439 #endif /* USE_LUCID */
4442 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4445 x_set_menu_resources_from_menu_face (f
, widget
)
4449 /* Realized faces may have been removed on frame F, e.g. because of
4450 face attribute changes. Recompute them, if necessary, since we
4451 will need the `menu' face. */
4452 if (f
->face_cache
->used
== 0)
4453 recompute_basic_faces (f
);
4457 xl_set_menu_resources_from_menu_face (f
, widget
);
4460 xm_set_menu_resources_from_menu_face (f
, widget
);
4465 #endif /* USE_X_TOOLKIT */
4467 #endif /* HAVE_X_WINDOWS */
4471 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4472 Sinternal_get_lisp_face_attribute
,
4474 "Return face attribute KEYWORD of face SYMBOL.\n\
4475 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4476 face attribute name, signal an error.\n\
4477 If the optional argument FRAME is given, report on face FACE in that\n\
4478 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4479 frames). If FRAME is omitted or nil, use the selected frame.")
4480 (symbol
, keyword
, frame
)
4481 Lisp_Object symbol
, keyword
, frame
;
4483 Lisp_Object lface
, value
= Qnil
;
4485 CHECK_SYMBOL (symbol
, 0);
4486 CHECK_SYMBOL (keyword
, 1);
4489 lface
= lface_from_face_name (NULL
, symbol
, 1);
4493 frame
= selected_frame
;
4494 CHECK_LIVE_FRAME (frame
, 2);
4495 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4498 if (EQ (keyword
, QCfamily
))
4499 value
= LFACE_FAMILY (lface
);
4500 else if (EQ (keyword
, QCheight
))
4501 value
= LFACE_HEIGHT (lface
);
4502 else if (EQ (keyword
, QCweight
))
4503 value
= LFACE_WEIGHT (lface
);
4504 else if (EQ (keyword
, QCslant
))
4505 value
= LFACE_SLANT (lface
);
4506 else if (EQ (keyword
, QCunderline
))
4507 value
= LFACE_UNDERLINE (lface
);
4508 else if (EQ (keyword
, QCoverline
))
4509 value
= LFACE_OVERLINE (lface
);
4510 else if (EQ (keyword
, QCstrike_through
))
4511 value
= LFACE_STRIKE_THROUGH (lface
);
4512 else if (EQ (keyword
, QCbox
))
4513 value
= LFACE_BOX (lface
);
4514 else if (EQ (keyword
, QCinverse_video
)
4515 || EQ (keyword
, QCreverse_video
))
4516 value
= LFACE_INVERSE (lface
);
4517 else if (EQ (keyword
, QCforeground
))
4518 value
= LFACE_FOREGROUND (lface
);
4519 else if (EQ (keyword
, QCbackground
))
4520 value
= LFACE_BACKGROUND (lface
);
4521 else if (EQ (keyword
, QCstipple
))
4522 value
= LFACE_STIPPLE (lface
);
4523 else if (EQ (keyword
, QCwidth
))
4524 value
= LFACE_SWIDTH (lface
);
4525 else if (EQ (keyword
, QCinherit
))
4526 value
= LFACE_INHERIT (lface
);
4527 else if (EQ (keyword
, QCfont
))
4528 value
= LFACE_FONT (lface
);
4530 signal_error ("Invalid face attribute name", keyword
);
4536 DEFUN ("internal-lisp-face-attribute-values",
4537 Finternal_lisp_face_attribute_values
,
4538 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4539 "Return a list of valid discrete values for face attribute ATTR.\n\
4540 Value is nil if ATTR doesn't have a discrete set of valid values.")
4544 Lisp_Object result
= Qnil
;
4546 CHECK_SYMBOL (attr
, 0);
4548 if (EQ (attr
, QCweight
)
4549 || EQ (attr
, QCslant
)
4550 || EQ (attr
, QCwidth
))
4552 /* Extract permissible symbols from tables. */
4553 struct table_entry
*table
;
4556 if (EQ (attr
, QCweight
))
4557 table
= weight_table
, dim
= DIM (weight_table
);
4558 else if (EQ (attr
, QCslant
))
4559 table
= slant_table
, dim
= DIM (slant_table
);
4561 table
= swidth_table
, dim
= DIM (swidth_table
);
4563 for (i
= 0; i
< dim
; ++i
)
4565 Lisp_Object symbol
= *table
[i
].symbol
;
4566 Lisp_Object tail
= result
;
4569 && !EQ (XCAR (tail
), symbol
))
4573 result
= Fcons (symbol
, result
);
4576 else if (EQ (attr
, QCunderline
))
4577 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4578 else if (EQ (attr
, QCoverline
))
4579 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4580 else if (EQ (attr
, QCstrike_through
))
4581 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4582 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4583 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4589 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4590 Sinternal_merge_in_global_face
, 2, 2, 0,
4591 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4592 Default face attributes override any local face attributes.")
4594 Lisp_Object face
, frame
;
4597 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4599 CHECK_LIVE_FRAME (frame
, 1);
4600 global_lface
= lface_from_face_name (NULL
, face
, 1);
4601 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4602 if (NILP (local_lface
))
4603 local_lface
= Finternal_make_lisp_face (face
, frame
);
4605 /* Make every specified global attribute override the local one.
4606 BEWARE!! This is only used from `face-set-after-frame-default' where
4607 the local frame is defined from default specs in `face-defface-spec'
4608 and those should be overridden by global settings. Hence the strange
4609 "global before local" priority. */
4610 lvec
= XVECTOR (local_lface
)->contents
;
4611 gvec
= XVECTOR (global_lface
)->contents
;
4612 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4613 if (! UNSPECIFIEDP (gvec
[i
]))
4620 /* The following function is implemented for compatibility with 20.2.
4621 The function is used in x-resolve-fonts when it is asked to
4622 return fonts with the same size as the font of a face. This is
4623 done in fontset.el. */
4625 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4626 "Return the font name of face FACE, or nil if it is unspecified.\n\
4627 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4628 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4629 The font default for a face is either nil, or a list\n\
4630 of the form (bold), (italic) or (bold italic).\n\
4631 If FRAME is omitted or nil, use the selected frame.")
4633 Lisp_Object face
, frame
;
4637 Lisp_Object result
= Qnil
;
4638 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4640 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4641 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4642 result
= Fcons (Qbold
, result
);
4644 if (!NILP (LFACE_SLANT (lface
))
4645 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4646 result
= Fcons (Qitalic
, result
);
4652 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4653 int face_id
= lookup_named_face (f
, face
, 0);
4654 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4655 return face
? build_string (face
->font_name
) : Qnil
;
4660 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4661 all attributes are `equal'. Tries to be fast because this function
4662 is called quite often. */
4665 lface_equal_p (v1
, v2
)
4666 Lisp_Object
*v1
, *v2
;
4670 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4672 Lisp_Object a
= v1
[i
];
4673 Lisp_Object b
= v2
[i
];
4675 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4676 and the other is specified. */
4677 equal_p
= XTYPE (a
) == XTYPE (b
);
4686 equal_p
= ((STRING_BYTES (XSTRING (a
))
4687 == STRING_BYTES (XSTRING (b
)))
4688 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4689 STRING_BYTES (XSTRING (a
))) == 0);
4698 equal_p
= !NILP (Fequal (a
, b
));
4708 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4709 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4710 "True if FACE1 and FACE2 are equal.\n\
4711 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4712 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4713 If FRAME is omitted or nil, use the selected frame.")
4714 (face1
, face2
, frame
)
4715 Lisp_Object face1
, face2
, frame
;
4719 Lisp_Object lface1
, lface2
;
4724 /* Don't use check_x_frame here because this function is called
4725 before X frames exist. At that time, if FRAME is nil,
4726 selected_frame will be used which is the frame dumped with
4727 Emacs. That frame is not an X frame. */
4728 f
= frame_or_selected_frame (frame
, 2);
4730 lface1
= lface_from_face_name (NULL
, face1
, 1);
4731 lface2
= lface_from_face_name (NULL
, face2
, 1);
4732 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4733 XVECTOR (lface2
)->contents
);
4734 return equal_p
? Qt
: Qnil
;
4738 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4739 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4740 "True if FACE has no attribute specified.\n\
4741 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4742 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4743 If FRAME is omitted or nil, use the selected frame.")
4745 Lisp_Object face
, frame
;
4752 frame
= selected_frame
;
4753 CHECK_LIVE_FRAME (frame
, 0);
4757 lface
= lface_from_face_name (NULL
, face
, 1);
4759 lface
= lface_from_face_name (f
, face
, 1);
4761 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4762 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4765 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4769 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4771 "Return an alist of frame-local faces defined on FRAME.\n\
4772 For internal use only.")
4776 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4777 return f
->face_alist
;
4781 /* Return a hash code for Lisp string STRING with case ignored. Used
4782 below in computing a hash value for a Lisp face. */
4784 static INLINE
unsigned
4785 hash_string_case_insensitive (string
)
4790 xassert (STRINGP (string
));
4791 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4792 hash
= (hash
<< 1) ^ tolower (*s
);
4797 /* Return a hash code for face attribute vector V. */
4799 static INLINE
unsigned
4803 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4804 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4805 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4806 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4807 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4808 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4809 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4813 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4814 considering charsets/registries). They do if they specify the same
4815 family, point size, weight, width, slant, and fontset. Both LFACE1
4816 and LFACE2 must be fully-specified. */
4819 lface_same_font_attributes_p (lface1
, lface2
)
4820 Lisp_Object
*lface1
, *lface2
;
4822 xassert (lface_fully_specified_p (lface1
)
4823 && lface_fully_specified_p (lface2
));
4824 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4825 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4826 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4827 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4828 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4829 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4830 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4831 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4832 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4833 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4834 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4839 /***********************************************************************
4841 ***********************************************************************/
4843 /* Allocate and return a new realized face for Lisp face attribute
4846 static struct face
*
4847 make_realized_face (attr
)
4850 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4851 bzero (face
, sizeof *face
);
4852 face
->ascii_face
= face
;
4853 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4858 /* Free realized face FACE, including its X resources. FACE may
4862 free_realized_face (f
, face
)
4868 #ifdef HAVE_WINDOW_SYSTEM
4869 if (FRAME_WINDOW_P (f
))
4871 /* Free fontset of FACE if it is ASCII face. */
4872 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4873 free_face_fontset (f
, face
);
4876 x_free_gc (f
, face
->gc
);
4880 free_face_colors (f
, face
);
4881 x_destroy_bitmap (f
, face
->stipple
);
4883 #endif /* HAVE_WINDOW_SYSTEM */
4890 /* Prepare face FACE for subsequent display on frame F. This
4891 allocated GCs if they haven't been allocated yet or have been freed
4892 by clearing the face cache. */
4895 prepare_face_for_display (f
, face
)
4899 #ifdef HAVE_WINDOW_SYSTEM
4900 xassert (FRAME_WINDOW_P (f
));
4905 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4907 xgcv
.foreground
= face
->foreground
;
4908 xgcv
.background
= face
->background
;
4909 #ifdef HAVE_X_WINDOWS
4910 xgcv
.graphics_exposures
= False
;
4912 /* The font of FACE may be null if we couldn't load it. */
4915 #ifdef HAVE_X_WINDOWS
4916 xgcv
.font
= face
->font
->fid
;
4919 xgcv
.font
= face
->font
;
4922 xgcv
.font
= face
->font
;
4928 #ifdef HAVE_X_WINDOWS
4931 xgcv
.fill_style
= FillOpaqueStippled
;
4932 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4933 mask
|= GCFillStyle
| GCStipple
;
4936 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4939 #endif /* HAVE_WINDOW_SYSTEM */
4943 /***********************************************************************
4945 ***********************************************************************/
4947 /* Return a new face cache for frame F. */
4949 static struct face_cache
*
4953 struct face_cache
*c
;
4956 c
= (struct face_cache
*) xmalloc (sizeof *c
);
4957 bzero (c
, sizeof *c
);
4958 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
4959 c
->buckets
= (struct face
**) xmalloc (size
);
4960 bzero (c
->buckets
, size
);
4962 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
4968 /* Clear out all graphics contexts for all realized faces, except for
4969 the basic faces. This should be done from time to time just to avoid
4970 keeping too many graphics contexts that are no longer needed. */
4974 struct face_cache
*c
;
4976 if (c
&& FRAME_WINDOW_P (c
->f
))
4978 #ifdef HAVE_WINDOW_SYSTEM
4980 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
4982 struct face
*face
= c
->faces_by_id
[i
];
4983 if (face
&& face
->gc
)
4985 x_free_gc (c
->f
, face
->gc
);
4989 #endif /* HAVE_WINDOW_SYSTEM */
4994 /* Free all realized faces in face cache C, including basic faces. C
4995 may be null. If faces are freed, make sure the frame's current
4996 matrix is marked invalid, so that a display caused by an expose
4997 event doesn't try to use faces we destroyed. */
5000 free_realized_faces (c
)
5001 struct face_cache
*c
;
5006 struct frame
*f
= c
->f
;
5008 /* We must block input here because we can't process X events
5009 safely while only some faces are freed, or when the frame's
5010 current matrix still references freed faces. */
5013 for (i
= 0; i
< c
->used
; ++i
)
5015 free_realized_face (f
, c
->faces_by_id
[i
]);
5016 c
->faces_by_id
[i
] = NULL
;
5020 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5021 bzero (c
->buckets
, size
);
5023 /* Must do a thorough redisplay the next time. Mark current
5024 matrices as invalid because they will reference faces freed
5025 above. This function is also called when a frame is
5026 destroyed. In this case, the root window of F is nil. */
5027 if (WINDOWP (f
->root_window
))
5029 clear_current_matrices (f
);
5030 ++windows_or_buffers_changed
;
5038 /* Free all faces realized for multibyte characters on frame F that
5042 free_realized_multibyte_face (f
, fontset
)
5046 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5050 /* We must block input here because we can't process X events safely
5051 while only some faces are freed, or when the frame's current
5052 matrix still references freed faces. */
5055 for (i
= 0; i
< cache
->used
; i
++)
5057 face
= cache
->faces_by_id
[i
];
5059 && face
!= face
->ascii_face
5060 && face
->fontset
== fontset
)
5062 uncache_face (cache
, face
);
5063 free_realized_face (f
, face
);
5067 /* Must do a thorough redisplay the next time. Mark current
5068 matrices as invalid because they will reference faces freed
5069 above. This function is also called when a frame is destroyed.
5070 In this case, the root window of F is nil. */
5071 if (WINDOWP (f
->root_window
))
5073 clear_current_matrices (f
);
5074 ++windows_or_buffers_changed
;
5081 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5082 This is done after attributes of a named face have been changed,
5083 because we can't tell which realized faces depend on that face. */
5086 free_all_realized_faces (frame
)
5092 FOR_EACH_FRAME (rest
, frame
)
5093 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5096 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5100 /* Free face cache C and faces in it, including their X resources. */
5104 struct face_cache
*c
;
5108 free_realized_faces (c
);
5110 xfree (c
->faces_by_id
);
5116 /* Cache realized face FACE in face cache C. HASH is the hash value
5117 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5118 collision list of the face hash table of C. This is done because
5119 otherwise lookup_face would find FACE for every character, even if
5120 faces with the same attributes but for specific characters exist. */
5123 cache_face (c
, face
, hash
)
5124 struct face_cache
*c
;
5128 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5132 if (face
->fontset
>= 0)
5134 struct face
*last
= c
->buckets
[i
];
5145 c
->buckets
[i
] = face
;
5146 face
->prev
= face
->next
= NULL
;
5152 face
->next
= c
->buckets
[i
];
5154 face
->next
->prev
= face
;
5155 c
->buckets
[i
] = face
;
5158 /* Find a free slot in C->faces_by_id and use the index of the free
5159 slot as FACE->id. */
5160 for (i
= 0; i
< c
->used
; ++i
)
5161 if (c
->faces_by_id
[i
] == NULL
)
5165 /* Maybe enlarge C->faces_by_id. */
5166 if (i
== c
->used
&& c
->used
== c
->size
)
5168 int new_size
= 2 * c
->size
;
5169 int sz
= new_size
* sizeof *c
->faces_by_id
;
5170 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5175 /* Check that FACE got a unique id. */
5180 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5181 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5187 #endif /* GLYPH_DEBUG */
5189 c
->faces_by_id
[i
] = face
;
5195 /* Remove face FACE from cache C. */
5198 uncache_face (c
, face
)
5199 struct face_cache
*c
;
5202 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5205 face
->prev
->next
= face
->next
;
5207 c
->buckets
[i
] = face
->next
;
5210 face
->next
->prev
= face
->prev
;
5212 c
->faces_by_id
[face
->id
] = NULL
;
5213 if (face
->id
== c
->used
)
5218 /* Look up a realized face with face attributes ATTR in the face cache
5219 of frame F. The face will be used to display character C. Value
5220 is the ID of the face found. If no suitable face is found, realize
5221 a new one. In that case, if C is a multibyte character, BASE_FACE
5222 is a face that has the same attributes. */
5225 lookup_face (f
, attr
, c
, base_face
)
5229 struct face
*base_face
;
5231 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5236 xassert (cache
!= NULL
);
5237 check_lface_attrs (attr
);
5239 /* Look up ATTR in the face cache. */
5240 hash
= lface_hash (attr
);
5241 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5243 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5244 if (face
->hash
== hash
5245 && (!FRAME_WINDOW_P (f
)
5246 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5247 && lface_equal_p (face
->lface
, attr
))
5250 /* If not found, realize a new face. */
5252 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5255 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5257 /* When this function is called from face_for_char (in this case, C is
5258 a multibyte character), a fontset of a face returned by
5259 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5260 C) is not sutisfied. The fontset is set for this face by
5261 face_for_char later. */
5263 if (FRAME_WINDOW_P (f
))
5264 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5266 #endif /* GLYPH_DEBUG */
5272 /* Return the face id of the realized face for named face SYMBOL on
5273 frame F suitable for displaying character C. Value is -1 if the
5274 face couldn't be determined, which might happen if the default face
5275 isn't realized and cannot be realized. */
5278 lookup_named_face (f
, symbol
, c
)
5283 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5284 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5285 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5287 if (default_face
== NULL
)
5289 if (!realize_basic_faces (f
))
5291 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5294 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5295 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5296 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5297 return lookup_face (f
, attrs
, c
, NULL
);
5301 /* Return the ID of the realized ASCII face of Lisp face with ID
5302 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5305 ascii_face_of_lisp_face (f
, lface_id
)
5311 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5313 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5314 face_id
= lookup_named_face (f
, face_name
, 0);
5323 /* Return a face for charset ASCII that is like the face with id
5324 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5325 STEPS < 0 means larger. Value is the id of the face. */
5328 smaller_face (f
, face_id
, steps
)
5332 #ifdef HAVE_WINDOW_SYSTEM
5334 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5335 int pt
, last_pt
, last_height
;
5338 struct face
*new_face
;
5340 /* If not called for an X frame, just return the original face. */
5341 if (FRAME_TERMCAP_P (f
))
5344 /* Try in increments of 1/2 pt. */
5345 delta
= steps
< 0 ? 5 : -5;
5346 steps
= abs (steps
);
5348 face
= FACE_FROM_ID (f
, face_id
);
5349 bcopy (face
->lface
, attrs
, sizeof attrs
);
5350 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5351 new_face_id
= face_id
;
5352 last_height
= FONT_HEIGHT (face
->font
);
5356 /* Give up if we cannot find a font within 10pt. */
5357 && abs (last_pt
- pt
) < 100)
5359 /* Look up a face for a slightly smaller/larger font. */
5361 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5362 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5363 new_face
= FACE_FROM_ID (f
, new_face_id
);
5365 /* If height changes, count that as one step. */
5366 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5367 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5370 last_height
= FONT_HEIGHT (new_face
->font
);
5377 #else /* not HAVE_WINDOW_SYSTEM */
5381 #endif /* not HAVE_WINDOW_SYSTEM */
5385 /* Return a face for charset ASCII that is like the face with id
5386 FACE_ID on frame F, but has height HEIGHT. */
5389 face_with_height (f
, face_id
, height
)
5394 #ifdef HAVE_WINDOW_SYSTEM
5396 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5398 if (FRAME_TERMCAP_P (f
)
5402 face
= FACE_FROM_ID (f
, face_id
);
5403 bcopy (face
->lface
, attrs
, sizeof attrs
);
5404 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5405 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5406 #endif /* HAVE_WINDOW_SYSTEM */
5412 /* Return the face id of the realized face for named face SYMBOL on
5413 frame F suitable for displaying character C, and use attributes of
5414 the face FACE_ID for attributes that aren't completely specified by
5415 SYMBOL. This is like lookup_named_face, except that the default
5416 attributes come from FACE_ID, not from the default face. FACE_ID
5417 is assumed to be already realized. */
5420 lookup_derived_face (f
, symbol
, c
, face_id
)
5426 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5427 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5428 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5433 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5434 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5435 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5436 return lookup_face (f
, attrs
, c
, default_face
);
5441 /***********************************************************************
5443 ***********************************************************************/
5445 DEFUN ("internal-set-font-selection-order",
5446 Finternal_set_font_selection_order
,
5447 Sinternal_set_font_selection_order
, 1, 1, 0,
5448 "Set font selection order for face font selection to ORDER.\n\
5449 ORDER must be a list of length 4 containing the symbols `:width',\n\
5450 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5451 first in ORDER are matched first, e.g. if `:height' appears before\n\
5452 `:weight' in ORDER, font selection first tries to find a font with\n\
5453 a suitable height, and then tries to match the font weight.\n\
5462 CHECK_LIST (order
, 0);
5463 bzero (indices
, sizeof indices
);
5467 CONSP (list
) && i
< DIM (indices
);
5468 list
= XCDR (list
), ++i
)
5470 Lisp_Object attr
= XCAR (list
);
5473 if (EQ (attr
, QCwidth
))
5475 else if (EQ (attr
, QCheight
))
5476 xlfd
= XLFD_POINT_SIZE
;
5477 else if (EQ (attr
, QCweight
))
5479 else if (EQ (attr
, QCslant
))
5484 if (indices
[i
] != 0)
5490 || i
!= DIM (indices
)
5495 signal_error ("Invalid font sort order", order
);
5497 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5499 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5500 free_all_realized_faces (Qnil
);
5507 DEFUN ("internal-set-alternative-font-family-alist",
5508 Finternal_set_alternative_font_family_alist
,
5509 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5510 "Define alternative font families to try in face font selection.\n\
5511 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5512 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5513 be found. Value is ALIST.")
5517 CHECK_LIST (alist
, 0);
5518 Vface_alternative_font_family_alist
= alist
;
5519 free_all_realized_faces (Qnil
);
5524 #ifdef HAVE_WINDOW_SYSTEM
5526 /* Value is non-zero if FONT is the name of a scalable font. The
5527 X11R6 XLFD spec says that point size, pixel size, and average width
5528 are zero for scalable fonts. Intlfonts contain at least one
5529 scalable font ("*-muleindian-1") for which this isn't true, so we
5530 just test average width. */
5533 font_scalable_p (font
)
5534 struct font_name
*font
;
5536 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5537 return (*s
== '0' && *(s
+ 1) == '\0')
5539 /* Windows implementation of XLFD is slightly broken for backward
5540 compatibility with previous broken versions, so test for
5541 wildcards as well as 0. */
5548 /* Value is non-zero if FONT1 is a better match for font attributes
5549 VALUES than FONT2. VALUES is an array of face attribute values in
5550 font sort order. COMPARE_PT_P zero means don't compare point
5554 better_font_p (values
, font1
, font2
, compare_pt_p
)
5556 struct font_name
*font1
, *font2
;
5561 for (i
= 0; i
< 4; ++i
)
5563 int xlfd_idx
= font_sort_order
[i
];
5565 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5567 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5568 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5570 if (delta1
> delta2
)
5572 else if (delta1
< delta2
)
5576 /* The difference may be equal because, e.g., the face
5577 specifies `italic' but we have only `regular' and
5578 `oblique'. Prefer `oblique' in this case. */
5579 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5580 && font1
->numeric
[xlfd_idx
] > values
[i
]
5581 && font2
->numeric
[xlfd_idx
] < values
[i
])
5591 /* Value is non-zero if FONT is an exact match for face attributes in
5592 SPECIFIED. SPECIFIED is an array of face attribute values in font
5596 exact_face_match_p (specified
, font
)
5598 struct font_name
*font
;
5602 for (i
= 0; i
< 4; ++i
)
5603 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5610 /* Value is the name of a scaled font, generated from scalable font
5611 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5612 Value is allocated from heap. */
5615 build_scalable_font_name (f
, font
, specified_pt
)
5617 struct font_name
*font
;
5620 char point_size
[20], pixel_size
[20];
5622 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5625 /* If scalable font is for a specific resolution, compute
5626 the point size we must specify from the resolution of
5627 the display and the specified resolution of the font. */
5628 if (font
->numeric
[XLFD_RESY
] != 0)
5630 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5631 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5636 pixel_value
= resy
/ 720.0 * pt
;
5639 /* Set point size of the font. */
5640 sprintf (point_size
, "%d", (int) pt
);
5641 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5642 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5644 /* Set pixel size. */
5645 sprintf (pixel_size
, "%d", pixel_value
);
5646 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5647 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5649 /* If font doesn't specify its resolution, use the
5650 resolution of the display. */
5651 if (font
->numeric
[XLFD_RESY
] == 0)
5654 sprintf (buffer
, "%d", (int) resy
);
5655 font
->fields
[XLFD_RESY
] = buffer
;
5656 font
->numeric
[XLFD_RESY
] = resy
;
5659 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5662 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5663 sprintf (buffer
, "%d", resx
);
5664 font
->fields
[XLFD_RESX
] = buffer
;
5665 font
->numeric
[XLFD_RESX
] = resx
;
5668 return build_font_name (font
);
5672 /* Value is non-zero if we are allowed to use scalable font FONT. We
5673 can't run a Lisp function here since this function may be called
5674 with input blocked. */
5677 may_use_scalable_font_p (font
, name
)
5678 struct font_name
*font
;
5681 if (EQ (Vscalable_fonts_allowed
, Qt
))
5683 else if (CONSP (Vscalable_fonts_allowed
))
5685 Lisp_Object tail
, regexp
;
5687 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5689 regexp
= XCAR (tail
);
5690 if (STRINGP (regexp
)
5691 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5701 /* Return the name of the best matching font for face attributes
5702 ATTRS in the array of font_name structures FONTS which contains
5703 NFONTS elements. Value is a font name which is allocated from
5704 the heap. FONTS is freed by this function. */
5707 best_matching_font (f
, attrs
, fonts
, nfonts
)
5710 struct font_name
*fonts
;
5714 struct font_name
*best
;
5722 /* Make specified font attributes available in `specified',
5723 indexed by sort order. */
5724 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5726 int xlfd_idx
= font_sort_order
[i
];
5728 if (xlfd_idx
== XLFD_SWIDTH
)
5729 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5730 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5731 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5732 else if (xlfd_idx
== XLFD_WEIGHT
)
5733 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5734 else if (xlfd_idx
== XLFD_SLANT
)
5735 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5742 /* Start with the first non-scalable font in the list. */
5743 for (i
= 0; i
< nfonts
; ++i
)
5744 if (!font_scalable_p (fonts
+ i
))
5747 /* Find the best match among the non-scalable fonts. */
5752 for (i
= 1; i
< nfonts
; ++i
)
5753 if (!font_scalable_p (fonts
+ i
)
5754 && better_font_p (specified
, fonts
+ i
, best
, 1))
5758 exact_p
= exact_face_match_p (specified
, best
);
5767 /* Unless we found an exact match among non-scalable fonts, see if
5768 we can find a better match among scalable fonts. */
5771 /* A scalable font is better if
5773 1. its weight, slant, swidth attributes are better, or.
5775 2. the best non-scalable font doesn't have the required
5776 point size, and the scalable fonts weight, slant, swidth
5779 int non_scalable_has_exact_height_p
;
5781 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5782 non_scalable_has_exact_height_p
= 1;
5784 non_scalable_has_exact_height_p
= 0;
5786 for (i
= 0; i
< nfonts
; ++i
)
5787 if (font_scalable_p (fonts
+ i
))
5790 || better_font_p (specified
, fonts
+ i
, best
, 0)
5791 || (!non_scalable_has_exact_height_p
5792 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5797 if (font_scalable_p (best
))
5798 font_name
= build_scalable_font_name (f
, best
, pt
);
5800 font_name
= build_font_name (best
);
5802 /* Free font_name structures. */
5803 free_font_names (fonts
, nfonts
);
5809 /* Try to get a list of fonts on frame F with font family FAMILY and
5810 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5811 of font_name structures for the fonts matched. Value is the number
5815 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5818 Lisp_Object pattern
, family
, registry
;
5819 struct font_name
**fonts
;
5823 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5824 family
= attrs
[LFACE_FAMILY_INDEX
];
5826 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5828 if (nfonts
== 0 && !NILP (family
))
5832 /* Try alternative font families from
5833 Vface_alternative_font_family_alist. */
5834 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5836 for (alter
= XCDR (alter
);
5837 CONSP (alter
) && nfonts
== 0;
5838 alter
= XCDR (alter
))
5840 if (STRINGP (XCAR (alter
)))
5841 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5844 /* Try font family of the default face or "fixed". */
5847 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5849 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5851 family
= build_string ("fixed");
5852 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5855 /* Try any family with the given registry. */
5857 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5864 /* Return the fontset id of the base fontset name or alias name given
5865 by the fontset attribute of ATTRS. Value is -1 if the fontset
5866 attribute of ATTRS doesn't name a fontset. */
5869 face_fontset (attrs
)
5875 name
= attrs
[LFACE_FONT_INDEX
];
5876 if (!STRINGP (name
))
5878 return fs_query_fontset (name
, 0);
5882 /* Choose a name of font to use on frame F to display character C with
5883 Lisp face attributes specified by ATTRS. The font name is
5884 determined by the font-related attributes in ATTRS and the name
5885 pattern for C in FONTSET. Value is the font name which is
5886 allocated from the heap and must be freed by the caller, or NULL if
5887 we can get no information about the font name of C. It is assured
5888 that we always get some information for a single byte
5892 choose_face_font (f
, attrs
, fontset
, c
)
5897 Lisp_Object pattern
;
5898 char *font_name
= NULL
;
5899 struct font_name
*fonts
;
5902 /* Get (foundry and) family name and registry (and encoding) name of
5904 pattern
= fontset_font_pattern (f
, fontset
, c
);
5907 xassert (!SINGLE_BYTE_CHAR_P (c
));
5910 /* If what we got is a name pattern, return it. */
5911 if (STRINGP (pattern
))
5912 return xstrdup (XSTRING (pattern
)->data
);
5914 /* Family name may be specified both in ATTRS and car part of
5915 PATTERN. The former has higher priority if C is a single byte
5917 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5918 && SINGLE_BYTE_CHAR_P (c
))
5919 XCAR (pattern
) = Qnil
;
5921 /* Get a list of fonts matching that pattern and choose the
5922 best match for the specified face attributes from it. */
5923 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5925 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5929 #endif /* HAVE_WINDOW_SYSTEM */
5933 /***********************************************************************
5935 ***********************************************************************/
5937 /* Realize basic faces on frame F. Value is zero if frame parameters
5938 of F don't contain enough information needed to realize the default
5942 realize_basic_faces (f
)
5947 /* Block input there so that we won't be surprised by an X expose
5948 event, for instance without having the faces set up. */
5951 if (realize_default_face (f
))
5953 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
5954 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
5955 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
5956 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
5957 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
5958 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
5959 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
5960 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
5961 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
5963 /* Reflect changes in the `menu' face in menu bars. */
5964 if (menu_face_change_count
)
5966 menu_face_change_count
= 0;
5968 #ifdef USE_X_TOOLKIT
5971 Widget menu
= f
->output_data
.x
->menubar_widget
;
5973 x_set_menu_resources_from_menu_face (f
, menu
);
5975 #endif /* USE_X_TOOLKIT */
5986 /* Realize the default face on frame F. If the face is not fully
5987 specified, make it fully-specified. Attributes of the default face
5988 that are not explicitly specified are taken from frame parameters. */
5991 realize_default_face (f
)
5994 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
5996 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5997 Lisp_Object frame_font
;
6001 /* If the `default' face is not yet known, create it. */
6002 lface
= lface_from_face_name (f
, Qdefault
, 0);
6006 XSETFRAME (frame
, f
);
6007 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6010 #ifdef HAVE_WINDOW_SYSTEM
6011 if (FRAME_WINDOW_P (f
))
6013 /* Set frame_font to the value of the `font' frame parameter. */
6014 frame_font
= Fassq (Qfont
, f
->param_alist
);
6015 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6016 frame_font
= XCDR (frame_font
);
6017 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6019 #endif /* HAVE_WINDOW_SYSTEM */
6021 if (!FRAME_WINDOW_P (f
))
6023 LFACE_FAMILY (lface
) = build_string ("default");
6024 LFACE_SWIDTH (lface
) = Qnormal
;
6025 LFACE_HEIGHT (lface
) = make_number (1);
6026 LFACE_WEIGHT (lface
) = Qnormal
;
6027 LFACE_SLANT (lface
) = Qnormal
;
6030 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6031 LFACE_UNDERLINE (lface
) = Qnil
;
6033 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6034 LFACE_OVERLINE (lface
) = Qnil
;
6036 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6037 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6039 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6040 LFACE_BOX (lface
) = Qnil
;
6042 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6043 LFACE_INVERSE (lface
) = Qnil
;
6045 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6047 /* This function is called so early that colors are not yet
6048 set in the frame parameter list. */
6049 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6051 if (CONSP (color
) && STRINGP (XCDR (color
)))
6052 LFACE_FOREGROUND (lface
) = XCDR (color
);
6053 else if (FRAME_WINDOW_P (f
))
6055 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6056 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6061 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6063 /* This function is called so early that colors are not yet
6064 set in the frame parameter list. */
6065 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6066 if (CONSP (color
) && STRINGP (XCDR (color
)))
6067 LFACE_BACKGROUND (lface
) = XCDR (color
);
6068 else if (FRAME_WINDOW_P (f
))
6070 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6071 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6076 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6077 LFACE_STIPPLE (lface
) = Qnil
;
6079 /* Realize the face; it must be fully-specified now. */
6080 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6081 check_lface (lface
);
6082 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6083 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6088 /* Realize basic faces other than the default face in face cache C.
6089 SYMBOL is the face name, ID is the face id the realized face must
6090 have. The default face must have been realized already. */
6093 realize_named_face (f
, symbol
, id
)
6098 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6099 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6100 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6101 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6102 struct face
*new_face
;
6104 /* The default face must exist and be fully specified. */
6105 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6106 check_lface_attrs (attrs
);
6107 xassert (lface_fully_specified_p (attrs
));
6109 /* If SYMBOL isn't know as a face, create it. */
6113 XSETFRAME (frame
, f
);
6114 lface
= Finternal_make_lisp_face (symbol
, frame
);
6117 /* Merge SYMBOL's face with the default face. */
6118 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6119 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6121 /* Realize the face. */
6122 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6126 /* Realize the fully-specified face with attributes ATTRS in face
6127 cache CACHE for character C. If C is a multibyte character,
6128 BASE_FACE is a face that has the same attributes. Otherwise,
6129 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6130 ID of face to remove before caching the new face. Value is a
6131 pointer to the newly created realized face. */
6133 static struct face
*
6134 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6135 struct face_cache
*cache
;
6138 struct face
*base_face
;
6143 /* LFACE must be fully specified. */
6144 xassert (cache
!= NULL
);
6145 check_lface_attrs (attrs
);
6147 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6149 /* Remove the former face. */
6150 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6151 uncache_face (cache
, former_face
);
6152 free_realized_face (cache
->f
, former_face
);
6155 if (FRAME_WINDOW_P (cache
->f
))
6156 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6157 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6158 face
= realize_tty_face (cache
, attrs
, c
);
6162 /* Insert the new face. */
6163 cache_face (cache
, face
, lface_hash (attrs
));
6164 #ifdef HAVE_WINDOW_SYSTEM
6165 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6166 load_face_font (cache
->f
, face
, c
);
6167 #endif /* HAVE_WINDOW_SYSTEM */
6172 /* Realize the fully-specified face with attributes ATTRS in face
6173 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6174 a multibyte character, BASE_FACE is a face that has the same
6175 attributes. Otherwise, BASE_FACE is ignored. If the new face
6176 doesn't share font with the default face, a fontname is allocated
6177 from the heap and set in `font_name' of the new face, but it is not
6178 yet loaded here. Value is a pointer to the newly created realized
6181 static struct face
*
6182 realize_x_face (cache
, attrs
, c
, base_face
)
6183 struct face_cache
*cache
;
6186 struct face
*base_face
;
6188 #ifdef HAVE_WINDOW_SYSTEM
6189 struct face
*face
, *default_face
;
6191 Lisp_Object stipple
, overline
, strike_through
, box
;
6193 xassert (FRAME_WINDOW_P (cache
->f
));
6194 xassert (SINGLE_BYTE_CHAR_P (c
)
6197 /* Allocate a new realized face. */
6198 face
= make_realized_face (attrs
);
6202 /* If C is a multibyte character, we share all face attirbutes with
6203 BASE_FACE including the realized fontset. But, we must load a
6205 if (!SINGLE_BYTE_CHAR_P (c
))
6207 bcopy (base_face
, face
, sizeof *face
);
6210 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6211 face
->foreground_defaulted_p
= 1;
6212 face
->background_defaulted_p
= 1;
6213 face
->underline_defaulted_p
= 1;
6214 face
->overline_color_defaulted_p
= 1;
6215 face
->strike_through_color_defaulted_p
= 1;
6216 face
->box_color_defaulted_p
= 1;
6218 /* to force realize_face to load font */
6223 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6225 /* Determine the font to use. Most of the time, the font will be
6226 the same as the font of the default face, so try that first. */
6227 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6229 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6230 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6232 face
->font
= default_face
->font
;
6233 face
->fontset
= default_face
->fontset
;
6234 face
->font_info_id
= default_face
->font_info_id
;
6235 face
->font_name
= default_face
->font_name
;
6236 face
->ascii_face
= face
;
6238 /* But, as we can't share the fontset, make a new realized
6239 fontset that has the same base fontset as of the default
6242 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6246 /* If the face attribute ATTRS specifies a fontset, use it as
6247 the base of a new realized fontset. Otherwise, use the same
6248 base fontset as of the default face. The base determines
6249 registry and encoding of a font. It may also determine
6250 foundry and family. The other fields of font name pattern
6251 are constructed from ATTRS. */
6252 int fontset
= face_fontset (attrs
);
6254 if ((fontset
== -1) && default_face
)
6255 fontset
= default_face
->fontset
;
6256 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6257 face
->font
= NULL
; /* to force realize_face to load font */
6260 /* Load the font if it is specified in ATTRS. This fixes
6261 changing frame font on the Mac. */
6262 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6264 struct font_info
*font_info
=
6265 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6267 face
->font
= font_info
->font
;
6272 /* Load colors, and set remaining attributes. */
6274 load_face_colors (f
, face
, attrs
);
6277 box
= attrs
[LFACE_BOX_INDEX
];
6280 /* A simple box of line width 1 drawn in color given by
6282 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6284 face
->box
= FACE_SIMPLE_BOX
;
6285 face
->box_line_width
= 1;
6287 else if (INTEGERP (box
))
6289 /* Simple box of specified line width in foreground color of the
6291 xassert (XINT (box
) > 0);
6292 face
->box
= FACE_SIMPLE_BOX
;
6293 face
->box_line_width
= XFASTINT (box
);
6294 face
->box_color
= face
->foreground
;
6295 face
->box_color_defaulted_p
= 1;
6297 else if (CONSP (box
))
6299 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6300 being one of `raised' or `sunken'. */
6301 face
->box
= FACE_SIMPLE_BOX
;
6302 face
->box_color
= face
->foreground
;
6303 face
->box_color_defaulted_p
= 1;
6304 face
->box_line_width
= 1;
6308 Lisp_Object keyword
, value
;
6310 keyword
= XCAR (box
);
6318 if (EQ (keyword
, QCline_width
))
6320 if (INTEGERP (value
) && XINT (value
) > 0)
6321 face
->box_line_width
= XFASTINT (value
);
6323 else if (EQ (keyword
, QCcolor
))
6325 if (STRINGP (value
))
6327 face
->box_color
= load_color (f
, face
, value
,
6329 face
->use_box_color_for_shadows_p
= 1;
6332 else if (EQ (keyword
, QCstyle
))
6334 if (EQ (value
, Qreleased_button
))
6335 face
->box
= FACE_RAISED_BOX
;
6336 else if (EQ (value
, Qpressed_button
))
6337 face
->box
= FACE_SUNKEN_BOX
;
6342 /* Text underline, overline, strike-through. */
6344 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6346 /* Use default color (same as foreground color). */
6347 face
->underline_p
= 1;
6348 face
->underline_defaulted_p
= 1;
6349 face
->underline_color
= 0;
6351 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6353 /* Use specified color. */
6354 face
->underline_p
= 1;
6355 face
->underline_defaulted_p
= 0;
6356 face
->underline_color
6357 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6358 LFACE_UNDERLINE_INDEX
);
6360 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6362 face
->underline_p
= 0;
6363 face
->underline_defaulted_p
= 0;
6364 face
->underline_color
= 0;
6367 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6368 if (STRINGP (overline
))
6370 face
->overline_color
6371 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6372 LFACE_OVERLINE_INDEX
);
6373 face
->overline_p
= 1;
6375 else if (EQ (overline
, Qt
))
6377 face
->overline_color
= face
->foreground
;
6378 face
->overline_color_defaulted_p
= 1;
6379 face
->overline_p
= 1;
6382 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6383 if (STRINGP (strike_through
))
6385 face
->strike_through_color
6386 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6387 LFACE_STRIKE_THROUGH_INDEX
);
6388 face
->strike_through_p
= 1;
6390 else if (EQ (strike_through
, Qt
))
6392 face
->strike_through_color
= face
->foreground
;
6393 face
->strike_through_color_defaulted_p
= 1;
6394 face
->strike_through_p
= 1;
6397 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6398 if (!NILP (stipple
))
6399 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6401 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6403 #endif /* HAVE_WINDOW_SYSTEM */
6407 /* Map a specified color of face FACE on frame F to a tty color index.
6408 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6409 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6410 default foreground/background colors. */
6413 map_tty_color (f
, face
, idx
, defaulted
)
6416 enum lface_attribute_index idx
;
6419 Lisp_Object frame
, color
, def
;
6420 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6421 unsigned long default_pixel
, default_other_pixel
, pixel
;
6423 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6427 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6428 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6432 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6433 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6436 XSETFRAME (frame
, f
);
6437 color
= face
->lface
[idx
];
6440 && XSTRING (color
)->size
6441 && CONSP (Vtty_defined_color_alist
)
6442 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6445 /* Associations in tty-defined-color-alist are of the form
6446 (NAME INDEX R G B). We need the INDEX part. */
6447 pixel
= XINT (XCAR (XCDR (def
)));
6450 if (pixel
== default_pixel
&& STRINGP (color
))
6452 pixel
= load_color (f
, face
, color
, idx
);
6454 #if defined (MSDOS) || defined (WINDOWSNT)
6455 /* If the foreground of the default face is the default color,
6456 use the foreground color defined by the frame. */
6458 if (FRAME_MSDOS_P (f
))
6461 if (pixel
== default_pixel
6462 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6465 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6467 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6468 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6471 else if (pixel
== default_other_pixel
)
6474 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6476 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6477 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6483 #endif /* MSDOS or WINDOWSNT */
6487 face
->foreground
= pixel
;
6489 face
->background
= pixel
;
6493 /* Realize the fully-specified face with attributes ATTRS in face
6494 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6495 pointer to the newly created realized face. */
6497 static struct face
*
6498 realize_tty_face (cache
, attrs
, c
)
6499 struct face_cache
*cache
;
6505 int face_colors_defaulted
= 0;
6506 struct frame
*f
= cache
->f
;
6508 /* Frame must be a termcap frame. */
6509 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6511 /* Allocate a new realized face. */
6512 face
= make_realized_face (attrs
);
6513 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6515 /* Map face attributes to TTY appearances. We map slant to
6516 dimmed text because we want italic text to appear differently
6517 and because dimmed text is probably used infrequently. */
6518 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6519 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6521 if (weight
> XLFD_WEIGHT_MEDIUM
)
6522 face
->tty_bold_p
= 1;
6523 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6524 face
->tty_dim_p
= 1;
6525 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6526 face
->tty_underline_p
= 1;
6527 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6528 face
->tty_reverse_p
= 1;
6530 /* Map color names to color indices. */
6531 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6532 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6534 /* Swap colors if face is inverse-video. If the colors are taken
6535 from the frame colors, they are already inverted, since the
6536 frame-creation function calls x-handle-reverse-video. */
6537 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6539 unsigned long tem
= face
->foreground
;
6540 face
->foreground
= face
->background
;
6541 face
->background
= tem
;
6544 if (tty_suppress_bold_inverse_default_colors_p
6546 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6547 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6548 face
->tty_bold_p
= 0;
6554 DEFUN ("tty-suppress-bold-inverse-default-colors",
6555 Ftty_suppress_bold_inverse_default_colors
,
6556 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6557 "Suppress/allow boldness of faces with inverse default colors.\n\
6558 SUPPRESS non-nil means suppress it.\n\
6559 This affects bold faces on TTYs whose foreground is the default background\n\
6560 color of the display and whose background is the default foreground color.\n\
6561 For such faces, the bold face attribute is ignored if this variable\n\
6564 Lisp_Object suppress
;
6566 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6567 ++face_change_count
;
6573 /***********************************************************************
6575 ***********************************************************************/
6577 /* Return the ID of the face to use to display character CH with face
6578 property PROP on frame F in current_buffer. */
6581 compute_char_face (f
, ch
, prop
)
6588 if (NILP (current_buffer
->enable_multibyte_characters
))
6593 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6594 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6598 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6599 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6600 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6601 merge_face_vector_with_property (f
, attrs
, prop
);
6602 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6609 /* Return the face ID associated with buffer position POS for
6610 displaying ASCII characters. Return in *ENDPTR the position at
6611 which a different face is needed, as far as text properties and
6612 overlays are concerned. W is a window displaying current_buffer.
6614 REGION_BEG, REGION_END delimit the region, so it can be
6617 LIMIT is a position not to scan beyond. That is to limit the time
6618 this function can take.
6620 If MOUSE is non-zero, use the character's mouse-face, not its face.
6622 The face returned is suitable for displaying ASCII characters. */
6625 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6626 endptr
, limit
, mouse
)
6629 int region_beg
, region_end
;
6634 struct frame
*f
= XFRAME (w
->frame
);
6635 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6636 Lisp_Object prop
, position
;
6638 Lisp_Object
*overlay_vec
;
6641 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6642 Lisp_Object limit1
, end
;
6643 struct face
*default_face
;
6644 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6646 /* W must display the current buffer. We could write this function
6647 to use the frame and buffer of W, but right now it doesn't. */
6648 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6650 XSETFRAME (frame
, f
);
6651 XSETFASTINT (position
, pos
);
6654 if (pos
< region_beg
&& region_beg
< endpos
)
6655 endpos
= region_beg
;
6657 /* Get the `face' or `mouse_face' text property at POS, and
6658 determine the next position at which the property changes. */
6659 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6660 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6661 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6663 endpos
= XINT (end
);
6665 /* Look at properties from overlays. */
6670 /* First try with room for 40 overlays. */
6672 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6673 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6674 &next_overlay
, NULL
, 0);
6676 /* If there are more than 40, make enough space for all, and try
6678 if (noverlays
> len
)
6681 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6682 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6683 &next_overlay
, NULL
, 0);
6686 if (next_overlay
< endpos
)
6687 endpos
= next_overlay
;
6692 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6694 /* Optimize common cases where we can use the default face. */
6697 && !(pos
>= region_beg
&& pos
< region_end
))
6698 return DEFAULT_FACE_ID
;
6700 /* Begin with attributes from the default face. */
6701 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6703 /* Merge in attributes specified via text properties. */
6705 merge_face_vector_with_property (f
, attrs
, prop
);
6707 /* Now merge the overlay data. */
6708 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6709 for (i
= 0; i
< noverlays
; i
++)
6714 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6716 merge_face_vector_with_property (f
, attrs
, prop
);
6718 oend
= OVERLAY_END (overlay_vec
[i
]);
6719 oendpos
= OVERLAY_POSITION (oend
);
6720 if (oendpos
< endpos
)
6724 /* If in the region, merge in the region face. */
6725 if (pos
>= region_beg
&& pos
< region_end
)
6727 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6728 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6730 if (region_end
< endpos
)
6731 endpos
= region_end
;
6736 /* Look up a realized face with the given face attributes,
6737 or realize a new one for ASCII characters. */
6738 return lookup_face (f
, attrs
, 0, NULL
);
6742 /* Compute the face at character position POS in Lisp string STRING on
6743 window W, for ASCII characters.
6745 If STRING is an overlay string, it comes from position BUFPOS in
6746 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6747 not an overlay string. W must display the current buffer.
6748 REGION_BEG and REGION_END give the start and end positions of the
6749 region; both are -1 if no region is visible. BASE_FACE_ID is the
6750 id of the basic face to merge with. It is usually equal to
6751 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6752 for strings displayed in the mode or top line.
6754 Set *ENDPTR to the next position where to check for faces in
6755 STRING; -1 if the face is constant from POS to the end of the
6758 Value is the id of the face to use. The face returned is suitable
6759 for displaying ASCII characters. */
6762 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6763 region_end
, endptr
, base_face_id
)
6767 int region_beg
, region_end
;
6769 enum face_id base_face_id
;
6771 Lisp_Object prop
, position
, end
, limit
;
6772 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6773 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6774 struct face
*base_face
;
6775 int multibyte_p
= STRING_MULTIBYTE (string
);
6777 /* Get the value of the face property at the current position within
6778 STRING. Value is nil if there is no face property. */
6779 XSETFASTINT (position
, pos
);
6780 prop
= Fget_text_property (position
, Qface
, string
);
6782 /* Get the next position at which to check for faces. Value of end
6783 is nil if face is constant all the way to the end of the string.
6784 Otherwise it is a string position where to check faces next.
6785 Limit is the maximum position up to which to check for property
6786 changes in Fnext_single_property_change. Strings are usually
6787 short, so set the limit to the end of the string. */
6788 XSETFASTINT (limit
, XSTRING (string
)->size
);
6789 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6791 *endptr
= XFASTINT (end
);
6795 base_face
= FACE_FROM_ID (f
, base_face_id
);
6796 xassert (base_face
);
6798 /* Optimize the default case that there is no face property and we
6799 are not in the region. */
6801 && (base_face_id
!= DEFAULT_FACE_ID
6802 /* BUFPOS <= 0 means STRING is not an overlay string, so
6803 that the region doesn't have to be taken into account. */
6805 || bufpos
< region_beg
6806 || bufpos
>= region_end
)
6808 /* We can't realize faces for different charsets differently
6809 if we don't have fonts, so we can stop here if not working
6810 on a window-system frame. */
6811 || !FRAME_WINDOW_P (f
)
6812 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6813 return base_face
->id
;
6815 /* Begin with attributes from the base face. */
6816 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6818 /* Merge in attributes specified via text properties. */
6820 merge_face_vector_with_property (f
, attrs
, prop
);
6822 /* If in the region, merge in the region face. */
6824 && bufpos
>= region_beg
6825 && bufpos
< region_end
)
6827 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6828 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6831 /* Look up a realized face with the given face attributes,
6832 or realize a new one for ASCII characters. */
6833 return lookup_face (f
, attrs
, 0, NULL
);
6838 /***********************************************************************
6840 ***********************************************************************/
6844 /* Print the contents of the realized face FACE to stderr. */
6847 dump_realized_face (face
)
6850 fprintf (stderr
, "ID: %d\n", face
->id
);
6851 #ifdef HAVE_X_WINDOWS
6852 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6854 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6856 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6857 fprintf (stderr
, "background: 0x%lx (%s)\n",
6859 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6860 fprintf (stderr
, "font_name: %s (%s)\n",
6862 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6863 #ifdef HAVE_X_WINDOWS
6864 fprintf (stderr
, "font = %p\n", face
->font
);
6866 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6867 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6868 fprintf (stderr
, "underline: %d (%s)\n",
6870 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6871 fprintf (stderr
, "hash: %d\n", face
->hash
);
6872 fprintf (stderr
, "charset: %d\n", face
->charset
);
6876 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6884 fprintf (stderr
, "font selection order: ");
6885 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6886 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6887 fprintf (stderr
, "\n");
6889 fprintf (stderr
, "alternative fonts: ");
6890 debug_print (Vface_alternative_font_family_alist
);
6891 fprintf (stderr
, "\n");
6893 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6894 Fdump_face (make_number (i
));
6899 CHECK_NUMBER (n
, 0);
6900 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6902 error ("Not a valid face");
6903 dump_realized_face (face
);
6910 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6914 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6915 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6916 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6920 #endif /* GLYPH_DEBUG != 0 */
6924 /***********************************************************************
6926 ***********************************************************************/
6931 Qface
= intern ("face");
6933 Qbitmap_spec_p
= intern ("bitmap-spec-p");
6934 staticpro (&Qbitmap_spec_p
);
6935 Qframe_update_face_colors
= intern ("frame-update-face-colors");
6936 staticpro (&Qframe_update_face_colors
);
6938 /* Lisp face attribute keywords. */
6939 QCfamily
= intern (":family");
6940 staticpro (&QCfamily
);
6941 QCheight
= intern (":height");
6942 staticpro (&QCheight
);
6943 QCweight
= intern (":weight");
6944 staticpro (&QCweight
);
6945 QCslant
= intern (":slant");
6946 staticpro (&QCslant
);
6947 QCunderline
= intern (":underline");
6948 staticpro (&QCunderline
);
6949 QCinverse_video
= intern (":inverse-video");
6950 staticpro (&QCinverse_video
);
6951 QCreverse_video
= intern (":reverse-video");
6952 staticpro (&QCreverse_video
);
6953 QCforeground
= intern (":foreground");
6954 staticpro (&QCforeground
);
6955 QCbackground
= intern (":background");
6956 staticpro (&QCbackground
);
6957 QCstipple
= intern (":stipple");;
6958 staticpro (&QCstipple
);
6959 QCwidth
= intern (":width");
6960 staticpro (&QCwidth
);
6961 QCfont
= intern (":font");
6962 staticpro (&QCfont
);
6963 QCbold
= intern (":bold");
6964 staticpro (&QCbold
);
6965 QCitalic
= intern (":italic");
6966 staticpro (&QCitalic
);
6967 QCoverline
= intern (":overline");
6968 staticpro (&QCoverline
);
6969 QCstrike_through
= intern (":strike-through");
6970 staticpro (&QCstrike_through
);
6971 QCbox
= intern (":box");
6973 QCinherit
= intern (":inherit");
6974 staticpro (&QCinherit
);
6976 /* Symbols used for Lisp face attribute values. */
6977 QCcolor
= intern (":color");
6978 staticpro (&QCcolor
);
6979 QCline_width
= intern (":line-width");
6980 staticpro (&QCline_width
);
6981 QCstyle
= intern (":style");
6982 staticpro (&QCstyle
);
6983 Qreleased_button
= intern ("released-button");
6984 staticpro (&Qreleased_button
);
6985 Qpressed_button
= intern ("pressed-button");
6986 staticpro (&Qpressed_button
);
6987 Qnormal
= intern ("normal");
6988 staticpro (&Qnormal
);
6989 Qultra_light
= intern ("ultra-light");
6990 staticpro (&Qultra_light
);
6991 Qextra_light
= intern ("extra-light");
6992 staticpro (&Qextra_light
);
6993 Qlight
= intern ("light");
6994 staticpro (&Qlight
);
6995 Qsemi_light
= intern ("semi-light");
6996 staticpro (&Qsemi_light
);
6997 Qsemi_bold
= intern ("semi-bold");
6998 staticpro (&Qsemi_bold
);
6999 Qbold
= intern ("bold");
7001 Qextra_bold
= intern ("extra-bold");
7002 staticpro (&Qextra_bold
);
7003 Qultra_bold
= intern ("ultra-bold");
7004 staticpro (&Qultra_bold
);
7005 Qoblique
= intern ("oblique");
7006 staticpro (&Qoblique
);
7007 Qitalic
= intern ("italic");
7008 staticpro (&Qitalic
);
7009 Qreverse_oblique
= intern ("reverse-oblique");
7010 staticpro (&Qreverse_oblique
);
7011 Qreverse_italic
= intern ("reverse-italic");
7012 staticpro (&Qreverse_italic
);
7013 Qultra_condensed
= intern ("ultra-condensed");
7014 staticpro (&Qultra_condensed
);
7015 Qextra_condensed
= intern ("extra-condensed");
7016 staticpro (&Qextra_condensed
);
7017 Qcondensed
= intern ("condensed");
7018 staticpro (&Qcondensed
);
7019 Qsemi_condensed
= intern ("semi-condensed");
7020 staticpro (&Qsemi_condensed
);
7021 Qsemi_expanded
= intern ("semi-expanded");
7022 staticpro (&Qsemi_expanded
);
7023 Qexpanded
= intern ("expanded");
7024 staticpro (&Qexpanded
);
7025 Qextra_expanded
= intern ("extra-expanded");
7026 staticpro (&Qextra_expanded
);
7027 Qultra_expanded
= intern ("ultra-expanded");
7028 staticpro (&Qultra_expanded
);
7029 Qbackground_color
= intern ("background-color");
7030 staticpro (&Qbackground_color
);
7031 Qforeground_color
= intern ("foreground-color");
7032 staticpro (&Qforeground_color
);
7033 Qunspecified
= intern ("unspecified");
7034 staticpro (&Qunspecified
);
7036 Qface_alias
= intern ("face-alias");
7037 staticpro (&Qface_alias
);
7038 Qdefault
= intern ("default");
7039 staticpro (&Qdefault
);
7040 Qtool_bar
= intern ("tool-bar");
7041 staticpro (&Qtool_bar
);
7042 Qregion
= intern ("region");
7043 staticpro (&Qregion
);
7044 Qfringe
= intern ("fringe");
7045 staticpro (&Qfringe
);
7046 Qheader_line
= intern ("header-line");
7047 staticpro (&Qheader_line
);
7048 Qscroll_bar
= intern ("scroll-bar");
7049 staticpro (&Qscroll_bar
);
7050 Qmenu
= intern ("menu");
7052 Qcursor
= intern ("cursor");
7053 staticpro (&Qcursor
);
7054 Qborder
= intern ("border");
7055 staticpro (&Qborder
);
7056 Qmouse
= intern ("mouse");
7057 staticpro (&Qmouse
);
7058 Qtty_color_desc
= intern ("tty-color-desc");
7059 staticpro (&Qtty_color_desc
);
7060 Qtty_color_by_index
= intern ("tty-color-by-index");
7061 staticpro (&Qtty_color_by_index
);
7062 Qtty_color_alist
= intern ("tty-color-alist");
7063 staticpro (&Qtty_color_alist
);
7065 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7066 staticpro (&Vparam_value_alist
);
7067 Vface_alternative_font_family_alist
= Qnil
;
7068 staticpro (&Vface_alternative_font_family_alist
);
7070 defsubr (&Sinternal_make_lisp_face
);
7071 defsubr (&Sinternal_lisp_face_p
);
7072 defsubr (&Sinternal_set_lisp_face_attribute
);
7073 #ifdef HAVE_WINDOW_SYSTEM
7074 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7076 defsubr (&Scolor_gray_p
);
7077 defsubr (&Scolor_supported_p
);
7078 defsubr (&Sinternal_get_lisp_face_attribute
);
7079 defsubr (&Sinternal_lisp_face_attribute_values
);
7080 defsubr (&Sinternal_lisp_face_equal_p
);
7081 defsubr (&Sinternal_lisp_face_empty_p
);
7082 defsubr (&Sinternal_copy_lisp_face
);
7083 defsubr (&Sinternal_merge_in_global_face
);
7084 defsubr (&Sface_font
);
7085 defsubr (&Sframe_face_alist
);
7086 defsubr (&Sinternal_set_font_selection_order
);
7087 defsubr (&Sinternal_set_alternative_font_family_alist
);
7089 defsubr (&Sdump_face
);
7090 defsubr (&Sshow_face_resources
);
7091 #endif /* GLYPH_DEBUG */
7092 defsubr (&Sclear_face_cache
);
7093 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7095 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7096 defsubr (&Sdump_colors
);
7099 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7100 "*Limit for font matching.\n\
7101 If an integer > 0, font matching functions won't load more than\n\
7102 that number of fonts when searching for a matching font.");
7103 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7105 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7106 "List of global face definitions (for internal use only.)");
7107 Vface_new_frame_defaults
= Qnil
;
7109 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7110 "*Default stipple pattern used on monochrome displays.\n\
7111 This stipple pattern is used on monochrome displays\n\
7112 instead of shades of gray for a face background color.\n\
7113 See `set-face-stipple' for possible values for this variable.");
7114 Vface_default_stipple
= build_string ("gray3");
7116 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7117 "An alist of defined terminal colors and their RGB values.");
7118 Vtty_defined_color_alist
= Qnil
;
7120 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7121 "Allowed scalable fonts.\n\
7122 A value of nil means don't allow any scalable fonts.\n\
7123 A value of t means allow any scalable font.\n\
7124 Otherwise, value must be a list of regular expressions. A font may be\n\
7125 scaled if its name matches a regular expression in the list.");
7126 #if defined (WINDOWSNT) || defined (macintosh)
7127 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7128 by default limits the fonts available severely. */
7129 Vscalable_fonts_allowed
= Qt
;
7131 Vscalable_fonts_allowed
= Qnil
;
7134 #ifdef HAVE_WINDOW_SYSTEM
7135 defsubr (&Sbitmap_spec_p
);
7136 defsubr (&Sx_list_fonts
);
7137 defsubr (&Sinternal_face_x_get_resource
);
7138 defsubr (&Sx_family_fonts
);
7139 defsubr (&Sx_font_family_list
);
7140 #endif /* HAVE_WINDOW_SYSTEM */