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 /* Alist of alternative font registries. Each element is of the form
379 (REGISTRY REGISTRY1 REGISTRY2...). If fonts of REGISTRY can't be
380 loaded, try REGISTRY1, then REGISTRY2, ... */
382 Lisp_Object Vface_alternative_font_registry_alist
;
384 /* Allowed scalable fonts. A value of nil means don't allow any
385 scalable fonts. A value of t means allow the use of any scalable
386 font. Otherwise, value must be a list of regular expressions. A
387 font may be scaled if its name matches a regular expression in the
390 Lisp_Object Vscalable_fonts_allowed
;
392 /* Maximum number of fonts to consider in font_list. If not an
393 integer > 0, DEFAULT_FONT_LIST_LIMIT is used instead. */
395 Lisp_Object Vfont_list_limit
;
396 #define DEFAULT_FONT_LIST_LIMIT 100
398 /* The symbols `foreground-color' and `background-color' which can be
399 used as part of a `face' property. This is for compatibility with
402 Lisp_Object Qforeground_color
, Qbackground_color
;
404 /* The symbols `face' and `mouse-face' used as text properties. */
407 extern Lisp_Object Qmouse_face
;
409 /* Error symbol for wrong_type_argument in load_pixmap. */
411 Lisp_Object Qbitmap_spec_p
;
413 /* Alist of global face definitions. Each element is of the form
414 (FACE . LFACE) where FACE is a symbol naming a face and LFACE
415 is a Lisp vector of face attributes. These faces are used
416 to initialize faces for new frames. */
418 Lisp_Object Vface_new_frame_defaults
;
420 /* The next ID to assign to Lisp faces. */
422 static int next_lface_id
;
424 /* A vector mapping Lisp face Id's to face names. */
426 static Lisp_Object
*lface_id_to_name
;
427 static int lface_id_to_name_size
;
429 /* TTY color-related functions (defined in tty-colors.el). */
431 Lisp_Object Qtty_color_desc
, Qtty_color_by_index
;
433 /* The name of the function used to compute colors on TTYs. */
435 Lisp_Object Qtty_color_alist
;
437 /* An alist of defined terminal colors and their RGB values. */
439 Lisp_Object Vtty_defined_color_alist
;
441 /* Counter for calls to clear_face_cache. If this counter reaches
442 CLEAR_FONT_TABLE_COUNT, and a frame has more than
443 CLEAR_FONT_TABLE_NFONTS load, unused fonts are freed. */
445 static int clear_font_table_count
;
446 #define CLEAR_FONT_TABLE_COUNT 100
447 #define CLEAR_FONT_TABLE_NFONTS 10
449 /* Non-zero means face attributes have been changed since the last
450 redisplay. Used in redisplay_internal. */
452 int face_change_count
;
454 /* Incremented for every change in the `menu' face. */
456 int menu_face_change_count
;
458 /* Non-zero means don't display bold text if a face's foreground
459 and background colors are the inverse of the default colors of the
460 display. This is a kluge to suppress `bold black' foreground text
461 which is hard to read on an LCD monitor. */
463 int tty_suppress_bold_inverse_default_colors_p
;
465 /* A list of the form `((x . y))' used to avoid consing in
466 Finternal_set_lisp_face_attribute. */
468 static Lisp_Object Vparam_value_alist
;
470 /* The total number of colors currently allocated. */
473 static int ncolors_allocated
;
474 static int npixmaps_allocated
;
480 /* Function prototypes. */
485 static void map_tty_color
P_ ((struct frame
*, struct face
*,
486 enum lface_attribute_index
, int *));
487 static Lisp_Object resolve_face_name
P_ ((Lisp_Object
));
488 static int may_use_scalable_font_p
P_ ((struct font_name
*, char *));
489 static void set_font_frame_param
P_ ((Lisp_Object
, Lisp_Object
));
490 static int better_font_p
P_ ((int *, struct font_name
*, struct font_name
*,
492 static int first_font_matching
P_ ((struct frame
*f
, char *,
493 struct font_name
*));
494 static int x_face_list_fonts
P_ ((struct frame
*, char *,
495 struct font_name
*, int, int, int));
496 static int font_scalable_p
P_ ((struct font_name
*));
497 static int get_lface_attributes
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
*, int));
498 static int load_pixmap
P_ ((struct frame
*, Lisp_Object
, unsigned *, unsigned *));
499 static unsigned char *xstrlwr
P_ ((unsigned char *));
500 static void signal_error
P_ ((char *, Lisp_Object
));
501 static struct frame
*frame_or_selected_frame
P_ ((Lisp_Object
, int));
502 static void load_face_font
P_ ((struct frame
*, struct face
*, int));
503 static void load_face_colors
P_ ((struct frame
*, struct face
*, Lisp_Object
*));
504 static void free_face_colors
P_ ((struct frame
*, struct face
*));
505 static int face_color_gray_p
P_ ((struct frame
*, char *));
506 static char *build_font_name
P_ ((struct font_name
*));
507 static void free_font_names
P_ ((struct font_name
*, int));
508 static int sorted_font_list
P_ ((struct frame
*, char *,
509 int (*cmpfn
) P_ ((const void *, const void *)),
510 struct font_name
**));
511 static int font_list_1
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
512 Lisp_Object
, struct font_name
**));
513 static int font_list
P_ ((struct frame
*, Lisp_Object
, Lisp_Object
,
514 Lisp_Object
, struct font_name
**));
515 static int try_font_list
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
,
516 Lisp_Object
, Lisp_Object
, struct font_name
**));
517 static int cmp_font_names
P_ ((const void *, const void *));
518 static struct face
*realize_face
P_ ((struct face_cache
*, Lisp_Object
*, int,
519 struct face
*, int));
520 static struct face
*realize_x_face
P_ ((struct face_cache
*,
521 Lisp_Object
*, int, struct face
*));
522 static struct face
*realize_tty_face
P_ ((struct face_cache
*,
523 Lisp_Object
*, int));
524 static int realize_basic_faces
P_ ((struct frame
*));
525 static int realize_default_face
P_ ((struct frame
*));
526 static void realize_named_face
P_ ((struct frame
*, Lisp_Object
, int));
527 static int lface_fully_specified_p
P_ ((Lisp_Object
*));
528 static int lface_equal_p
P_ ((Lisp_Object
*, Lisp_Object
*));
529 static unsigned hash_string_case_insensitive
P_ ((Lisp_Object
));
530 static unsigned lface_hash
P_ ((Lisp_Object
*));
531 static int lface_same_font_attributes_p
P_ ((Lisp_Object
*, Lisp_Object
*));
532 static struct face_cache
*make_face_cache
P_ ((struct frame
*));
533 static void free_realized_face
P_ ((struct frame
*, struct face
*));
534 static void clear_face_gcs
P_ ((struct face_cache
*));
535 static void free_face_cache
P_ ((struct face_cache
*));
536 static int face_numeric_weight
P_ ((Lisp_Object
));
537 static int face_numeric_slant
P_ ((Lisp_Object
));
538 static int face_numeric_swidth
P_ ((Lisp_Object
));
539 static int face_fontset
P_ ((Lisp_Object
*));
540 static char *choose_face_font
P_ ((struct frame
*, Lisp_Object
*, int, int));
541 static void merge_face_vectors
P_ ((struct frame
*, Lisp_Object
*, Lisp_Object
*, Lisp_Object
));
542 static void merge_face_inheritance
P_ ((struct frame
*f
, Lisp_Object
,
543 Lisp_Object
*, Lisp_Object
));
544 static void merge_face_vector_with_property
P_ ((struct frame
*, Lisp_Object
*,
546 static int set_lface_from_font_name
P_ ((struct frame
*, Lisp_Object
,
547 Lisp_Object
, int, int));
548 static Lisp_Object lface_from_face_name
P_ ((struct frame
*, Lisp_Object
, int));
549 static struct face
*make_realized_face
P_ ((Lisp_Object
*));
550 static void free_realized_faces
P_ ((struct face_cache
*));
551 static char *best_matching_font
P_ ((struct frame
*, Lisp_Object
*,
552 struct font_name
*, int));
553 static void cache_face
P_ ((struct face_cache
*, struct face
*, unsigned));
554 static void uncache_face
P_ ((struct face_cache
*, struct face
*));
555 static int xlfd_numeric_slant
P_ ((struct font_name
*));
556 static int xlfd_numeric_weight
P_ ((struct font_name
*));
557 static int xlfd_numeric_swidth
P_ ((struct font_name
*));
558 static Lisp_Object xlfd_symbolic_slant
P_ ((struct font_name
*));
559 static Lisp_Object xlfd_symbolic_weight
P_ ((struct font_name
*));
560 static Lisp_Object xlfd_symbolic_swidth
P_ ((struct font_name
*));
561 static int xlfd_fixed_p
P_ ((struct font_name
*));
562 static int xlfd_numeric_value
P_ ((struct table_entry
*, int, struct font_name
*,
564 static Lisp_Object xlfd_symbolic_value
P_ ((struct table_entry
*, int,
565 struct font_name
*, int,
567 static struct table_entry
*xlfd_lookup_field_contents
P_ ((struct table_entry
*, int,
568 struct font_name
*, int));
570 #ifdef HAVE_WINDOW_SYSTEM
572 static int split_font_name
P_ ((struct frame
*, struct font_name
*, int));
573 static int xlfd_point_size
P_ ((struct frame
*, struct font_name
*));
574 static void sort_fonts
P_ ((struct frame
*, struct font_name
*, int,
575 int (*cmpfn
) P_ ((const void *, const void *))));
576 static GC x_create_gc
P_ ((struct frame
*, unsigned long, XGCValues
*));
577 static void x_free_gc
P_ ((struct frame
*, GC
));
578 static void clear_font_table
P_ ((struct frame
*));
581 extern Lisp_Object w32_list_fonts
P_ ((struct frame
*, Lisp_Object
, int, int));
582 #endif /* WINDOWSNT */
584 #endif /* HAVE_WINDOW_SYSTEM */
587 /***********************************************************************
589 ***********************************************************************/
591 #ifdef HAVE_X_WINDOWS
593 #ifdef DEBUG_X_COLORS
595 /* The following is a poor mans infrastructure for debugging X color
596 allocation problems on displays with PseudoColor-8. Some X servers
597 like 3.3.5 XF86_SVGA with Matrox cards apparently don't implement
598 color reference counts completely so that they don't signal an
599 error when a color is freed whose reference count is already 0.
600 Other X servers do. To help me debug this, the following code
601 implements a simple reference counting schema of its own, for a
602 single display/screen. --gerd. */
604 /* Reference counts for pixel colors. */
606 int color_count
[256];
608 /* Register color PIXEL as allocated. */
611 register_color (pixel
)
614 xassert (pixel
< 256);
615 ++color_count
[pixel
];
619 /* Register color PIXEL as deallocated. */
622 unregister_color (pixel
)
625 xassert (pixel
< 256);
626 if (color_count
[pixel
] > 0)
627 --color_count
[pixel
];
633 /* Register N colors from PIXELS as deallocated. */
636 unregister_colors (pixels
, n
)
637 unsigned long *pixels
;
641 for (i
= 0; i
< n
; ++i
)
642 unregister_color (pixels
[i
]);
646 DEFUN ("dump-colors", Fdump_colors
, Sdump_colors
, 0, 0, 0,
647 "Dump currently allocated colors and their reference counts to stderr.")
652 fputc ('\n', stderr
);
654 for (i
= n
= 0; i
< sizeof color_count
/ sizeof color_count
[0]; ++i
)
657 fprintf (stderr
, "%3d: %5d", i
, color_count
[i
]);
660 fputc ('\n', stderr
);
662 fputc ('\t', stderr
);
666 fputc ('\n', stderr
);
670 #endif /* DEBUG_X_COLORS */
673 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
674 color values. Interrupt input must be blocked when this function
678 x_free_colors (f
, pixels
, npixels
)
680 unsigned long *pixels
;
683 int class = FRAME_X_DISPLAY_INFO (f
)->visual
->class;
685 /* If display has an immutable color map, freeing colors is not
686 necessary and some servers don't allow it. So don't do it. */
687 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
689 XFreeColors (FRAME_X_DISPLAY (f
), FRAME_X_COLORMAP (f
),
691 #ifdef DEBUG_X_COLORS
692 unregister_colors (pixels
, npixels
);
698 /* Free colors used on frame F. PIXELS is an array of NPIXELS pixel
699 color values. Interrupt input must be blocked when this function
703 x_free_dpy_colors (dpy
, screen
, cmap
, pixels
, npixels
)
707 unsigned long *pixels
;
710 struct x_display_info
*dpyinfo
= x_display_info_for_display (dpy
);
711 int class = dpyinfo
->visual
->class;
713 /* If display has an immutable color map, freeing colors is not
714 necessary and some servers don't allow it. So don't do it. */
715 if (class != StaticColor
&& class != StaticGray
&& class != TrueColor
)
717 XFreeColors (dpy
, cmap
, pixels
, npixels
, 0);
718 #ifdef DEBUG_X_COLORS
719 unregister_colors (pixels
, npixels
);
725 /* Create and return a GC for use on frame F. GC values and mask
726 are given by XGCV and MASK. */
729 x_create_gc (f
, mask
, xgcv
)
736 gc
= XCreateGC (FRAME_X_DISPLAY (f
), FRAME_X_WINDOW (f
), mask
, xgcv
);
743 /* Free GC which was used on frame F. */
751 xassert (--ngcs
>= 0);
752 XFreeGC (FRAME_X_DISPLAY (f
), gc
);
756 #endif /* HAVE_X_WINDOWS */
759 /* W32 emulation of GCs */
762 x_create_gc (f
, mask
, xgcv
)
769 gc
= XCreateGC (NULL
, FRAME_W32_WINDOW (f
), mask
, xgcv
);
776 /* Free GC which was used on frame F. */
784 xassert (--ngcs
>= 0);
789 #endif /* WINDOWSNT */
791 /* Like stricmp. Used to compare parts of font names which are in
796 unsigned char *s1
, *s2
;
800 unsigned char c1
= tolower (*s1
);
801 unsigned char c2
= tolower (*s2
);
803 return c1
< c2
? -1 : 1;
808 return *s2
== 0 ? 0 : -1;
813 /* Like strlwr, which might not always be available. */
815 static unsigned char *
819 unsigned char *p
= s
;
828 /* Signal `error' with message S, and additional argument ARG. */
831 signal_error (s
, arg
)
835 Fsignal (Qerror
, Fcons (build_string (s
), Fcons (arg
, Qnil
)));
839 /* If FRAME is nil, return a pointer to the selected frame.
840 Otherwise, check that FRAME is a live frame, and return a pointer
841 to it. NPARAM is the parameter number of FRAME, for
842 CHECK_LIVE_FRAME. This is here because it's a frequent pattern in
843 Lisp function definitions. */
845 static INLINE
struct frame
*
846 frame_or_selected_frame (frame
, nparam
)
851 frame
= selected_frame
;
853 CHECK_LIVE_FRAME (frame
, nparam
);
854 return XFRAME (frame
);
858 /***********************************************************************
860 ***********************************************************************/
862 /* Initialize face cache and basic faces for frame F. */
868 /* Make a face cache, if F doesn't have one. */
869 if (FRAME_FACE_CACHE (f
) == NULL
)
870 FRAME_FACE_CACHE (f
) = make_face_cache (f
);
872 #ifdef HAVE_WINDOW_SYSTEM
873 /* Make the image cache. */
874 if (FRAME_WINDOW_P (f
))
876 if (FRAME_X_IMAGE_CACHE (f
) == NULL
)
877 FRAME_X_IMAGE_CACHE (f
) = make_image_cache ();
878 ++FRAME_X_IMAGE_CACHE (f
)->refcount
;
880 #endif /* HAVE_WINDOW_SYSTEM */
882 /* Realize basic faces. Must have enough information in frame
883 parameters to realize basic faces at this point. */
884 #ifdef HAVE_X_WINDOWS
885 if (!FRAME_X_P (f
) || FRAME_X_WINDOW (f
))
888 if (!FRAME_WINDOW_P (f
) || FRAME_W32_WINDOW (f
))
890 if (!realize_basic_faces (f
))
895 /* Free face cache of frame F. Called from Fdelete_frame. */
901 struct face_cache
*face_cache
= FRAME_FACE_CACHE (f
);
905 free_face_cache (face_cache
);
906 FRAME_FACE_CACHE (f
) = NULL
;
909 #ifdef HAVE_WINDOW_SYSTEM
910 if (FRAME_WINDOW_P (f
))
912 struct image_cache
*image_cache
= FRAME_X_IMAGE_CACHE (f
);
915 --image_cache
->refcount
;
916 if (image_cache
->refcount
== 0)
917 free_image_cache (f
);
920 #endif /* HAVE_WINDOW_SYSTEM */
924 /* Clear face caches, and recompute basic faces for frame F. Call
925 this after changing frame parameters on which those faces depend,
926 or when realized faces have been freed due to changing attributes
930 recompute_basic_faces (f
)
933 if (FRAME_FACE_CACHE (f
))
935 clear_face_cache (0);
936 if (!realize_basic_faces (f
))
942 /* Clear the face caches of all frames. CLEAR_FONTS_P non-zero means
943 try to free unused fonts, too. */
946 clear_face_cache (clear_fonts_p
)
949 #ifdef HAVE_WINDOW_SYSTEM
950 Lisp_Object tail
, frame
;
954 || ++clear_font_table_count
== CLEAR_FONT_TABLE_COUNT
)
956 /* From time to time see if we can unload some fonts. This also
957 frees all realized faces on all frames. Fonts needed by
958 faces will be loaded again when faces are realized again. */
959 clear_font_table_count
= 0;
961 FOR_EACH_FRAME (tail
, frame
)
964 if (FRAME_WINDOW_P (f
)
965 && FRAME_X_DISPLAY_INFO (f
)->n_fonts
> CLEAR_FONT_TABLE_NFONTS
)
967 free_all_realized_faces (frame
);
968 clear_font_table (f
);
974 /* Clear GCs of realized faces. */
975 FOR_EACH_FRAME (tail
, frame
)
978 if (FRAME_WINDOW_P (f
))
980 clear_face_gcs (FRAME_FACE_CACHE (f
));
981 clear_image_cache (f
, 0);
985 #endif /* HAVE_WINDOW_SYSTEM */
989 DEFUN ("clear-face-cache", Fclear_face_cache
, Sclear_face_cache
, 0, 1, 0,
990 "Clear face caches on all frames.\n\
991 Optional THOROUGHLY non-nil means try to free unused fonts, too.")
993 Lisp_Object thorougly
;
995 clear_face_cache (!NILP (thorougly
));
997 ++windows_or_buffers_changed
;
1003 #ifdef HAVE_WINDOW_SYSTEM
1006 /* Remove those fonts from the font table of frame F exept for the
1007 default ASCII font for the frame. Called from clear_face_cache
1008 from time to time. */
1011 clear_font_table (f
)
1014 struct x_display_info
*dpyinfo
= FRAME_X_DISPLAY_INFO (f
);
1017 xassert (FRAME_WINDOW_P (f
));
1019 /* Free those fonts that are not used by the frame F as the default. */
1020 for (i
= 0; i
< dpyinfo
->n_fonts
; ++i
)
1022 struct font_info
*font_info
= dpyinfo
->font_table
+ i
;
1024 if (!font_info
->name
1025 || font_info
->font
== FRAME_FONT (f
))
1029 if (font_info
->full_name
!= font_info
->name
)
1030 xfree (font_info
->full_name
);
1031 xfree (font_info
->name
);
1033 /* Free the font. */
1035 #ifdef HAVE_X_WINDOWS
1036 XFreeFont (dpyinfo
->display
, font_info
->font
);
1039 w32_unload_font (dpyinfo
, font_info
->font
);
1043 /* Mark font table slot free. */
1044 font_info
->font
= NULL
;
1045 font_info
->name
= font_info
->full_name
= NULL
;
1049 #endif /* HAVE_WINDOW_SYSTEM */
1053 /***********************************************************************
1055 ***********************************************************************/
1057 #ifdef HAVE_WINDOW_SYSTEM
1059 DEFUN ("bitmap-spec-p", Fbitmap_spec_p
, Sbitmap_spec_p
, 1, 1, 0,
1060 "Value is non-nil if OBJECT is a valid bitmap specification.\n\
1061 A bitmap specification is either a string, a file name, or a list\n\
1062 (WIDTH HEIGHT DATA) where WIDTH is the pixel width of the bitmap,\n\
1063 HEIGHT is its height, and DATA is a string containing the bits of\n\
1064 the pixmap. Bits are stored row by row, each row occupies\n\
1065 (WIDTH + 7)/8 bytes.")
1071 if (STRINGP (object
))
1072 /* If OBJECT is a string, it's a file name. */
1074 else if (CONSP (object
))
1076 /* Otherwise OBJECT must be (WIDTH HEIGHT DATA), WIDTH and
1077 HEIGHT must be integers > 0, and DATA must be string large
1078 enough to hold a bitmap of the specified size. */
1079 Lisp_Object width
, height
, data
;
1081 height
= width
= data
= Qnil
;
1085 width
= XCAR (object
);
1086 object
= XCDR (object
);
1089 height
= XCAR (object
);
1090 object
= XCDR (object
);
1092 data
= XCAR (object
);
1096 if (NATNUMP (width
) && NATNUMP (height
) && STRINGP (data
))
1098 int bytes_per_row
= ((XFASTINT (width
) + BITS_PER_CHAR
- 1)
1100 if (STRING_BYTES (XSTRING (data
)) >= bytes_per_row
* XINT (height
))
1105 return pixmap_p
? Qt
: Qnil
;
1109 /* Load a bitmap according to NAME (which is either a file name or a
1110 pixmap spec) for use on frame F. Value is the bitmap_id (see
1111 xfns.c). If NAME is nil, return with a bitmap id of zero. If
1112 bitmap cannot be loaded, display a message saying so, and return
1113 zero. Store the bitmap width in *W_PTR and its height in *H_PTR,
1114 if these pointers are not null. */
1117 load_pixmap (f
, name
, w_ptr
, h_ptr
)
1120 unsigned int *w_ptr
, *h_ptr
;
1128 tem
= Fbitmap_spec_p (name
);
1130 wrong_type_argument (Qbitmap_spec_p
, name
);
1135 /* Decode a bitmap spec into a bitmap. */
1140 w
= XINT (Fcar (name
));
1141 h
= XINT (Fcar (Fcdr (name
)));
1142 bits
= Fcar (Fcdr (Fcdr (name
)));
1144 bitmap_id
= x_create_bitmap_from_data (f
, XSTRING (bits
)->data
,
1149 /* It must be a string -- a file name. */
1150 bitmap_id
= x_create_bitmap_from_file (f
, name
);
1156 add_to_log ("Invalid or undefined bitmap %s", name
, Qnil
);
1167 ++npixmaps_allocated
;
1170 *w_ptr
= x_bitmap_width (f
, bitmap_id
);
1173 *h_ptr
= x_bitmap_height (f
, bitmap_id
);
1179 #endif /* HAVE_WINDOW_SYSTEM */
1183 /***********************************************************************
1185 ***********************************************************************/
1187 #ifdef HAVE_WINDOW_SYSTEM
1189 /* Update the line_height of frame F. Return non-zero if line height
1193 frame_update_line_height (f
)
1196 int line_height
, changed_p
;
1198 line_height
= FONT_HEIGHT (FRAME_FONT (f
));
1199 changed_p
= line_height
!= FRAME_LINE_HEIGHT (f
);
1200 FRAME_LINE_HEIGHT (f
) = line_height
;
1204 #endif /* HAVE_WINDOW_SYSTEM */
1207 /***********************************************************************
1209 ***********************************************************************/
1211 #ifdef HAVE_WINDOW_SYSTEM
1213 /* Load font of face FACE which is used on frame F to display
1214 character C. The name of the font to load is determined by lface
1215 and fontset of FACE. */
1218 load_face_font (f
, face
, c
)
1223 struct font_info
*font_info
= NULL
;
1226 face
->font_info_id
= -1;
1229 font_name
= choose_face_font (f
, face
->lface
, face
->fontset
, c
);
1234 font_info
= FS_LOAD_FACE_FONT (f
, c
, font_name
, face
);
1239 face
->font_info_id
= font_info
->font_idx
;
1240 face
->font
= font_info
->font
;
1241 face
->font_name
= font_info
->full_name
;
1244 x_free_gc (f
, face
->gc
);
1249 add_to_log ("Unable to load font %s",
1250 build_string (font_name
), Qnil
);
1254 #endif /* HAVE_WINDOW_SYSTEM */
1258 /***********************************************************************
1260 ***********************************************************************/
1262 /* A version of defined_color for non-X frames. */
1265 tty_defined_color (f
, color_name
, color_def
, alloc
)
1271 Lisp_Object color_desc
;
1272 unsigned long color_idx
= FACE_TTY_DEFAULT_COLOR
;
1273 unsigned long red
= 0, green
= 0, blue
= 0;
1276 if (*color_name
&& !NILP (Ffboundp (Qtty_color_desc
)))
1280 XSETFRAME (frame
, f
);
1282 color_desc
= call2 (Qtty_color_desc
, build_string (color_name
), frame
);
1283 if (CONSP (color_desc
) && CONSP (XCDR (color_desc
)))
1285 color_idx
= XINT (XCAR (XCDR (color_desc
)));
1286 if (CONSP (XCDR (XCDR (color_desc
))))
1288 red
= XINT (XCAR (XCDR (XCDR (color_desc
))));
1289 green
= XINT (XCAR (XCDR (XCDR (XCDR (color_desc
)))));
1290 blue
= XINT (XCAR (XCDR (XCDR (XCDR (XCDR (color_desc
))))));
1294 else if (NILP (Fsymbol_value (intern ("tty-defined-color-alist"))))
1295 /* We were called early during startup, and the colors are not
1296 yet set up in tty-defined-color-alist. Don't return a failure
1297 indication, since this produces the annoying "Unable to
1298 load color" messages in the *Messages* buffer. */
1301 if (color_idx
== FACE_TTY_DEFAULT_COLOR
&& *color_name
)
1303 if (strcmp (color_name
, "unspecified-fg") == 0)
1304 color_idx
= FACE_TTY_DEFAULT_FG_COLOR
;
1305 else if (strcmp (color_name
, "unspecified-bg") == 0)
1306 color_idx
= FACE_TTY_DEFAULT_BG_COLOR
;
1309 if (color_idx
!= FACE_TTY_DEFAULT_COLOR
)
1312 color_def
->pixel
= color_idx
;
1313 color_def
->red
= red
;
1314 color_def
->green
= green
;
1315 color_def
->blue
= blue
;
1321 /* Decide if color named COLOR_NAME is valid for the display
1322 associated with the frame F; if so, return the rgb values in
1323 COLOR_DEF. If ALLOC is nonzero, allocate a new colormap cell.
1325 This does the right thing for any type of frame. */
1328 defined_color (f
, color_name
, color_def
, alloc
)
1334 if (!FRAME_WINDOW_P (f
))
1335 return tty_defined_color (f
, color_name
, color_def
, alloc
);
1336 #ifdef HAVE_X_WINDOWS
1337 else if (FRAME_X_P (f
))
1338 return x_defined_color (f
, color_name
, color_def
, alloc
);
1341 else if (FRAME_W32_P (f
))
1342 return w32_defined_color (f
, color_name
, color_def
, alloc
);
1345 else if (FRAME_MAC_P (f
))
1346 return mac_defined_color (f
, color_name
, color_def
, alloc
);
1353 /* Given the index IDX of a tty color on frame F, return its name, a
1357 tty_color_name (f
, idx
)
1361 if (idx
>= 0 && !NILP (Ffboundp (Qtty_color_by_index
)))
1364 Lisp_Object coldesc
;
1366 XSETFRAME (frame
, f
);
1367 coldesc
= call2 (Qtty_color_by_index
, make_number (idx
), frame
);
1369 if (!NILP (coldesc
))
1370 return XCAR (coldesc
);
1373 /* We can have an MSDOG frame under -nw for a short window of
1374 opportunity before internal_terminal_init is called. DTRT. */
1375 if (FRAME_MSDOS_P (f
) && !inhibit_window_system
)
1376 return msdos_stdcolor_name (idx
);
1379 if (idx
== FACE_TTY_DEFAULT_FG_COLOR
)
1380 return build_string (unspecified_fg
);
1381 if (idx
== FACE_TTY_DEFAULT_BG_COLOR
)
1382 return build_string (unspecified_bg
);
1385 return vga_stdcolor_name (idx
);
1388 return Qunspecified
;
1392 /* Return non-zero if COLOR_NAME is a shade of gray (or white or
1393 black) on frame F. The algorithm is taken from 20.2 faces.el. */
1396 face_color_gray_p (f
, color_name
)
1403 if (defined_color (f
, color_name
, &color
, 0))
1404 gray_p
= ((abs (color
.red
- color
.green
)
1405 < max (color
.red
, color
.green
) / 20)
1406 && (abs (color
.green
- color
.blue
)
1407 < max (color
.green
, color
.blue
) / 20)
1408 && (abs (color
.blue
- color
.red
)
1409 < max (color
.blue
, color
.red
) / 20));
1417 /* Return non-zero if color COLOR_NAME can be displayed on frame F.
1418 BACKGROUND_P non-zero means the color will be used as background
1422 face_color_supported_p (f
, color_name
, background_p
)
1430 XSETFRAME (frame
, f
);
1431 return (FRAME_WINDOW_P (f
)
1432 ? (!NILP (Fxw_display_color_p (frame
))
1433 || xstricmp (color_name
, "black") == 0
1434 || xstricmp (color_name
, "white") == 0
1436 && face_color_gray_p (f
, color_name
))
1437 || (!NILP (Fx_display_grayscale_p (frame
))
1438 && face_color_gray_p (f
, color_name
)))
1439 : tty_defined_color (f
, color_name
, ¬_used
, 0));
1443 DEFUN ("color-gray-p", Fcolor_gray_p
, Scolor_gray_p
, 1, 2, 0,
1444 "Return non-nil if COLOR is a shade of gray (or white or black).\n\
1445 FRAME specifies the frame and thus the display for interpreting COLOR.\n\
1446 If FRAME is nil or omitted, use the selected frame.")
1448 Lisp_Object color
, frame
;
1452 CHECK_FRAME (frame
, 0);
1453 CHECK_STRING (color
, 0);
1455 return face_color_gray_p (f
, XSTRING (color
)->data
) ? Qt
: Qnil
;
1459 DEFUN ("color-supported-p", Fcolor_supported_p
,
1460 Scolor_supported_p
, 2, 3, 0,
1461 "Return non-nil if COLOR can be displayed on FRAME.\n\
1462 BACKGROUND-P non-nil means COLOR is used as a background.\n\
1463 If FRAME is nil or omitted, use the selected frame.\n\
1464 COLOR must be a valid color name.")
1465 (color
, frame
, background_p
)
1466 Lisp_Object frame
, color
, background_p
;
1470 CHECK_FRAME (frame
, 0);
1471 CHECK_STRING (color
, 0);
1473 if (face_color_supported_p (f
, XSTRING (color
)->data
, !NILP (background_p
)))
1479 /* Load color with name NAME for use by face FACE on frame F.
1480 TARGET_INDEX must be one of LFACE_FOREGROUND_INDEX,
1481 LFACE_BACKGROUND_INDEX, LFACE_UNDERLINE_INDEX, LFACE_OVERLINE_INDEX,
1482 LFACE_STRIKE_THROUGH_INDEX, or LFACE_BOX_INDEX. Value is the
1483 pixel color. If color cannot be loaded, display a message, and
1484 return the foreground, background or underline color of F, but
1485 record that fact in flags of the face so that we don't try to free
1489 load_color (f
, face
, name
, target_index
)
1493 enum lface_attribute_index target_index
;
1497 xassert (STRINGP (name
));
1498 xassert (target_index
== LFACE_FOREGROUND_INDEX
1499 || target_index
== LFACE_BACKGROUND_INDEX
1500 || target_index
== LFACE_UNDERLINE_INDEX
1501 || target_index
== LFACE_OVERLINE_INDEX
1502 || target_index
== LFACE_STRIKE_THROUGH_INDEX
1503 || target_index
== LFACE_BOX_INDEX
);
1505 /* if the color map is full, defined_color will return a best match
1506 to the values in an existing cell. */
1507 if (!defined_color (f
, XSTRING (name
)->data
, &color
, 1))
1509 add_to_log ("Unable to load color \"%s\"", name
, Qnil
);
1511 switch (target_index
)
1513 case LFACE_FOREGROUND_INDEX
:
1514 face
->foreground_defaulted_p
= 1;
1515 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1518 case LFACE_BACKGROUND_INDEX
:
1519 face
->background_defaulted_p
= 1;
1520 color
.pixel
= FRAME_BACKGROUND_PIXEL (f
);
1523 case LFACE_UNDERLINE_INDEX
:
1524 face
->underline_defaulted_p
= 1;
1525 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1528 case LFACE_OVERLINE_INDEX
:
1529 face
->overline_color_defaulted_p
= 1;
1530 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1533 case LFACE_STRIKE_THROUGH_INDEX
:
1534 face
->strike_through_color_defaulted_p
= 1;
1535 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1538 case LFACE_BOX_INDEX
:
1539 face
->box_color_defaulted_p
= 1;
1540 color
.pixel
= FRAME_FOREGROUND_PIXEL (f
);
1549 ++ncolors_allocated
;
1556 #ifdef HAVE_WINDOW_SYSTEM
1558 /* Load colors for face FACE which is used on frame F. Colors are
1559 specified by slots LFACE_BACKGROUND_INDEX and LFACE_FOREGROUND_INDEX
1560 of ATTRS. If the background color specified is not supported on F,
1561 try to emulate gray colors with a stipple from Vface_default_stipple. */
1564 load_face_colors (f
, face
, attrs
)
1571 bg
= attrs
[LFACE_BACKGROUND_INDEX
];
1572 fg
= attrs
[LFACE_FOREGROUND_INDEX
];
1574 /* Swap colors if face is inverse-video. */
1575 if (EQ (attrs
[LFACE_INVERSE_INDEX
], Qt
))
1583 /* Check for support for foreground, not for background because
1584 face_color_supported_p is smart enough to know that grays are
1585 "supported" as background because we are supposed to use stipple
1587 if (!face_color_supported_p (f
, XSTRING (bg
)->data
, 0)
1588 && !NILP (Fbitmap_spec_p (Vface_default_stipple
)))
1590 x_destroy_bitmap (f
, face
->stipple
);
1591 face
->stipple
= load_pixmap (f
, Vface_default_stipple
,
1592 &face
->pixmap_w
, &face
->pixmap_h
);
1595 face
->background
= load_color (f
, face
, bg
, LFACE_BACKGROUND_INDEX
);
1596 face
->foreground
= load_color (f
, face
, fg
, LFACE_FOREGROUND_INDEX
);
1600 /* Free color PIXEL on frame F. */
1603 unload_color (f
, pixel
)
1605 unsigned long pixel
;
1607 #ifdef HAVE_X_WINDOWS
1609 x_free_colors (f
, &pixel
, 1);
1615 /* Free colors allocated for FACE. */
1618 free_face_colors (f
, face
)
1622 #ifdef HAVE_X_WINDOWS
1625 if (!face
->foreground_defaulted_p
)
1627 x_free_colors (f
, &face
->foreground
, 1);
1628 IF_DEBUG (--ncolors_allocated
);
1631 if (!face
->background_defaulted_p
)
1633 x_free_colors (f
, &face
->background
, 1);
1634 IF_DEBUG (--ncolors_allocated
);
1637 if (face
->underline_p
1638 && !face
->underline_defaulted_p
)
1640 x_free_colors (f
, &face
->underline_color
, 1);
1641 IF_DEBUG (--ncolors_allocated
);
1644 if (face
->overline_p
1645 && !face
->overline_color_defaulted_p
)
1647 x_free_colors (f
, &face
->overline_color
, 1);
1648 IF_DEBUG (--ncolors_allocated
);
1651 if (face
->strike_through_p
1652 && !face
->strike_through_color_defaulted_p
)
1654 x_free_colors (f
, &face
->strike_through_color
, 1);
1655 IF_DEBUG (--ncolors_allocated
);
1658 if (face
->box
!= FACE_NO_BOX
1659 && !face
->box_color_defaulted_p
)
1661 x_free_colors (f
, &face
->box_color
, 1);
1662 IF_DEBUG (--ncolors_allocated
);
1666 #endif /* HAVE_X_WINDOWS */
1669 #endif /* HAVE_WINDOW_SYSTEM */
1673 /***********************************************************************
1675 ***********************************************************************/
1677 /* An enumerator for each field of an XLFD font name. */
1698 /* An enumerator for each possible slant value of a font. Taken from
1699 the XLFD specification. */
1707 XLFD_SLANT_REVERSE_ITALIC
,
1708 XLFD_SLANT_REVERSE_OBLIQUE
,
1712 /* Relative font weight according to XLFD documentation. */
1716 XLFD_WEIGHT_UNKNOWN
,
1717 XLFD_WEIGHT_ULTRA_LIGHT
, /* 10 */
1718 XLFD_WEIGHT_EXTRA_LIGHT
, /* 20 */
1719 XLFD_WEIGHT_LIGHT
, /* 30 */
1720 XLFD_WEIGHT_SEMI_LIGHT
, /* 40: SemiLight, Book, ... */
1721 XLFD_WEIGHT_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1722 XLFD_WEIGHT_SEMI_BOLD
, /* 60: SemiBold, DemiBold, ... */
1723 XLFD_WEIGHT_BOLD
, /* 70: Bold, ... */
1724 XLFD_WEIGHT_EXTRA_BOLD
, /* 80: ExtraBold, Heavy, ... */
1725 XLFD_WEIGHT_ULTRA_BOLD
/* 90: UltraBold, Black, ... */
1728 /* Relative proportionate width. */
1732 XLFD_SWIDTH_UNKNOWN
,
1733 XLFD_SWIDTH_ULTRA_CONDENSED
, /* 10 */
1734 XLFD_SWIDTH_EXTRA_CONDENSED
, /* 20 */
1735 XLFD_SWIDTH_CONDENSED
, /* 30: Condensed, Narrow, Compressed, ... */
1736 XLFD_SWIDTH_SEMI_CONDENSED
, /* 40: semicondensed */
1737 XLFD_SWIDTH_MEDIUM
, /* 50: Medium, Normal, Regular, ... */
1738 XLFD_SWIDTH_SEMI_EXPANDED
, /* 60: SemiExpanded, DemiExpanded, ... */
1739 XLFD_SWIDTH_EXPANDED
, /* 70: Expanded... */
1740 XLFD_SWIDTH_EXTRA_EXPANDED
, /* 80: ExtraExpanded, Wide... */
1741 XLFD_SWIDTH_ULTRA_EXPANDED
/* 90: UltraExpanded... */
1744 /* Structure used for tables mapping XLFD weight, slant, and width
1745 names to numeric and symbolic values. */
1751 Lisp_Object
*symbol
;
1754 /* Table of XLFD slant names and their numeric and symbolic
1755 representations. This table must be sorted by slant names in
1758 static struct table_entry slant_table
[] =
1760 {"i", XLFD_SLANT_ITALIC
, &Qitalic
},
1761 {"o", XLFD_SLANT_OBLIQUE
, &Qoblique
},
1762 {"ot", XLFD_SLANT_OTHER
, &Qitalic
},
1763 {"r", XLFD_SLANT_ROMAN
, &Qnormal
},
1764 {"ri", XLFD_SLANT_REVERSE_ITALIC
, &Qreverse_italic
},
1765 {"ro", XLFD_SLANT_REVERSE_OBLIQUE
, &Qreverse_oblique
}
1768 /* Table of XLFD weight names. This table must be sorted by weight
1769 names in ascending order. */
1771 static struct table_entry weight_table
[] =
1773 {"black", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
},
1774 {"bold", XLFD_WEIGHT_BOLD
, &Qbold
},
1775 {"book", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1776 {"demi", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1777 {"demibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1778 {"extralight", XLFD_WEIGHT_EXTRA_LIGHT
, &Qextra_light
},
1779 {"extrabold", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1780 {"heavy", XLFD_WEIGHT_EXTRA_BOLD
, &Qextra_bold
},
1781 {"light", XLFD_WEIGHT_LIGHT
, &Qlight
},
1782 {"medium", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1783 {"normal", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1784 {"regular", XLFD_WEIGHT_MEDIUM
, &Qnormal
},
1785 {"semibold", XLFD_WEIGHT_SEMI_BOLD
, &Qsemi_bold
},
1786 {"semilight", XLFD_WEIGHT_SEMI_LIGHT
, &Qsemi_light
},
1787 {"ultralight", XLFD_WEIGHT_ULTRA_LIGHT
, &Qultra_light
},
1788 {"ultrabold", XLFD_WEIGHT_ULTRA_BOLD
, &Qultra_bold
}
1791 /* Table of XLFD width names. This table must be sorted by width
1792 names in ascending order. */
1794 static struct table_entry swidth_table
[] =
1796 {"compressed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1797 {"condensed", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1798 {"demiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1799 {"expanded", XLFD_SWIDTH_EXPANDED
, &Qexpanded
},
1800 {"extracondensed", XLFD_SWIDTH_EXTRA_CONDENSED
, &Qextra_condensed
},
1801 {"extraexpanded", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
},
1802 {"medium", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1803 {"narrow", XLFD_SWIDTH_CONDENSED
, &Qcondensed
},
1804 {"normal", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1805 {"regular", XLFD_SWIDTH_MEDIUM
, &Qnormal
},
1806 {"semicondensed", XLFD_SWIDTH_SEMI_CONDENSED
, &Qsemi_condensed
},
1807 {"semiexpanded", XLFD_SWIDTH_SEMI_EXPANDED
, &Qsemi_expanded
},
1808 {"ultracondensed", XLFD_SWIDTH_ULTRA_CONDENSED
, &Qultra_condensed
},
1809 {"ultraexpanded", XLFD_SWIDTH_ULTRA_EXPANDED
, &Qultra_expanded
},
1810 {"wide", XLFD_SWIDTH_EXTRA_EXPANDED
, &Qextra_expanded
}
1813 /* Structure used to hold the result of splitting font names in XLFD
1814 format into their fields. */
1818 /* The original name which is modified destructively by
1819 split_font_name. The pointer is kept here to be able to free it
1820 if it was allocated from the heap. */
1823 /* Font name fields. Each vector element points into `name' above.
1824 Fields are NUL-terminated. */
1825 char *fields
[XLFD_LAST
];
1827 /* Numeric values for those fields that interest us. See
1828 split_font_name for which these are. */
1829 int numeric
[XLFD_LAST
];
1832 /* The frame in effect when sorting font names. Set temporarily in
1833 sort_fonts so that it is available in font comparison functions. */
1835 static struct frame
*font_frame
;
1837 /* Order by which font selection chooses fonts. The default values
1838 mean `first, find a best match for the font width, then for the
1839 font height, then for weight, then for slant.' This variable can be
1840 set via set-face-font-sort-order. */
1843 static int font_sort_order
[4] = { XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
};
1845 static int font_sort_order
[4];
1848 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1849 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1850 is a pointer to the matching table entry or null if no table entry
1853 static struct table_entry
*
1854 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1855 struct table_entry
*table
;
1857 struct font_name
*font
;
1860 /* Function split_font_name converts fields to lower-case, so there
1861 is no need to use xstrlwr or xstricmp here. */
1862 char *s
= font
->fields
[field_index
];
1863 int low
, mid
, high
, cmp
;
1870 mid
= (low
+ high
) / 2;
1871 cmp
= strcmp (table
[mid
].name
, s
);
1885 /* Return a numeric representation for font name field
1886 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1887 has DIM entries. Value is the numeric value found or DFLT if no
1888 table entry matches. This function is used to translate weight,
1889 slant, and swidth names of XLFD font names to numeric values. */
1892 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1893 struct table_entry
*table
;
1895 struct font_name
*font
;
1899 struct table_entry
*p
;
1900 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1901 return p
? p
->numeric
: dflt
;
1905 /* Return a symbolic representation for font name field
1906 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1907 has DIM entries. Value is the symbolic value found or DFLT if no
1908 table entry matches. This function is used to translate weight,
1909 slant, and swidth names of XLFD font names to symbols. */
1911 static INLINE Lisp_Object
1912 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1913 struct table_entry
*table
;
1915 struct font_name
*font
;
1919 struct table_entry
*p
;
1920 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1921 return p
? *p
->symbol
: dflt
;
1925 /* Return a numeric value for the slant of the font given by FONT. */
1928 xlfd_numeric_slant (font
)
1929 struct font_name
*font
;
1931 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1932 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1936 /* Return a symbol representing the weight of the font given by FONT. */
1938 static INLINE Lisp_Object
1939 xlfd_symbolic_slant (font
)
1940 struct font_name
*font
;
1942 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1943 font
, XLFD_SLANT
, Qnormal
);
1947 /* Return a numeric value for the weight of the font given by FONT. */
1950 xlfd_numeric_weight (font
)
1951 struct font_name
*font
;
1953 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1954 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1958 /* Return a symbol representing the slant of the font given by FONT. */
1960 static INLINE Lisp_Object
1961 xlfd_symbolic_weight (font
)
1962 struct font_name
*font
;
1964 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1965 font
, XLFD_WEIGHT
, Qnormal
);
1969 /* Return a numeric value for the swidth of the font whose XLFD font
1970 name fields are found in FONT. */
1973 xlfd_numeric_swidth (font
)
1974 struct font_name
*font
;
1976 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1977 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1981 /* Return a symbolic value for the swidth of FONT. */
1983 static INLINE Lisp_Object
1984 xlfd_symbolic_swidth (font
)
1985 struct font_name
*font
;
1987 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1988 font
, XLFD_SWIDTH
, Qnormal
);
1992 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1993 entries. Value is a pointer to the matching table entry or null if
1994 no element of TABLE contains SYMBOL. */
1996 static struct table_entry
*
1997 face_value (table
, dim
, symbol
)
1998 struct table_entry
*table
;
2004 xassert (SYMBOLP (symbol
));
2006 for (i
= 0; i
< dim
; ++i
)
2007 if (EQ (*table
[i
].symbol
, symbol
))
2010 return i
< dim
? table
+ i
: NULL
;
2014 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2015 entries. Value is -1 if SYMBOL is not found in TABLE. */
2018 face_numeric_value (table
, dim
, symbol
)
2019 struct table_entry
*table
;
2023 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2024 return p
? p
->numeric
: -1;
2028 /* Return a numeric value representing the weight specified by Lisp
2029 symbol WEIGHT. Value is one of the enumerators of enum
2033 face_numeric_weight (weight
)
2036 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2040 /* Return a numeric value representing the slant specified by Lisp
2041 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2044 face_numeric_slant (slant
)
2047 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2051 /* Return a numeric value representing the swidth specified by Lisp
2052 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2055 face_numeric_swidth (width
)
2058 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2062 #ifdef HAVE_WINDOW_SYSTEM
2064 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2068 struct font_name
*font
;
2070 /* Function split_font_name converts fields to lower-case, so there
2071 is no need to use tolower here. */
2072 return *font
->fields
[XLFD_SPACING
] != 'p';
2076 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2078 The actual height of the font when displayed on F depends on the
2079 resolution of both the font and frame. For example, a 10pt font
2080 designed for a 100dpi display will display larger than 10pt on a
2081 75dpi display. (It's not unusual to use fonts not designed for the
2082 display one is using. For example, some intlfonts are available in
2083 72dpi versions, only.)
2085 Value is the real point size of FONT on frame F, or 0 if it cannot
2089 xlfd_point_size (f
, font
)
2091 struct font_name
*font
;
2093 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2094 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2095 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2098 if (font_resy
== 0 || font_pt
== 0)
2101 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2107 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2108 of frame F. This function is used to guess a point size of font
2109 when only the pixel height of the font is available. */
2112 pixel_point_size (f
, pixel
)
2116 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2120 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2121 real_pt
= pixel
* 72 / resy
;
2122 int_pt
= real_pt
+ 0.5;
2128 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2129 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2130 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2131 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2132 zero if the font name doesn't have the format we expect. The
2133 expected format is a font name that starts with a `-' and has
2134 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2135 forms of font names where certain field contents are enclosed in
2136 square brackets. We don't support that, for now. */
2139 split_font_name (f
, font
, numeric_p
)
2141 struct font_name
*font
;
2147 if (*font
->name
== '-')
2149 char *p
= xstrlwr (font
->name
) + 1;
2151 while (i
< XLFD_LAST
)
2153 font
->fields
[i
] = p
;
2156 while (*p
&& *p
!= '-')
2166 success_p
= i
== XLFD_LAST
;
2168 /* If requested, and font name was in the expected format,
2169 compute numeric values for some fields. */
2170 if (numeric_p
&& success_p
)
2172 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2173 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2174 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2175 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2176 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2183 /* Build an XLFD font name from font name fields in FONT. Value is a
2184 pointer to the font name, which is allocated via xmalloc. */
2187 build_font_name (font
)
2188 struct font_name
*font
;
2192 char *font_name
= (char *) xmalloc (size
);
2193 int total_length
= 0;
2195 for (i
= 0; i
< XLFD_LAST
; ++i
)
2197 /* Add 1 because of the leading `-'. */
2198 int len
= strlen (font
->fields
[i
]) + 1;
2200 /* Reallocate font_name if necessary. Add 1 for the final
2202 if (total_length
+ len
+ 1 >= size
)
2204 int new_size
= max (2 * size
, size
+ len
+ 1);
2205 int sz
= new_size
* sizeof *font_name
;
2206 font_name
= (char *) xrealloc (font_name
, sz
);
2210 font_name
[total_length
] = '-';
2211 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2212 total_length
+= len
;
2215 font_name
[total_length
] = 0;
2220 /* Free an array FONTS of N font_name structures. This frees FONTS
2221 itself and all `name' fields in its elements. */
2224 free_font_names (fonts
, n
)
2225 struct font_name
*fonts
;
2229 xfree (fonts
[--n
].name
);
2234 /* Sort vector FONTS of font_name structures which contains NFONTS
2235 elements using qsort and comparison function CMPFN. F is the frame
2236 on which the fonts will be used. The global variable font_frame
2237 is temporarily set to F to make it available in CMPFN. */
2240 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2242 struct font_name
*fonts
;
2244 int (*cmpfn
) P_ ((const void *, const void *));
2247 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2252 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2253 display in x_display_list. FONTS is a pointer to a vector of
2254 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2255 alternative patterns from Valternate_fontname_alist if no fonts are
2256 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2259 For all fonts found, set FONTS[i].name to the name of the font,
2260 allocated via xmalloc, and split font names into fields. Ignore
2261 fonts that we can't parse. Value is the number of fonts found.
2263 This is similar to x_list_fonts. The differences are:
2265 1. It avoids consing.
2266 2. It never calls XLoadQueryFont. */
2269 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2273 struct font_name
*fonts
;
2274 int nfonts
, try_alternatives_p
;
2275 int scalable_fonts_p
;
2279 #ifdef HAVE_X_WINDOWS
2280 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2282 /* Get the list of fonts matching PATTERN from the X server. */
2284 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2286 #endif /* HAVE_X_WINDOWS */
2287 #if defined (WINDOWSNT) || defined (macintosh)
2288 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2289 better to do it the other way around. */
2291 Lisp_Object lpattern
, tem
;
2296 lpattern
= build_string (pattern
);
2298 /* Get the list of fonts matching PATTERN. */
2301 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2302 #else /* macintosh */
2303 lfonts
= x_list_fonts (f
, lpattern
, 0, nfonts
);
2307 /* Count fonts returned */
2308 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2311 /* Allocate array. */
2313 names
= (char **) xmalloc (n
* sizeof (char *));
2315 /* Extract font names into char * array. */
2317 for (i
= 0; i
< n
; i
++)
2319 names
[i
] = XSTRING (XCAR (tem
))->data
;
2322 #endif /* defined (WINDOWSNT) || defined (macintosh) */
2326 /* Make a copy of the font names we got from X, and
2327 split them into fields. */
2328 for (i
= j
= 0; i
< n
; ++i
)
2330 /* Make a copy of the font name. */
2331 fonts
[j
].name
= xstrdup (names
[i
]);
2333 /* Ignore fonts having a name that we can't parse. */
2334 if (!split_font_name (f
, fonts
+ j
, 1))
2335 xfree (fonts
[j
].name
);
2336 else if (font_scalable_p (fonts
+ j
))
2338 if (!scalable_fonts_p
2339 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2340 xfree (fonts
[j
].name
);
2350 #ifdef HAVE_X_WINDOWS
2351 /* Free font names. */
2353 XFreeFontNames (names
);
2359 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2360 if (n
== 0 && try_alternatives_p
)
2362 Lisp_Object list
= Valternate_fontname_alist
;
2364 while (CONSP (list
))
2366 Lisp_Object entry
= XCAR (list
);
2368 && STRINGP (XCAR (entry
))
2369 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2376 Lisp_Object patterns
= XCAR (list
);
2379 while (CONSP (patterns
)
2380 /* If list is screwed up, give up. */
2381 && (name
= XCAR (patterns
),
2383 /* Ignore patterns equal to PATTERN because we tried that
2384 already with no success. */
2385 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2386 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2390 patterns
= XCDR (patterns
);
2398 /* Determine the first font matching PATTERN on frame F. Return in
2399 *FONT the matching font name, split into fields. Value is non-zero
2400 if a match was found. */
2403 first_font_matching (f
, pattern
, font
)
2406 struct font_name
*font
;
2409 struct font_name
*fonts
;
2411 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2412 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2416 bcopy (&fonts
[0], font
, sizeof *font
);
2418 fonts
[0].name
= NULL
;
2419 free_font_names (fonts
, nfonts
);
2426 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2427 using comparison function CMPFN. Value is the number of fonts
2428 found. If value is non-zero, *FONTS is set to a vector of
2429 font_name structures allocated from the heap containing matching
2430 fonts. Each element of *FONTS contains a name member that is also
2431 allocated from the heap. Font names in these structures are split
2432 into fields. Use free_font_names to free such an array. */
2435 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2438 int (*cmpfn
) P_ ((const void *, const void *));
2439 struct font_name
**fonts
;
2443 /* Get the list of fonts matching pattern. 100 should suffice. */
2444 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2445 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2446 nfonts
= XFASTINT (Vfont_list_limit
);
2448 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2449 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2451 /* Sort the resulting array and return it in *FONTS. If no
2452 fonts were found, make sure to set *FONTS to null. */
2454 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2465 /* Compare two font_name structures *A and *B. Value is analogous to
2466 strcmp. Sort order is given by the global variable
2467 font_sort_order. Font names are sorted so that, everything else
2468 being equal, fonts with a resolution closer to that of the frame on
2469 which they are used are listed first. The global variable
2470 font_frame is the frame on which we operate. */
2473 cmp_font_names (a
, b
)
2476 struct font_name
*x
= (struct font_name
*) a
;
2477 struct font_name
*y
= (struct font_name
*) b
;
2480 /* All strings have been converted to lower-case by split_font_name,
2481 so we can use strcmp here. */
2482 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2487 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2489 int j
= font_sort_order
[i
];
2490 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2495 /* Everything else being equal, we prefer fonts with an
2496 y-resolution closer to that of the frame. */
2497 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2498 int x_resy
= x
->numeric
[XLFD_RESY
];
2499 int y_resy
= y
->numeric
[XLFD_RESY
];
2500 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2508 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2509 is non-nil list fonts matching that pattern. Otherwise, if
2510 REGISTRY is non-nil return only fonts with that registry, otherwise
2511 return fonts of any registry. Set *FONTS to a vector of font_name
2512 structures allocated from the heap containing the fonts found.
2513 Value is the number of fonts found. */
2516 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2518 Lisp_Object pattern
, family
, registry
;
2519 struct font_name
**fonts
;
2521 char *pattern_str
, *family_str
, *registry_str
;
2525 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2526 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2528 pattern_str
= (char *) alloca (strlen (family_str
)
2529 + strlen (registry_str
)
2531 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2532 strcat (pattern_str
, family_str
);
2533 strcat (pattern_str
, "-*-");
2534 strcat (pattern_str
, registry_str
);
2535 if (!index (registry_str
, '-'))
2537 if (registry_str
[strlen (registry_str
) - 1] == '*')
2538 strcat (pattern_str
, "-*");
2540 strcat (pattern_str
, "*-*");
2544 pattern_str
= (char *) XSTRING (pattern
)->data
;
2546 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2550 /* Get a sorted list of fonts of family FAMILY on frame F.
2552 If PATTERN is non-nil list fonts matching that pattern.
2554 If REGISTRY is non-nil, retur fonts with that registry. If none
2555 are found, try alternative registries from
2556 Vface_alternative_font_registry_alist.
2558 If REGISTRY is nil return fonts of any registry.
2560 Set *FONTS to a vector of font_name structures allocated from the
2561 heap containing the fonts found. Value is the number of fonts
2565 font_list (f
, pattern
, family
, registry
, fonts
)
2567 Lisp_Object pattern
, family
, registry
;
2568 struct font_name
**fonts
;
2570 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2574 && CONSP (Vface_alternative_font_registry_alist
))
2578 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2581 for (alter
= XCDR (alter
);
2582 CONSP (alter
) && nfonts
== 0;
2583 alter
= XCDR (alter
))
2584 if (STRINGP (XCAR (alter
)))
2585 nfonts
= font_list_1 (f
, pattern
, family
, XCAR (alter
), fonts
);
2593 /* Remove elements from LIST whose cars are `equal'. Called from
2594 x-family-fonts and x-font-family-list to remove duplicate font
2598 remove_duplicates (list
)
2601 Lisp_Object tail
= list
;
2603 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2605 Lisp_Object next
= XCDR (tail
);
2606 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2607 XCDR (tail
) = XCDR (next
);
2614 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2615 "Return a list of available fonts of family FAMILY on FRAME.\n\
2616 If FAMILY is omitted or nil, list all families.\n\
2617 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2619 If FRAME is omitted or nil, use the selected frame.\n\
2620 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2621 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2622 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2623 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2624 width, weight and slant of the font. These symbols are the same as for\n\
2625 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2626 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2627 giving the registry and encoding of the font.\n\
2628 The result list is sorted according to the current setting of\n\
2629 the face font sort order.")
2631 Lisp_Object family
, frame
;
2633 struct frame
*f
= check_x_frame (frame
);
2634 struct font_name
*fonts
;
2637 struct gcpro gcpro1
;
2640 CHECK_STRING (family
, 1);
2644 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2645 for (i
= nfonts
- 1; i
>= 0; --i
)
2647 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2650 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2651 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2652 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2653 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2654 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2655 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2656 tem
= build_font_name (fonts
+ i
);
2657 ASET (v
, 6, build_string (tem
));
2658 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2659 fonts
[i
].fields
[XLFD_ENCODING
]);
2660 ASET (v
, 7, build_string (tem
));
2663 result
= Fcons (v
, result
);
2666 remove_duplicates (result
);
2667 free_font_names (fonts
, nfonts
);
2673 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2675 "Return a list of available font families on FRAME.\n\
2676 If FRAME is omitted or nil, use the selected frame.\n\
2677 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2678 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2683 struct frame
*f
= check_x_frame (frame
);
2685 struct font_name
*fonts
;
2687 struct gcpro gcpro1
;
2688 int count
= specpdl_ptr
- specpdl
;
2691 /* Let's consider all fonts. Increase the limit for matching
2692 fonts until we have them all. */
2695 specbind (intern ("font-list-limit"), make_number (limit
));
2696 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2698 if (nfonts
== limit
)
2700 free_font_names (fonts
, nfonts
);
2709 for (i
= nfonts
- 1; i
>= 0; --i
)
2710 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2711 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2714 remove_duplicates (result
);
2715 free_font_names (fonts
, nfonts
);
2717 return unbind_to (count
, result
);
2721 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2722 "Return a list of the names of available fonts matching PATTERN.\n\
2723 If optional arguments FACE and FRAME are specified, return only fonts\n\
2724 the same size as FACE on FRAME.\n\
2725 PATTERN is a string, perhaps with wildcard characters;\n\
2726 the * character matches any substring, and\n\
2727 the ? character matches any single character.\n\
2728 PATTERN is case-insensitive.\n\
2729 FACE is a face name--a symbol.\n\
2731 The return value is a list of strings, suitable as arguments to\n\
2734 Fonts Emacs can't use may or may not be excluded\n\
2735 even if they match PATTERN and FACE.\n\
2736 The optional fourth argument MAXIMUM sets a limit on how many\n\
2737 fonts to match. The first MAXIMUM fonts are reported.\n\
2738 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2739 occupied by a character of a font. In that case, return only fonts\n\
2740 the WIDTH times as wide as FACE on FRAME.")
2741 (pattern
, face
, frame
, maximum
, width
)
2742 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2749 CHECK_STRING (pattern
, 0);
2755 CHECK_NATNUM (maximum
, 0);
2756 maxnames
= XINT (maximum
);
2760 CHECK_NUMBER (width
, 4);
2762 /* We can't simply call check_x_frame because this function may be
2763 called before any frame is created. */
2764 f
= frame_or_selected_frame (frame
, 2);
2765 if (!FRAME_WINDOW_P (f
))
2767 /* Perhaps we have not yet created any frame. */
2772 /* Determine the width standard for comparison with the fonts we find. */
2778 /* This is of limited utility since it works with character
2779 widths. Keep it for compatibility. --gerd. */
2780 int face_id
= lookup_named_face (f
, face
, 0);
2781 struct face
*face
= (face_id
< 0
2783 : FACE_FROM_ID (f
, face_id
));
2785 if (face
&& face
->font
)
2786 size
= FONT_WIDTH (face
->font
);
2788 size
= FONT_WIDTH (FRAME_FONT (f
));
2791 size
*= XINT (width
);
2795 Lisp_Object args
[2];
2797 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2799 /* We don't have to check fontsets. */
2801 args
[1] = list_fontsets (f
, pattern
, size
);
2802 return Fnconc (2, args
);
2806 #endif /* HAVE_WINDOW_SYSTEM */
2810 /***********************************************************************
2812 ***********************************************************************/
2814 /* Access face attributes of face FACE, a Lisp vector. */
2816 #define LFACE_FAMILY(LFACE) \
2817 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2818 #define LFACE_HEIGHT(LFACE) \
2819 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2820 #define LFACE_WEIGHT(LFACE) \
2821 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2822 #define LFACE_SLANT(LFACE) \
2823 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2824 #define LFACE_UNDERLINE(LFACE) \
2825 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2826 #define LFACE_INVERSE(LFACE) \
2827 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2828 #define LFACE_FOREGROUND(LFACE) \
2829 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2830 #define LFACE_BACKGROUND(LFACE) \
2831 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2832 #define LFACE_STIPPLE(LFACE) \
2833 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2834 #define LFACE_SWIDTH(LFACE) \
2835 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2836 #define LFACE_OVERLINE(LFACE) \
2837 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2838 #define LFACE_STRIKE_THROUGH(LFACE) \
2839 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2840 #define LFACE_BOX(LFACE) \
2841 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2842 #define LFACE_FONT(LFACE) \
2843 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2844 #define LFACE_INHERIT(LFACE) \
2845 XVECTOR (LFACE)->contents[LFACE_INHERIT_INDEX]
2847 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2848 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2850 #define LFACEP(LFACE) \
2852 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2853 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2858 /* Check consistency of Lisp face attribute vector ATTRS. */
2861 check_lface_attrs (attrs
)
2864 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2865 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2866 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2867 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2868 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2869 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2870 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2871 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2872 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2873 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2874 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2875 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2876 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2877 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2878 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2879 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2880 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2881 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2882 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2883 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2884 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2885 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2886 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2887 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2888 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2889 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2890 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2891 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2892 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2893 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2894 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2895 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2896 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2897 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2898 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2899 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2900 #ifdef HAVE_WINDOW_SYSTEM
2901 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2902 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2903 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2904 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2905 || NILP (attrs
[LFACE_FONT_INDEX
])
2906 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2911 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2919 xassert (LFACEP (lface
));
2920 check_lface_attrs (XVECTOR (lface
)->contents
);
2924 #else /* GLYPH_DEBUG == 0 */
2926 #define check_lface_attrs(attrs) (void) 0
2927 #define check_lface(lface) (void) 0
2929 #endif /* GLYPH_DEBUG == 0 */
2932 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2933 to make it a symvol. If FACE_NAME is an alias for another face,
2934 return that face's name. */
2937 resolve_face_name (face_name
)
2938 Lisp_Object face_name
;
2940 Lisp_Object aliased
;
2942 if (STRINGP (face_name
))
2943 face_name
= intern (XSTRING (face_name
)->data
);
2945 while (SYMBOLP (face_name
))
2947 aliased
= Fget (face_name
, Qface_alias
);
2951 face_name
= aliased
;
2958 /* Return the face definition of FACE_NAME on frame F. F null means
2959 return the definition for new frames. FACE_NAME may be a string or
2960 a symbol (apparently Emacs 20.2 allowed strings as face names in
2961 face text properties; Ediff uses that). If FACE_NAME is an alias
2962 for another face, return that face's definition. If SIGNAL_P is
2963 non-zero, signal an error if FACE_NAME is not a valid face name.
2964 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
2967 static INLINE Lisp_Object
2968 lface_from_face_name (f
, face_name
, signal_p
)
2970 Lisp_Object face_name
;
2975 face_name
= resolve_face_name (face_name
);
2978 lface
= assq_no_quit (face_name
, f
->face_alist
);
2980 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
2983 lface
= XCDR (lface
);
2985 signal_error ("Invalid face", face_name
);
2987 check_lface (lface
);
2992 /* Get face attributes of face FACE_NAME from frame-local faces on
2993 frame F. Store the resulting attributes in ATTRS which must point
2994 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
2995 is non-zero, signal an error if FACE_NAME does not name a face.
2996 Otherwise, value is zero if FACE_NAME is not a face. */
2999 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3001 Lisp_Object face_name
;
3008 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3011 bcopy (XVECTOR (lface
)->contents
, attrs
,
3012 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3022 /* Non-zero if all attributes in face attribute vector ATTRS are
3023 specified, i.e. are non-nil. */
3026 lface_fully_specified_p (attrs
)
3031 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3032 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
3033 if (UNSPECIFIEDP (attrs
[i
]))
3036 return i
== LFACE_VECTOR_SIZE
;
3039 #ifdef HAVE_WINDOW_SYSTEM
3041 /* Set font-related attributes of Lisp face LFACE from the fullname of
3042 the font opened by FONTNAME. If FORCE_P is zero, set only
3043 unspecified attributes of LFACE. The exception is `font'
3044 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3046 If FONTNAME is not available on frame F,
3047 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3048 If the fullname is not in a valid XLFD format,
3049 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3050 in LFACE and return 1.
3051 Otherwise, return 1. */
3054 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3057 Lisp_Object fontname
;
3058 int force_p
, may_fail_p
;
3060 struct font_name font
;
3065 char *font_name
= XSTRING (fontname
)->data
;
3066 struct font_info
*font_info
;
3068 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3069 fontset
= fs_query_fontset (fontname
, 0);
3071 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3073 /* Check if FONT_NAME is surely available on the system. Usually
3074 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3075 returns quickly. But, even if FONT_NAME is not yet cached,
3076 caching it now is not futail because we anyway load the font
3079 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3089 font
.name
= STRDUPA (font_info
->full_name
);
3090 have_xlfd_p
= split_font_name (f
, &font
, 1);
3092 /* Set attributes only if unspecified, otherwise face defaults for
3093 new frames would never take effect. If we couldn't get a font
3094 name conforming to XLFD, set normal values. */
3096 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3101 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3102 + strlen (font
.fields
[XLFD_FOUNDRY
])
3104 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3105 font
.fields
[XLFD_FAMILY
]);
3106 val
= build_string (buffer
);
3109 val
= build_string ("*");
3110 LFACE_FAMILY (lface
) = val
;
3113 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3116 pt
= xlfd_point_size (f
, &font
);
3118 pt
= pixel_point_size (f
, font_info
->height
* 10);
3120 LFACE_HEIGHT (lface
) = make_number (pt
);
3123 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3124 LFACE_SWIDTH (lface
)
3125 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3127 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3128 LFACE_WEIGHT (lface
)
3129 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3131 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3133 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3135 LFACE_FONT (lface
) = fontname
;
3140 #endif /* HAVE_WINDOW_SYSTEM */
3143 /* Merges the face height FROM with the face height TO, and returns the
3144 merged height. If FROM is an invalid height, then INVALID is
3145 returned instead. FROM may be a either an absolute face height or a
3146 `relative' height, and TO must be an absolute height. The returned
3147 value is always an absolute height. GCPRO is a lisp value that will
3148 be protected from garbage-collection if this function makes a call
3152 merge_face_heights (from
, to
, invalid
, gcpro
)
3153 Lisp_Object from
, to
, invalid
, gcpro
;
3157 if (INTEGERP (from
))
3158 result
= XINT (from
);
3159 else if (NUMBERP (from
))
3160 result
= XFLOATINT (from
) * XINT (to
);
3161 #if 0 /* Probably not so useful. */
3162 else if (CONSP (from
) && CONSP (XCDR (from
)))
3164 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3166 if (INTEGERP (XCAR (XCDR (from
))))
3168 int inc
= XINT (XCAR (XCDR (from
)));
3169 if (EQ (XCAR (from
), Qminus
))
3172 result
= XFASTINT (to
);
3173 if (result
+ inc
> 0)
3174 /* Note that `underflows' don't mean FROM is invalid, so
3175 we just pin the result at TO if it would otherwise be
3182 else if (FUNCTIONP (from
))
3184 /* Call function with current height as argument.
3185 From is the new height. */
3186 Lisp_Object args
[2], height
;
3187 struct gcpro gcpro1
;
3193 height
= safe_call (2, args
);
3197 if (NUMBERP (height
))
3198 result
= XFLOATINT (height
);
3202 return make_number (result
);
3208 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3209 store the resulting attributes in TO, which must be already be
3210 completely specified and contain only absolute attributes. Every
3211 specified attribute of FROM overrides the corresponding attribute of
3212 TO; relative attributes in FROM are merged with the absolute value in
3213 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3214 face inheritance; it should be Qnil when called from other places. */
3217 merge_face_vectors (f
, from
, to
, cycle_check
)
3219 Lisp_Object
*from
, *to
;
3220 Lisp_Object cycle_check
;
3224 /* If FROM inherits from some other faces, merge their attributes into
3225 TO before merging FROM's direct attributes. Note that an :inherit
3226 attribute of `unspecified' is the same as one of nil; we never
3227 merge :inherit attributes, so nil is more correct, but lots of
3228 other code uses `unspecified' as a generic value for face attributes. */
3229 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3230 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3231 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3233 /* If TO specifies a :font attribute, and FROM specifies some
3234 font-related attribute, we need to clear TO's :font attribute
3235 (because it will be inconsistent with whatever FROM specifies, and
3236 FROM takes precedence). */
3237 if (!NILP (to
[LFACE_FONT_INDEX
])
3238 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3239 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3240 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3241 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3242 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])))
3243 to
[LFACE_FONT_INDEX
] = Qnil
;
3245 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3246 if (!UNSPECIFIEDP (from
[i
]))
3247 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3248 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3252 /* TO is always an absolute face, which should inherit from nothing.
3253 We blindly copy the :inherit attribute above and fix it up here. */
3254 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3258 /* Checks the `cycle check' variable CHECK to see if it indicates that
3259 EL is part of a cycle; CHECK must be either Qnil or a value returned
3260 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3261 elements after which a cycle might be suspected; after that many
3262 elements, this macro begins consing in order to keep more precise
3265 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3268 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3269 the caller should make sure that's ok. */
3271 #define CYCLE_CHECK(check, el, suspicious) \
3274 : (INTEGERP (check) \
3275 ? (XFASTINT (check) < (suspicious) \
3276 ? make_number (XFASTINT (check) + 1) \
3277 : Fcons (el, Qnil)) \
3278 : (!NILP (Fmemq ((el), (check))) \
3280 : Fcons ((el), (check)))))
3283 /* Merge face attributes from the face on frame F whose name is
3284 INHERITS, into the vector of face attributes TO; INHERITS may also be
3285 a list of face names, in which case they are applied in order.
3286 CYCLE_CHECK is used to detect loops in face inheritance.
3287 Returns true if any of the inherited attributes are `font-related'. */
3290 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3292 Lisp_Object inherit
;
3294 Lisp_Object cycle_check
;
3296 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3297 /* Inherit from the named face INHERIT. */
3301 /* Make sure we're not in an inheritance loop. */
3302 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3303 if (NILP (cycle_check
))
3304 /* Cycle detected, ignore any further inheritance. */
3307 lface
= lface_from_face_name (f
, inherit
, 0);
3309 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3311 else if (CONSP (inherit
))
3312 /* Handle a list of inherited faces by calling ourselves recursively
3313 on each element. Note that we only do so for symbol elements, so
3314 it's not possible to infinitely recurse. */
3316 while (CONSP (inherit
))
3318 if (SYMBOLP (XCAR (inherit
)))
3319 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3321 /* Check for a circular inheritance list. */
3322 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3323 if (NILP (cycle_check
))
3324 /* Cycle detected. */
3327 inherit
= XCDR (inherit
);
3333 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3334 is a face property, determine the resulting face attributes on
3335 frame F, and store them in TO. PROP may be a single face
3336 specification or a list of such specifications. Each face
3337 specification can be
3339 1. A symbol or string naming a Lisp face.
3341 2. A property list of the form (KEYWORD VALUE ...) where each
3342 KEYWORD is a face attribute name, and value is an appropriate value
3345 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3346 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3347 for compatibility with 20.2.
3349 Face specifications earlier in lists take precedence over later
3353 merge_face_vector_with_property (f
, to
, prop
)
3360 Lisp_Object first
= XCAR (prop
);
3362 if (EQ (first
, Qforeground_color
)
3363 || EQ (first
, Qbackground_color
))
3365 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3366 . COLOR). COLOR must be a string. */
3367 Lisp_Object color_name
= XCDR (prop
);
3368 Lisp_Object color
= first
;
3370 if (STRINGP (color_name
))
3372 if (EQ (color
, Qforeground_color
))
3373 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3375 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3378 add_to_log ("Invalid face color", color_name
, Qnil
);
3380 else if (SYMBOLP (first
)
3381 && *XSYMBOL (first
)->name
->data
== ':')
3383 /* Assume this is the property list form. */
3384 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3386 Lisp_Object keyword
= XCAR (prop
);
3387 Lisp_Object value
= XCAR (XCDR (prop
));
3389 if (EQ (keyword
, QCfamily
))
3391 if (STRINGP (value
))
3392 to
[LFACE_FAMILY_INDEX
] = value
;
3394 add_to_log ("Invalid face font family", value
, Qnil
);
3396 else if (EQ (keyword
, QCheight
))
3398 Lisp_Object new_height
=
3399 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3402 if (NILP (new_height
))
3403 add_to_log ("Invalid face font height", value
, Qnil
);
3405 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3407 else if (EQ (keyword
, QCweight
))
3410 && face_numeric_weight (value
) >= 0)
3411 to
[LFACE_WEIGHT_INDEX
] = value
;
3413 add_to_log ("Invalid face weight", value
, Qnil
);
3415 else if (EQ (keyword
, QCslant
))
3418 && face_numeric_slant (value
) >= 0)
3419 to
[LFACE_SLANT_INDEX
] = value
;
3421 add_to_log ("Invalid face slant", value
, Qnil
);
3423 else if (EQ (keyword
, QCunderline
))
3428 to
[LFACE_UNDERLINE_INDEX
] = value
;
3430 add_to_log ("Invalid face underline", value
, Qnil
);
3432 else if (EQ (keyword
, QCoverline
))
3437 to
[LFACE_OVERLINE_INDEX
] = value
;
3439 add_to_log ("Invalid face overline", value
, Qnil
);
3441 else if (EQ (keyword
, QCstrike_through
))
3446 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3448 add_to_log ("Invalid face strike-through", value
, Qnil
);
3450 else if (EQ (keyword
, QCbox
))
3453 value
= make_number (1);
3454 if (INTEGERP (value
)
3458 to
[LFACE_BOX_INDEX
] = value
;
3460 add_to_log ("Invalid face box", value
, Qnil
);
3462 else if (EQ (keyword
, QCinverse_video
)
3463 || EQ (keyword
, QCreverse_video
))
3465 if (EQ (value
, Qt
) || NILP (value
))
3466 to
[LFACE_INVERSE_INDEX
] = value
;
3468 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3470 else if (EQ (keyword
, QCforeground
))
3472 if (STRINGP (value
))
3473 to
[LFACE_FOREGROUND_INDEX
] = value
;
3475 add_to_log ("Invalid face foreground", value
, Qnil
);
3477 else if (EQ (keyword
, QCbackground
))
3479 if (STRINGP (value
))
3480 to
[LFACE_BACKGROUND_INDEX
] = value
;
3482 add_to_log ("Invalid face background", value
, Qnil
);
3484 else if (EQ (keyword
, QCstipple
))
3486 #ifdef HAVE_X_WINDOWS
3487 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3488 if (!NILP (pixmap_p
))
3489 to
[LFACE_STIPPLE_INDEX
] = value
;
3491 add_to_log ("Invalid face stipple", value
, Qnil
);
3494 else if (EQ (keyword
, QCwidth
))
3497 && face_numeric_swidth (value
) >= 0)
3498 to
[LFACE_SWIDTH_INDEX
] = value
;
3500 add_to_log ("Invalid face width", value
, Qnil
);
3502 else if (EQ (keyword
, QCinherit
))
3504 if (SYMBOLP (value
))
3505 to
[LFACE_INHERIT_INDEX
] = value
;
3509 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3510 if (!SYMBOLP (XCAR (tail
)))
3513 to
[LFACE_INHERIT_INDEX
] = value
;
3515 add_to_log ("Invalid face inherit", value
, Qnil
);
3519 add_to_log ("Invalid attribute %s in face property",
3522 prop
= XCDR (XCDR (prop
));
3527 /* This is a list of face specs. Specifications at the
3528 beginning of the list take precedence over later
3529 specifications, so we have to merge starting with the
3530 last specification. */
3531 Lisp_Object next
= XCDR (prop
);
3533 merge_face_vector_with_property (f
, to
, next
);
3534 merge_face_vector_with_property (f
, to
, first
);
3539 /* PROP ought to be a face name. */
3540 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3542 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3544 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3549 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3550 Sinternal_make_lisp_face
, 1, 2, 0,
3551 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3552 If FACE was not known as a face before, create a new one.\n\
3553 If optional argument FRAME is specified, make a frame-local face\n\
3554 for that frame. Otherwise operate on the global face definition.\n\
3555 Value is a vector of face attributes.")
3557 Lisp_Object face
, frame
;
3559 Lisp_Object global_lface
, lface
;
3563 CHECK_SYMBOL (face
, 0);
3564 global_lface
= lface_from_face_name (NULL
, face
, 0);
3568 CHECK_LIVE_FRAME (frame
, 1);
3570 lface
= lface_from_face_name (f
, face
, 0);
3573 f
= NULL
, lface
= Qnil
;
3575 /* Add a global definition if there is none. */
3576 if (NILP (global_lface
))
3578 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3580 XVECTOR (global_lface
)->contents
[0] = Qface
;
3581 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3582 Vface_new_frame_defaults
);
3584 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3585 face id to Lisp face is given by the vector lface_id_to_name.
3586 The mapping from Lisp face to Lisp face id is given by the
3587 property `face' of the Lisp face name. */
3588 if (next_lface_id
== lface_id_to_name_size
)
3590 int new_size
= max (50, 2 * lface_id_to_name_size
);
3591 int sz
= new_size
* sizeof *lface_id_to_name
;
3592 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3593 lface_id_to_name_size
= new_size
;
3596 lface_id_to_name
[next_lface_id
] = face
;
3597 Fput (face
, Qface
, make_number (next_lface_id
));
3601 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3602 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3604 /* Add a frame-local definition. */
3609 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3611 XVECTOR (lface
)->contents
[0] = Qface
;
3612 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3615 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3616 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3619 lface
= global_lface
;
3621 xassert (LFACEP (lface
));
3622 check_lface (lface
);
3627 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3628 Sinternal_lisp_face_p
, 1, 2, 0,
3629 "Return non-nil if FACE names a face.\n\
3630 If optional second parameter FRAME is non-nil, check for the\n\
3631 existence of a frame-local face with name FACE on that frame.\n\
3632 Otherwise check for the existence of a global face.")
3634 Lisp_Object face
, frame
;
3640 CHECK_LIVE_FRAME (frame
, 1);
3641 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3644 lface
= lface_from_face_name (NULL
, face
, 0);
3650 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3651 Sinternal_copy_lisp_face
, 4, 4, 0,
3652 "Copy face FROM to TO.\n\
3653 If FRAME it t, copy the global face definition of FROM to the\n\
3654 global face definition of TO. Otherwise, copy the frame-local\n\
3655 definition of FROM on FRAME to the frame-local definition of TO\n\
3656 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3659 (from
, to
, frame
, new_frame
)
3660 Lisp_Object from
, to
, frame
, new_frame
;
3662 Lisp_Object lface
, copy
;
3664 CHECK_SYMBOL (from
, 0);
3665 CHECK_SYMBOL (to
, 1);
3666 if (NILP (new_frame
))
3671 /* Copy global definition of FROM. We don't make copies of
3672 strings etc. because 20.2 didn't do it either. */
3673 lface
= lface_from_face_name (NULL
, from
, 1);
3674 copy
= Finternal_make_lisp_face (to
, Qnil
);
3678 /* Copy frame-local definition of FROM. */
3679 CHECK_LIVE_FRAME (frame
, 2);
3680 CHECK_LIVE_FRAME (new_frame
, 3);
3681 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3682 copy
= Finternal_make_lisp_face (to
, new_frame
);
3685 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3686 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3692 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3693 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3694 "Set attribute ATTR of FACE to VALUE.\n\
3695 FRAME being a frame means change the face on that frame.\n\
3696 FRAME nil means change change the face of the selected frame.\n\
3697 FRAME t means change the default for new frames.\n\
3698 FRAME 0 means change the face on all frames, and change the default\n\
3700 (face
, attr
, value
, frame
)
3701 Lisp_Object face
, attr
, value
, frame
;
3704 Lisp_Object old_value
= Qnil
;
3705 /* Set 1 if ATTR is QCfont. */
3706 int font_attr_p
= 0;
3707 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3708 int font_related_attr_p
= 0;
3710 CHECK_SYMBOL (face
, 0);
3711 CHECK_SYMBOL (attr
, 1);
3713 face
= resolve_face_name (face
);
3715 /* If FRAME is 0, change face on all frames, and change the
3716 default for new frames. */
3717 if (INTEGERP (frame
) && XINT (frame
) == 0)
3720 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3721 FOR_EACH_FRAME (tail
, frame
)
3722 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3726 /* Set lface to the Lisp attribute vector of FACE. */
3728 lface
= lface_from_face_name (NULL
, face
, 1);
3732 frame
= selected_frame
;
3734 CHECK_LIVE_FRAME (frame
, 3);
3735 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3737 /* If a frame-local face doesn't exist yet, create one. */
3739 lface
= Finternal_make_lisp_face (face
, frame
);
3742 if (EQ (attr
, QCfamily
))
3744 if (!UNSPECIFIEDP (value
))
3746 CHECK_STRING (value
, 3);
3747 if (XSTRING (value
)->size
== 0)
3748 signal_error ("Invalid face family", value
);
3750 old_value
= LFACE_FAMILY (lface
);
3751 LFACE_FAMILY (lface
) = value
;
3752 font_related_attr_p
= 1;
3754 else if (EQ (attr
, QCheight
))
3756 if (!UNSPECIFIEDP (value
))
3759 (EQ (face
, Qdefault
) ? value
:
3760 /* The default face must have an absolute size, otherwise, we do
3761 a test merge with a random height to see if VALUE's ok. */
3762 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3764 if (!INTEGERP(test
) || XINT(test
) <= 0)
3765 signal_error ("Invalid face height", value
);
3768 old_value
= LFACE_HEIGHT (lface
);
3769 LFACE_HEIGHT (lface
) = value
;
3770 font_related_attr_p
= 1;
3772 else if (EQ (attr
, QCweight
))
3774 if (!UNSPECIFIEDP (value
))
3776 CHECK_SYMBOL (value
, 3);
3777 if (face_numeric_weight (value
) < 0)
3778 signal_error ("Invalid face weight", value
);
3780 old_value
= LFACE_WEIGHT (lface
);
3781 LFACE_WEIGHT (lface
) = value
;
3782 font_related_attr_p
= 1;
3784 else if (EQ (attr
, QCslant
))
3786 if (!UNSPECIFIEDP (value
))
3788 CHECK_SYMBOL (value
, 3);
3789 if (face_numeric_slant (value
) < 0)
3790 signal_error ("Invalid face slant", value
);
3792 old_value
= LFACE_SLANT (lface
);
3793 LFACE_SLANT (lface
) = value
;
3794 font_related_attr_p
= 1;
3796 else if (EQ (attr
, QCunderline
))
3798 if (!UNSPECIFIEDP (value
))
3799 if ((SYMBOLP (value
)
3801 && !EQ (value
, Qnil
))
3802 /* Underline color. */
3804 && XSTRING (value
)->size
== 0))
3805 signal_error ("Invalid face underline", value
);
3807 old_value
= LFACE_UNDERLINE (lface
);
3808 LFACE_UNDERLINE (lface
) = value
;
3810 else if (EQ (attr
, QCoverline
))
3812 if (!UNSPECIFIEDP (value
))
3813 if ((SYMBOLP (value
)
3815 && !EQ (value
, Qnil
))
3816 /* Overline color. */
3818 && XSTRING (value
)->size
== 0))
3819 signal_error ("Invalid face overline", value
);
3821 old_value
= LFACE_OVERLINE (lface
);
3822 LFACE_OVERLINE (lface
) = value
;
3824 else if (EQ (attr
, QCstrike_through
))
3826 if (!UNSPECIFIEDP (value
))
3827 if ((SYMBOLP (value
)
3829 && !EQ (value
, Qnil
))
3830 /* Strike-through color. */
3832 && XSTRING (value
)->size
== 0))
3833 signal_error ("Invalid face strike-through", value
);
3835 old_value
= LFACE_STRIKE_THROUGH (lface
);
3836 LFACE_STRIKE_THROUGH (lface
) = value
;
3838 else if (EQ (attr
, QCbox
))
3842 /* Allow t meaning a simple box of width 1 in foreground color
3845 value
= make_number (1);
3847 if (UNSPECIFIEDP (value
))
3849 else if (NILP (value
))
3851 else if (INTEGERP (value
))
3852 valid_p
= XINT (value
) > 0;
3853 else if (STRINGP (value
))
3854 valid_p
= XSTRING (value
)->size
> 0;
3855 else if (CONSP (value
))
3871 if (EQ (k
, QCline_width
))
3873 if (!INTEGERP (v
) || XINT (v
) <= 0)
3876 else if (EQ (k
, QCcolor
))
3878 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3881 else if (EQ (k
, QCstyle
))
3883 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3890 valid_p
= NILP (tem
);
3896 signal_error ("Invalid face box", value
);
3898 old_value
= LFACE_BOX (lface
);
3899 LFACE_BOX (lface
) = value
;
3901 else if (EQ (attr
, QCinverse_video
)
3902 || EQ (attr
, QCreverse_video
))
3904 if (!UNSPECIFIEDP (value
))
3906 CHECK_SYMBOL (value
, 3);
3907 if (!EQ (value
, Qt
) && !NILP (value
))
3908 signal_error ("Invalid inverse-video face attribute value", value
);
3910 old_value
= LFACE_INVERSE (lface
);
3911 LFACE_INVERSE (lface
) = value
;
3913 else if (EQ (attr
, QCforeground
))
3915 if (!UNSPECIFIEDP (value
))
3917 /* Don't check for valid color names here because it depends
3918 on the frame (display) whether the color will be valid
3919 when the face is realized. */
3920 CHECK_STRING (value
, 3);
3921 if (XSTRING (value
)->size
== 0)
3922 signal_error ("Empty foreground color value", value
);
3924 old_value
= LFACE_FOREGROUND (lface
);
3925 LFACE_FOREGROUND (lface
) = value
;
3927 else if (EQ (attr
, QCbackground
))
3929 if (!UNSPECIFIEDP (value
))
3931 /* Don't check for valid color names here because it depends
3932 on the frame (display) whether the color will be valid
3933 when the face is realized. */
3934 CHECK_STRING (value
, 3);
3935 if (XSTRING (value
)->size
== 0)
3936 signal_error ("Empty background color value", value
);
3938 old_value
= LFACE_BACKGROUND (lface
);
3939 LFACE_BACKGROUND (lface
) = value
;
3941 else if (EQ (attr
, QCstipple
))
3943 #ifdef HAVE_X_WINDOWS
3944 if (!UNSPECIFIEDP (value
)
3946 && NILP (Fbitmap_spec_p (value
)))
3947 signal_error ("Invalid stipple attribute", value
);
3948 old_value
= LFACE_STIPPLE (lface
);
3949 LFACE_STIPPLE (lface
) = value
;
3950 #endif /* HAVE_X_WINDOWS */
3952 else if (EQ (attr
, QCwidth
))
3954 if (!UNSPECIFIEDP (value
))
3956 CHECK_SYMBOL (value
, 3);
3957 if (face_numeric_swidth (value
) < 0)
3958 signal_error ("Invalid face width", value
);
3960 old_value
= LFACE_SWIDTH (lface
);
3961 LFACE_SWIDTH (lface
) = value
;
3962 font_related_attr_p
= 1;
3964 else if (EQ (attr
, QCfont
))
3966 #ifdef HAVE_WINDOW_SYSTEM
3967 /* Set font-related attributes of the Lisp face from an
3972 CHECK_STRING (value
, 3);
3974 f
= SELECTED_FRAME ();
3976 f
= check_x_frame (frame
);
3978 /* VALUE may be a fontset name or an alias of fontset. In such
3979 a case, use the base fontset name. */
3980 tmp
= Fquery_fontset (value
, Qnil
);
3984 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
3985 signal_error ("Invalid font or fontset name", value
);
3988 #endif /* HAVE_WINDOW_SYSTEM */
3990 else if (EQ (attr
, QCinherit
))
3993 if (SYMBOLP (value
))
3996 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3997 if (!SYMBOLP (XCAR (tail
)))
4000 LFACE_INHERIT (lface
) = value
;
4002 signal_error ("Invalid face inheritance", value
);
4004 else if (EQ (attr
, QCbold
))
4006 old_value
= LFACE_WEIGHT (lface
);
4007 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4008 font_related_attr_p
= 1;
4010 else if (EQ (attr
, QCitalic
))
4012 old_value
= LFACE_SLANT (lface
);
4013 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4014 font_related_attr_p
= 1;
4017 signal_error ("Invalid face attribute name", attr
);
4019 if (font_related_attr_p
4020 && !UNSPECIFIEDP (value
))
4021 /* If a font-related attribute other than QCfont is specified, the
4022 original `font' attribute nor that of default face is useless
4023 to determine a new font. Thus, we set it to nil so that font
4024 selection mechanism doesn't use it. */
4025 LFACE_FONT (lface
) = Qnil
;
4027 /* Changing a named face means that all realized faces depending on
4028 that face are invalid. Since we cannot tell which realized faces
4029 depend on the face, make sure they are all removed. This is done
4030 by incrementing face_change_count. The next call to
4031 init_iterator will then free realized faces. */
4033 && (EQ (attr
, QCfont
)
4034 || NILP (Fequal (old_value
, value
))))
4036 ++face_change_count
;
4037 ++windows_or_buffers_changed
;
4040 #ifdef HAVE_WINDOW_SYSTEM
4043 && !UNSPECIFIEDP (value
)
4044 && NILP (Fequal (old_value
, value
)))
4050 if (EQ (face
, Qdefault
))
4052 /* Changed font-related attributes of the `default' face are
4053 reflected in changed `font' frame parameters. */
4054 if ((font_related_attr_p
|| font_attr_p
)
4055 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4056 set_font_frame_param (frame
, lface
);
4057 else if (EQ (attr
, QCforeground
))
4058 param
= Qforeground_color
;
4059 else if (EQ (attr
, QCbackground
))
4060 param
= Qbackground_color
;
4063 else if (EQ (face
, Qscroll_bar
))
4065 /* Changing the colors of `scroll-bar' sets frame parameters
4066 `scroll-bar-foreground' and `scroll-bar-background'. */
4067 if (EQ (attr
, QCforeground
))
4068 param
= Qscroll_bar_foreground
;
4069 else if (EQ (attr
, QCbackground
))
4070 param
= Qscroll_bar_background
;
4072 #endif /* not WINDOWSNT */
4073 else if (EQ (face
, Qborder
))
4075 /* Changing background color of `border' sets frame parameter
4077 if (EQ (attr
, QCbackground
))
4078 param
= Qborder_color
;
4080 else if (EQ (face
, Qcursor
))
4082 /* Changing background color of `cursor' sets frame parameter
4084 if (EQ (attr
, QCbackground
))
4085 param
= Qcursor_color
;
4087 else if (EQ (face
, Qmouse
))
4089 /* Changing background color of `mouse' sets frame parameter
4091 if (EQ (attr
, QCbackground
))
4092 param
= Qmouse_color
;
4094 else if (EQ (face
, Qmenu
))
4095 ++menu_face_change_count
;
4100 cons
= XCAR (Vparam_value_alist
);
4101 XCAR (cons
) = param
;
4102 XCDR (cons
) = value
;
4103 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4107 #endif /* HAVE_WINDOW_SYSTEM */
4113 #ifdef HAVE_WINDOW_SYSTEM
4115 /* Set the `font' frame parameter of FRAME determined from `default'
4116 face attributes LFACE. If a face or fontset name is explicitely
4117 specfied in LFACE, use it as is. Otherwise, determine a font name
4118 from the other font-related atrributes of LFACE. In that case, if
4119 there's no matching font, signals an error. */
4122 set_font_frame_param (frame
, lface
)
4123 Lisp_Object frame
, lface
;
4125 struct frame
*f
= XFRAME (frame
);
4126 Lisp_Object font_name
;
4129 if (STRINGP (LFACE_FONT (lface
)))
4130 font_name
= LFACE_FONT (lface
);
4133 /* Choose a font name that reflects LFACE's attributes and has
4134 the registry and encoding pattern specified in the default
4135 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4136 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4138 error ("No font matches the specified attribute");
4139 font_name
= build_string (font
);
4143 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4147 /* Update the corresponding face when frame parameter PARAM on frame F
4148 has been assigned the value NEW_VALUE. */
4151 update_face_from_frame_parameter (f
, param
, new_value
)
4153 Lisp_Object param
, new_value
;
4157 /* If there are no faces yet, give up. This is the case when called
4158 from Fx_create_frame, and we do the necessary things later in
4159 face-set-after-frame-defaults. */
4160 if (NILP (f
->face_alist
))
4163 if (EQ (param
, Qforeground_color
))
4165 lface
= lface_from_face_name (f
, Qdefault
, 1);
4166 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4167 ? new_value
: Qunspecified
);
4168 realize_basic_faces (f
);
4170 else if (EQ (param
, Qbackground_color
))
4174 /* Changing the background color might change the background
4175 mode, so that we have to load new defface specs. Call
4176 frame-update-face-colors to do that. */
4177 XSETFRAME (frame
, f
);
4178 call1 (Qframe_update_face_colors
, frame
);
4180 lface
= lface_from_face_name (f
, Qdefault
, 1);
4181 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4182 ? new_value
: Qunspecified
);
4183 realize_basic_faces (f
);
4185 if (EQ (param
, Qborder_color
))
4187 lface
= lface_from_face_name (f
, Qborder
, 1);
4188 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4189 ? new_value
: Qunspecified
);
4191 else if (EQ (param
, Qcursor_color
))
4193 lface
= lface_from_face_name (f
, Qcursor
, 1);
4194 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4195 ? new_value
: Qunspecified
);
4197 else if (EQ (param
, Qmouse_color
))
4199 lface
= lface_from_face_name (f
, Qmouse
, 1);
4200 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4201 ? new_value
: Qunspecified
);
4206 /* Get the value of X resource RESOURCE, class CLASS for the display
4207 of frame FRAME. This is here because ordinary `x-get-resource'
4208 doesn't take a frame argument. */
4210 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4211 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4212 (resource
, class, frame
)
4213 Lisp_Object resource
, class, frame
;
4215 Lisp_Object value
= Qnil
;
4218 CHECK_STRING (resource
, 0);
4219 CHECK_STRING (class, 1);
4220 CHECK_LIVE_FRAME (frame
, 2);
4222 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4223 resource
, class, Qnil
, Qnil
);
4225 #endif /* not macintosh */
4226 #endif /* not WINDOWSNT */
4231 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4232 If VALUE is "on" or "true", return t. If VALUE is "off" or
4233 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4234 error; if SIGNAL_P is zero, return 0. */
4237 face_boolean_x_resource_value (value
, signal_p
)
4241 Lisp_Object result
= make_number (0);
4243 xassert (STRINGP (value
));
4245 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4246 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4248 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4249 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4251 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4252 result
= Qunspecified
;
4254 signal_error ("Invalid face attribute value from X resource", value
);
4260 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4261 Finternal_set_lisp_face_attribute_from_resource
,
4262 Sinternal_set_lisp_face_attribute_from_resource
,
4264 (face
, attr
, value
, frame
)
4265 Lisp_Object face
, attr
, value
, frame
;
4267 CHECK_SYMBOL (face
, 0);
4268 CHECK_SYMBOL (attr
, 1);
4269 CHECK_STRING (value
, 2);
4271 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4272 value
= Qunspecified
;
4273 else if (EQ (attr
, QCheight
))
4275 value
= Fstring_to_number (value
, make_number (10));
4276 if (XINT (value
) <= 0)
4277 signal_error ("Invalid face height from X resource", value
);
4279 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4280 value
= face_boolean_x_resource_value (value
, 1);
4281 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4282 value
= intern (XSTRING (value
)->data
);
4283 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4284 value
= face_boolean_x_resource_value (value
, 1);
4285 else if (EQ (attr
, QCunderline
)
4286 || EQ (attr
, QCoverline
)
4287 || EQ (attr
, QCstrike_through
)
4288 || EQ (attr
, QCbox
))
4290 Lisp_Object boolean_value
;
4292 /* If the result of face_boolean_x_resource_value is t or nil,
4293 VALUE does NOT specify a color. */
4294 boolean_value
= face_boolean_x_resource_value (value
, 0);
4295 if (SYMBOLP (boolean_value
))
4296 value
= boolean_value
;
4299 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4302 #endif /* HAVE_WINDOW_SYSTEM */
4305 #ifdef HAVE_X_WINDOWS
4306 /***********************************************************************
4308 ***********************************************************************/
4310 #ifdef USE_X_TOOLKIT
4312 #include "../lwlib/lwlib-utils.h"
4314 /* Structure used to pass X resources to functions called via
4315 XtApplyToWidgets. */
4326 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4327 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4330 /* Set widget W's X resources from P which points to an x_resources
4331 structure. If W is a cascade button, apply resources to W's
4335 xm_apply_resources (w
, p
)
4340 struct x_resources
*res
= (struct x_resources
*) p
;
4342 XtSetValues (w
, res
->av
, res
->ac
);
4343 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4346 XtSetValues (submenu
, res
->av
, res
->ac
);
4347 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4352 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4353 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4356 1. Setting the XmNfontList resource leads to an infinite loop
4357 somewhere in LessTif. */
4360 xm_set_menu_resources_from_menu_face (f
, widget
)
4370 lface
= lface_from_face_name (f
, Qmenu
, 1);
4371 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4373 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4375 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4379 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4381 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4385 /* If any font-related attribute of `menu' is set, set the font. */
4387 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4388 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4389 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4390 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4391 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4393 #if 0 /* Setting the font leads to an infinite loop somewhere
4394 in LessTif during geometry computation. */
4396 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4397 fl
= XmFontListAppendEntry (NULL
, fe
);
4398 XtSetArg (av
[ac
], XmNfontList
, fl
);
4403 xassert (ac
<= sizeof av
/ sizeof *av
);
4407 struct x_resources res
;
4409 XtSetValues (widget
, av
, ac
);
4410 res
.av
= av
, res
.ac
= ac
;
4411 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4413 XmFontListFree (fl
);
4417 #endif /* USE_MOTIF */
4421 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4422 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4425 /* Set widget W's resources from P which points to an x_resources
4429 xl_apply_resources (widget
, p
)
4433 struct x_resources
*res
= (struct x_resources
*) p
;
4434 XtSetValues (widget
, res
->av
, res
->ac
);
4438 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4439 This is the Lucid version. */
4442 xl_set_menu_resources_from_menu_face (f
, widget
)
4451 lface
= lface_from_face_name (f
, Qmenu
, 1);
4452 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4454 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4456 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4460 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4462 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4467 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4468 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4469 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4470 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4471 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4473 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4479 struct x_resources res
;
4481 XtSetValues (widget
, av
, ac
);
4483 /* We must do children here in case we're handling a pop-up menu
4484 in which case WIDGET is a popup shell. XtApplyToWidgets
4485 is a function from lwlib. */
4486 res
.av
= av
, res
.ac
= ac
;
4487 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4491 #endif /* USE_LUCID */
4494 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4497 x_set_menu_resources_from_menu_face (f
, widget
)
4501 /* Realized faces may have been removed on frame F, e.g. because of
4502 face attribute changes. Recompute them, if necessary, since we
4503 will need the `menu' face. */
4504 if (f
->face_cache
->used
== 0)
4505 recompute_basic_faces (f
);
4509 xl_set_menu_resources_from_menu_face (f
, widget
);
4512 xm_set_menu_resources_from_menu_face (f
, widget
);
4517 #endif /* USE_X_TOOLKIT */
4519 #endif /* HAVE_X_WINDOWS */
4523 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4524 Sinternal_get_lisp_face_attribute
,
4526 "Return face attribute KEYWORD of face SYMBOL.\n\
4527 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4528 face attribute name, signal an error.\n\
4529 If the optional argument FRAME is given, report on face FACE in that\n\
4530 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4531 frames). If FRAME is omitted or nil, use the selected frame.")
4532 (symbol
, keyword
, frame
)
4533 Lisp_Object symbol
, keyword
, frame
;
4535 Lisp_Object lface
, value
= Qnil
;
4537 CHECK_SYMBOL (symbol
, 0);
4538 CHECK_SYMBOL (keyword
, 1);
4541 lface
= lface_from_face_name (NULL
, symbol
, 1);
4545 frame
= selected_frame
;
4546 CHECK_LIVE_FRAME (frame
, 2);
4547 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4550 if (EQ (keyword
, QCfamily
))
4551 value
= LFACE_FAMILY (lface
);
4552 else if (EQ (keyword
, QCheight
))
4553 value
= LFACE_HEIGHT (lface
);
4554 else if (EQ (keyword
, QCweight
))
4555 value
= LFACE_WEIGHT (lface
);
4556 else if (EQ (keyword
, QCslant
))
4557 value
= LFACE_SLANT (lface
);
4558 else if (EQ (keyword
, QCunderline
))
4559 value
= LFACE_UNDERLINE (lface
);
4560 else if (EQ (keyword
, QCoverline
))
4561 value
= LFACE_OVERLINE (lface
);
4562 else if (EQ (keyword
, QCstrike_through
))
4563 value
= LFACE_STRIKE_THROUGH (lface
);
4564 else if (EQ (keyword
, QCbox
))
4565 value
= LFACE_BOX (lface
);
4566 else if (EQ (keyword
, QCinverse_video
)
4567 || EQ (keyword
, QCreverse_video
))
4568 value
= LFACE_INVERSE (lface
);
4569 else if (EQ (keyword
, QCforeground
))
4570 value
= LFACE_FOREGROUND (lface
);
4571 else if (EQ (keyword
, QCbackground
))
4572 value
= LFACE_BACKGROUND (lface
);
4573 else if (EQ (keyword
, QCstipple
))
4574 value
= LFACE_STIPPLE (lface
);
4575 else if (EQ (keyword
, QCwidth
))
4576 value
= LFACE_SWIDTH (lface
);
4577 else if (EQ (keyword
, QCinherit
))
4578 value
= LFACE_INHERIT (lface
);
4579 else if (EQ (keyword
, QCfont
))
4580 value
= LFACE_FONT (lface
);
4582 signal_error ("Invalid face attribute name", keyword
);
4588 DEFUN ("internal-lisp-face-attribute-values",
4589 Finternal_lisp_face_attribute_values
,
4590 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4591 "Return a list of valid discrete values for face attribute ATTR.\n\
4592 Value is nil if ATTR doesn't have a discrete set of valid values.")
4596 Lisp_Object result
= Qnil
;
4598 CHECK_SYMBOL (attr
, 0);
4600 if (EQ (attr
, QCweight
)
4601 || EQ (attr
, QCslant
)
4602 || EQ (attr
, QCwidth
))
4604 /* Extract permissible symbols from tables. */
4605 struct table_entry
*table
;
4608 if (EQ (attr
, QCweight
))
4609 table
= weight_table
, dim
= DIM (weight_table
);
4610 else if (EQ (attr
, QCslant
))
4611 table
= slant_table
, dim
= DIM (slant_table
);
4613 table
= swidth_table
, dim
= DIM (swidth_table
);
4615 for (i
= 0; i
< dim
; ++i
)
4617 Lisp_Object symbol
= *table
[i
].symbol
;
4618 Lisp_Object tail
= result
;
4621 && !EQ (XCAR (tail
), symbol
))
4625 result
= Fcons (symbol
, result
);
4628 else if (EQ (attr
, QCunderline
))
4629 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4630 else if (EQ (attr
, QCoverline
))
4631 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4632 else if (EQ (attr
, QCstrike_through
))
4633 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4634 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4635 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4641 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4642 Sinternal_merge_in_global_face
, 2, 2, 0,
4643 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4644 Default face attributes override any local face attributes.")
4646 Lisp_Object face
, frame
;
4649 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4651 CHECK_LIVE_FRAME (frame
, 1);
4652 global_lface
= lface_from_face_name (NULL
, face
, 1);
4653 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4654 if (NILP (local_lface
))
4655 local_lface
= Finternal_make_lisp_face (face
, frame
);
4657 /* Make every specified global attribute override the local one.
4658 BEWARE!! This is only used from `face-set-after-frame-default' where
4659 the local frame is defined from default specs in `face-defface-spec'
4660 and those should be overridden by global settings. Hence the strange
4661 "global before local" priority. */
4662 lvec
= XVECTOR (local_lface
)->contents
;
4663 gvec
= XVECTOR (global_lface
)->contents
;
4664 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4665 if (! UNSPECIFIEDP (gvec
[i
]))
4672 /* The following function is implemented for compatibility with 20.2.
4673 The function is used in x-resolve-fonts when it is asked to
4674 return fonts with the same size as the font of a face. This is
4675 done in fontset.el. */
4677 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4678 "Return the font name of face FACE, or nil if it is unspecified.\n\
4679 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4680 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4681 The font default for a face is either nil, or a list\n\
4682 of the form (bold), (italic) or (bold italic).\n\
4683 If FRAME is omitted or nil, use the selected frame.")
4685 Lisp_Object face
, frame
;
4689 Lisp_Object result
= Qnil
;
4690 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4692 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4693 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4694 result
= Fcons (Qbold
, result
);
4696 if (!NILP (LFACE_SLANT (lface
))
4697 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4698 result
= Fcons (Qitalic
, result
);
4704 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4705 int face_id
= lookup_named_face (f
, face
, 0);
4706 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4707 return face
? build_string (face
->font_name
) : Qnil
;
4712 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4713 all attributes are `equal'. Tries to be fast because this function
4714 is called quite often. */
4717 lface_equal_p (v1
, v2
)
4718 Lisp_Object
*v1
, *v2
;
4722 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4724 Lisp_Object a
= v1
[i
];
4725 Lisp_Object b
= v2
[i
];
4727 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4728 and the other is specified. */
4729 equal_p
= XTYPE (a
) == XTYPE (b
);
4738 equal_p
= ((STRING_BYTES (XSTRING (a
))
4739 == STRING_BYTES (XSTRING (b
)))
4740 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4741 STRING_BYTES (XSTRING (a
))) == 0);
4750 equal_p
= !NILP (Fequal (a
, b
));
4760 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4761 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4762 "True if FACE1 and FACE2 are equal.\n\
4763 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4764 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4765 If FRAME is omitted or nil, use the selected frame.")
4766 (face1
, face2
, frame
)
4767 Lisp_Object face1
, face2
, frame
;
4771 Lisp_Object lface1
, lface2
;
4776 /* Don't use check_x_frame here because this function is called
4777 before X frames exist. At that time, if FRAME is nil,
4778 selected_frame will be used which is the frame dumped with
4779 Emacs. That frame is not an X frame. */
4780 f
= frame_or_selected_frame (frame
, 2);
4782 lface1
= lface_from_face_name (NULL
, face1
, 1);
4783 lface2
= lface_from_face_name (NULL
, face2
, 1);
4784 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4785 XVECTOR (lface2
)->contents
);
4786 return equal_p
? Qt
: Qnil
;
4790 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4791 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4792 "True if FACE has no attribute specified.\n\
4793 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4794 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4795 If FRAME is omitted or nil, use the selected frame.")
4797 Lisp_Object face
, frame
;
4804 frame
= selected_frame
;
4805 CHECK_LIVE_FRAME (frame
, 0);
4809 lface
= lface_from_face_name (NULL
, face
, 1);
4811 lface
= lface_from_face_name (f
, face
, 1);
4813 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4814 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4817 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4821 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4823 "Return an alist of frame-local faces defined on FRAME.\n\
4824 For internal use only.")
4828 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4829 return f
->face_alist
;
4833 /* Return a hash code for Lisp string STRING with case ignored. Used
4834 below in computing a hash value for a Lisp face. */
4836 static INLINE
unsigned
4837 hash_string_case_insensitive (string
)
4842 xassert (STRINGP (string
));
4843 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4844 hash
= (hash
<< 1) ^ tolower (*s
);
4849 /* Return a hash code for face attribute vector V. */
4851 static INLINE
unsigned
4855 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4856 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4857 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4858 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4859 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4860 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4861 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4865 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4866 considering charsets/registries). They do if they specify the same
4867 family, point size, weight, width, slant, and fontset. Both LFACE1
4868 and LFACE2 must be fully-specified. */
4871 lface_same_font_attributes_p (lface1
, lface2
)
4872 Lisp_Object
*lface1
, *lface2
;
4874 xassert (lface_fully_specified_p (lface1
)
4875 && lface_fully_specified_p (lface2
));
4876 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4877 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4878 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4879 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4880 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4881 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4882 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4883 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4884 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4885 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4886 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4891 /***********************************************************************
4893 ***********************************************************************/
4895 /* Allocate and return a new realized face for Lisp face attribute
4898 static struct face
*
4899 make_realized_face (attr
)
4902 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4903 bzero (face
, sizeof *face
);
4904 face
->ascii_face
= face
;
4905 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4910 /* Free realized face FACE, including its X resources. FACE may
4914 free_realized_face (f
, face
)
4920 #ifdef HAVE_WINDOW_SYSTEM
4921 if (FRAME_WINDOW_P (f
))
4923 /* Free fontset of FACE if it is ASCII face. */
4924 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4925 free_face_fontset (f
, face
);
4928 x_free_gc (f
, face
->gc
);
4932 free_face_colors (f
, face
);
4933 x_destroy_bitmap (f
, face
->stipple
);
4935 #endif /* HAVE_WINDOW_SYSTEM */
4942 /* Prepare face FACE for subsequent display on frame F. This
4943 allocated GCs if they haven't been allocated yet or have been freed
4944 by clearing the face cache. */
4947 prepare_face_for_display (f
, face
)
4951 #ifdef HAVE_WINDOW_SYSTEM
4952 xassert (FRAME_WINDOW_P (f
));
4957 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
4959 xgcv
.foreground
= face
->foreground
;
4960 xgcv
.background
= face
->background
;
4961 #ifdef HAVE_X_WINDOWS
4962 xgcv
.graphics_exposures
= False
;
4964 /* The font of FACE may be null if we couldn't load it. */
4967 #ifdef HAVE_X_WINDOWS
4968 xgcv
.font
= face
->font
->fid
;
4971 xgcv
.font
= face
->font
;
4974 xgcv
.font
= face
->font
;
4980 #ifdef HAVE_X_WINDOWS
4983 xgcv
.fill_style
= FillOpaqueStippled
;
4984 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
4985 mask
|= GCFillStyle
| GCStipple
;
4988 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
4991 #endif /* HAVE_WINDOW_SYSTEM */
4995 /***********************************************************************
4997 ***********************************************************************/
4999 /* Return a new face cache for frame F. */
5001 static struct face_cache
*
5005 struct face_cache
*c
;
5008 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5009 bzero (c
, sizeof *c
);
5010 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5011 c
->buckets
= (struct face
**) xmalloc (size
);
5012 bzero (c
->buckets
, size
);
5014 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5020 /* Clear out all graphics contexts for all realized faces, except for
5021 the basic faces. This should be done from time to time just to avoid
5022 keeping too many graphics contexts that are no longer needed. */
5026 struct face_cache
*c
;
5028 if (c
&& FRAME_WINDOW_P (c
->f
))
5030 #ifdef HAVE_WINDOW_SYSTEM
5032 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5034 struct face
*face
= c
->faces_by_id
[i
];
5035 if (face
&& face
->gc
)
5037 x_free_gc (c
->f
, face
->gc
);
5041 #endif /* HAVE_WINDOW_SYSTEM */
5046 /* Free all realized faces in face cache C, including basic faces. C
5047 may be null. If faces are freed, make sure the frame's current
5048 matrix is marked invalid, so that a display caused by an expose
5049 event doesn't try to use faces we destroyed. */
5052 free_realized_faces (c
)
5053 struct face_cache
*c
;
5058 struct frame
*f
= c
->f
;
5060 /* We must block input here because we can't process X events
5061 safely while only some faces are freed, or when the frame's
5062 current matrix still references freed faces. */
5065 for (i
= 0; i
< c
->used
; ++i
)
5067 free_realized_face (f
, c
->faces_by_id
[i
]);
5068 c
->faces_by_id
[i
] = NULL
;
5072 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5073 bzero (c
->buckets
, size
);
5075 /* Must do a thorough redisplay the next time. Mark current
5076 matrices as invalid because they will reference faces freed
5077 above. This function is also called when a frame is
5078 destroyed. In this case, the root window of F is nil. */
5079 if (WINDOWP (f
->root_window
))
5081 clear_current_matrices (f
);
5082 ++windows_or_buffers_changed
;
5090 /* Free all faces realized for multibyte characters on frame F that
5094 free_realized_multibyte_face (f
, fontset
)
5098 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5102 /* We must block input here because we can't process X events safely
5103 while only some faces are freed, or when the frame's current
5104 matrix still references freed faces. */
5107 for (i
= 0; i
< cache
->used
; i
++)
5109 face
= cache
->faces_by_id
[i
];
5111 && face
!= face
->ascii_face
5112 && face
->fontset
== fontset
)
5114 uncache_face (cache
, face
);
5115 free_realized_face (f
, face
);
5119 /* Must do a thorough redisplay the next time. Mark current
5120 matrices as invalid because they will reference faces freed
5121 above. This function is also called when a frame is destroyed.
5122 In this case, the root window of F is nil. */
5123 if (WINDOWP (f
->root_window
))
5125 clear_current_matrices (f
);
5126 ++windows_or_buffers_changed
;
5133 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5134 This is done after attributes of a named face have been changed,
5135 because we can't tell which realized faces depend on that face. */
5138 free_all_realized_faces (frame
)
5144 FOR_EACH_FRAME (rest
, frame
)
5145 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5148 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5152 /* Free face cache C and faces in it, including their X resources. */
5156 struct face_cache
*c
;
5160 free_realized_faces (c
);
5162 xfree (c
->faces_by_id
);
5168 /* Cache realized face FACE in face cache C. HASH is the hash value
5169 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5170 collision list of the face hash table of C. This is done because
5171 otherwise lookup_face would find FACE for every character, even if
5172 faces with the same attributes but for specific characters exist. */
5175 cache_face (c
, face
, hash
)
5176 struct face_cache
*c
;
5180 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5184 if (face
->fontset
>= 0)
5186 struct face
*last
= c
->buckets
[i
];
5197 c
->buckets
[i
] = face
;
5198 face
->prev
= face
->next
= NULL
;
5204 face
->next
= c
->buckets
[i
];
5206 face
->next
->prev
= face
;
5207 c
->buckets
[i
] = face
;
5210 /* Find a free slot in C->faces_by_id and use the index of the free
5211 slot as FACE->id. */
5212 for (i
= 0; i
< c
->used
; ++i
)
5213 if (c
->faces_by_id
[i
] == NULL
)
5217 /* Maybe enlarge C->faces_by_id. */
5218 if (i
== c
->used
&& c
->used
== c
->size
)
5220 int new_size
= 2 * c
->size
;
5221 int sz
= new_size
* sizeof *c
->faces_by_id
;
5222 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5227 /* Check that FACE got a unique id. */
5232 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5233 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5239 #endif /* GLYPH_DEBUG */
5241 c
->faces_by_id
[i
] = face
;
5247 /* Remove face FACE from cache C. */
5250 uncache_face (c
, face
)
5251 struct face_cache
*c
;
5254 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5257 face
->prev
->next
= face
->next
;
5259 c
->buckets
[i
] = face
->next
;
5262 face
->next
->prev
= face
->prev
;
5264 c
->faces_by_id
[face
->id
] = NULL
;
5265 if (face
->id
== c
->used
)
5270 /* Look up a realized face with face attributes ATTR in the face cache
5271 of frame F. The face will be used to display character C. Value
5272 is the ID of the face found. If no suitable face is found, realize
5273 a new one. In that case, if C is a multibyte character, BASE_FACE
5274 is a face that has the same attributes. */
5277 lookup_face (f
, attr
, c
, base_face
)
5281 struct face
*base_face
;
5283 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5288 xassert (cache
!= NULL
);
5289 check_lface_attrs (attr
);
5291 /* Look up ATTR in the face cache. */
5292 hash
= lface_hash (attr
);
5293 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5295 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5296 if (face
->hash
== hash
5297 && (!FRAME_WINDOW_P (f
)
5298 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5299 && lface_equal_p (face
->lface
, attr
))
5302 /* If not found, realize a new face. */
5304 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5307 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5309 /* When this function is called from face_for_char (in this case, C is
5310 a multibyte character), a fontset of a face returned by
5311 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5312 C) is not sutisfied. The fontset is set for this face by
5313 face_for_char later. */
5315 if (FRAME_WINDOW_P (f
))
5316 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5318 #endif /* GLYPH_DEBUG */
5324 /* Return the face id of the realized face for named face SYMBOL on
5325 frame F suitable for displaying character C. Value is -1 if the
5326 face couldn't be determined, which might happen if the default face
5327 isn't realized and cannot be realized. */
5330 lookup_named_face (f
, symbol
, c
)
5335 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5336 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5337 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5339 if (default_face
== NULL
)
5341 if (!realize_basic_faces (f
))
5343 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5346 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5347 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5348 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5349 return lookup_face (f
, attrs
, c
, NULL
);
5353 /* Return the ID of the realized ASCII face of Lisp face with ID
5354 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5357 ascii_face_of_lisp_face (f
, lface_id
)
5363 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5365 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5366 face_id
= lookup_named_face (f
, face_name
, 0);
5375 /* Return a face for charset ASCII that is like the face with id
5376 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5377 STEPS < 0 means larger. Value is the id of the face. */
5380 smaller_face (f
, face_id
, steps
)
5384 #ifdef HAVE_WINDOW_SYSTEM
5386 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5387 int pt
, last_pt
, last_height
;
5390 struct face
*new_face
;
5392 /* If not called for an X frame, just return the original face. */
5393 if (FRAME_TERMCAP_P (f
))
5396 /* Try in increments of 1/2 pt. */
5397 delta
= steps
< 0 ? 5 : -5;
5398 steps
= abs (steps
);
5400 face
= FACE_FROM_ID (f
, face_id
);
5401 bcopy (face
->lface
, attrs
, sizeof attrs
);
5402 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5403 new_face_id
= face_id
;
5404 last_height
= FONT_HEIGHT (face
->font
);
5408 /* Give up if we cannot find a font within 10pt. */
5409 && abs (last_pt
- pt
) < 100)
5411 /* Look up a face for a slightly smaller/larger font. */
5413 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5414 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5415 new_face
= FACE_FROM_ID (f
, new_face_id
);
5417 /* If height changes, count that as one step. */
5418 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5419 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5422 last_height
= FONT_HEIGHT (new_face
->font
);
5429 #else /* not HAVE_WINDOW_SYSTEM */
5433 #endif /* not HAVE_WINDOW_SYSTEM */
5437 /* Return a face for charset ASCII that is like the face with id
5438 FACE_ID on frame F, but has height HEIGHT. */
5441 face_with_height (f
, face_id
, height
)
5446 #ifdef HAVE_WINDOW_SYSTEM
5448 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5450 if (FRAME_TERMCAP_P (f
)
5454 face
= FACE_FROM_ID (f
, face_id
);
5455 bcopy (face
->lface
, attrs
, sizeof attrs
);
5456 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5457 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5458 #endif /* HAVE_WINDOW_SYSTEM */
5464 /* Return the face id of the realized face for named face SYMBOL on
5465 frame F suitable for displaying character C, and use attributes of
5466 the face FACE_ID for attributes that aren't completely specified by
5467 SYMBOL. This is like lookup_named_face, except that the default
5468 attributes come from FACE_ID, not from the default face. FACE_ID
5469 is assumed to be already realized. */
5472 lookup_derived_face (f
, symbol
, c
, face_id
)
5478 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5479 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5480 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5485 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5486 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5487 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5488 return lookup_face (f
, attrs
, c
, default_face
);
5493 /***********************************************************************
5495 ***********************************************************************/
5497 DEFUN ("internal-set-font-selection-order",
5498 Finternal_set_font_selection_order
,
5499 Sinternal_set_font_selection_order
, 1, 1, 0,
5500 "Set font selection order for face font selection to ORDER.\n\
5501 ORDER must be a list of length 4 containing the symbols `:width',\n\
5502 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5503 first in ORDER are matched first, e.g. if `:height' appears before\n\
5504 `:weight' in ORDER, font selection first tries to find a font with\n\
5505 a suitable height, and then tries to match the font weight.\n\
5514 CHECK_LIST (order
, 0);
5515 bzero (indices
, sizeof indices
);
5519 CONSP (list
) && i
< DIM (indices
);
5520 list
= XCDR (list
), ++i
)
5522 Lisp_Object attr
= XCAR (list
);
5525 if (EQ (attr
, QCwidth
))
5527 else if (EQ (attr
, QCheight
))
5528 xlfd
= XLFD_POINT_SIZE
;
5529 else if (EQ (attr
, QCweight
))
5531 else if (EQ (attr
, QCslant
))
5536 if (indices
[i
] != 0)
5542 || i
!= DIM (indices
)
5547 signal_error ("Invalid font sort order", order
);
5549 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5551 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5552 free_all_realized_faces (Qnil
);
5559 DEFUN ("internal-set-alternative-font-family-alist",
5560 Finternal_set_alternative_font_family_alist
,
5561 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5562 "Define alternative font families to try in face font selection.\n\
5563 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5564 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5565 be found. Value is ALIST.")
5569 CHECK_LIST (alist
, 0);
5570 Vface_alternative_font_family_alist
= alist
;
5571 free_all_realized_faces (Qnil
);
5576 DEFUN ("internal-set-alternative-font-registry-alist",
5577 Finternal_set_alternative_font_registry_alist
,
5578 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5579 "Define alternative font registries to try in face font selection.\n\
5580 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5581 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5582 be found. Value is ALIST.")
5586 CHECK_LIST (alist
, 0);
5587 Vface_alternative_font_registry_alist
= alist
;
5588 free_all_realized_faces (Qnil
);
5593 #ifdef HAVE_WINDOW_SYSTEM
5595 /* Value is non-zero if FONT is the name of a scalable font. The
5596 X11R6 XLFD spec says that point size, pixel size, and average width
5597 are zero for scalable fonts. Intlfonts contain at least one
5598 scalable font ("*-muleindian-1") for which this isn't true, so we
5599 just test average width. */
5602 font_scalable_p (font
)
5603 struct font_name
*font
;
5605 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5606 return (*s
== '0' && *(s
+ 1) == '\0')
5608 /* Windows implementation of XLFD is slightly broken for backward
5609 compatibility with previous broken versions, so test for
5610 wildcards as well as 0. */
5617 /* Value is non-zero if FONT1 is a better match for font attributes
5618 VALUES than FONT2. VALUES is an array of face attribute values in
5619 font sort order. COMPARE_PT_P zero means don't compare point
5623 better_font_p (values
, font1
, font2
, compare_pt_p
)
5625 struct font_name
*font1
, *font2
;
5630 for (i
= 0; i
< 4; ++i
)
5632 int xlfd_idx
= font_sort_order
[i
];
5634 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5636 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5637 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5639 if (delta1
> delta2
)
5641 else if (delta1
< delta2
)
5645 /* The difference may be equal because, e.g., the face
5646 specifies `italic' but we have only `regular' and
5647 `oblique'. Prefer `oblique' in this case. */
5648 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5649 && font1
->numeric
[xlfd_idx
] > values
[i
]
5650 && font2
->numeric
[xlfd_idx
] < values
[i
])
5660 /* Value is non-zero if FONT is an exact match for face attributes in
5661 SPECIFIED. SPECIFIED is an array of face attribute values in font
5665 exact_face_match_p (specified
, font
)
5667 struct font_name
*font
;
5671 for (i
= 0; i
< 4; ++i
)
5672 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5679 /* Value is the name of a scaled font, generated from scalable font
5680 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5681 Value is allocated from heap. */
5684 build_scalable_font_name (f
, font
, specified_pt
)
5686 struct font_name
*font
;
5689 char point_size
[20], pixel_size
[20];
5691 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5694 /* If scalable font is for a specific resolution, compute
5695 the point size we must specify from the resolution of
5696 the display and the specified resolution of the font. */
5697 if (font
->numeric
[XLFD_RESY
] != 0)
5699 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5700 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5705 pixel_value
= resy
/ 720.0 * pt
;
5708 /* Set point size of the font. */
5709 sprintf (point_size
, "%d", (int) pt
);
5710 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5711 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5713 /* Set pixel size. */
5714 sprintf (pixel_size
, "%d", pixel_value
);
5715 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5716 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5718 /* If font doesn't specify its resolution, use the
5719 resolution of the display. */
5720 if (font
->numeric
[XLFD_RESY
] == 0)
5723 sprintf (buffer
, "%d", (int) resy
);
5724 font
->fields
[XLFD_RESY
] = buffer
;
5725 font
->numeric
[XLFD_RESY
] = resy
;
5728 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5731 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5732 sprintf (buffer
, "%d", resx
);
5733 font
->fields
[XLFD_RESX
] = buffer
;
5734 font
->numeric
[XLFD_RESX
] = resx
;
5737 return build_font_name (font
);
5741 /* Value is non-zero if we are allowed to use scalable font FONT. We
5742 can't run a Lisp function here since this function may be called
5743 with input blocked. */
5746 may_use_scalable_font_p (font
, name
)
5747 struct font_name
*font
;
5750 if (EQ (Vscalable_fonts_allowed
, Qt
))
5752 else if (CONSP (Vscalable_fonts_allowed
))
5754 Lisp_Object tail
, regexp
;
5756 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5758 regexp
= XCAR (tail
);
5759 if (STRINGP (regexp
)
5760 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5770 /* Return the name of the best matching font for face attributes
5771 ATTRS in the array of font_name structures FONTS which contains
5772 NFONTS elements. Value is a font name which is allocated from
5773 the heap. FONTS is freed by this function. */
5776 best_matching_font (f
, attrs
, fonts
, nfonts
)
5779 struct font_name
*fonts
;
5783 struct font_name
*best
;
5791 /* Make specified font attributes available in `specified',
5792 indexed by sort order. */
5793 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5795 int xlfd_idx
= font_sort_order
[i
];
5797 if (xlfd_idx
== XLFD_SWIDTH
)
5798 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5799 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5800 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5801 else if (xlfd_idx
== XLFD_WEIGHT
)
5802 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5803 else if (xlfd_idx
== XLFD_SLANT
)
5804 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5811 /* Start with the first non-scalable font in the list. */
5812 for (i
= 0; i
< nfonts
; ++i
)
5813 if (!font_scalable_p (fonts
+ i
))
5816 /* Find the best match among the non-scalable fonts. */
5821 for (i
= 1; i
< nfonts
; ++i
)
5822 if (!font_scalable_p (fonts
+ i
)
5823 && better_font_p (specified
, fonts
+ i
, best
, 1))
5827 exact_p
= exact_face_match_p (specified
, best
);
5836 /* Unless we found an exact match among non-scalable fonts, see if
5837 we can find a better match among scalable fonts. */
5840 /* A scalable font is better if
5842 1. its weight, slant, swidth attributes are better, or.
5844 2. the best non-scalable font doesn't have the required
5845 point size, and the scalable fonts weight, slant, swidth
5848 int non_scalable_has_exact_height_p
;
5850 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5851 non_scalable_has_exact_height_p
= 1;
5853 non_scalable_has_exact_height_p
= 0;
5855 for (i
= 0; i
< nfonts
; ++i
)
5856 if (font_scalable_p (fonts
+ i
))
5859 || better_font_p (specified
, fonts
+ i
, best
, 0)
5860 || (!non_scalable_has_exact_height_p
5861 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5866 if (font_scalable_p (best
))
5867 font_name
= build_scalable_font_name (f
, best
, pt
);
5869 font_name
= build_font_name (best
);
5871 /* Free font_name structures. */
5872 free_font_names (fonts
, nfonts
);
5878 /* Try to get a list of fonts on frame F with font family FAMILY and
5879 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5880 of font_name structures for the fonts matched. Value is the number
5884 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5887 Lisp_Object pattern
, family
, registry
;
5888 struct font_name
**fonts
;
5892 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5893 family
= attrs
[LFACE_FAMILY_INDEX
];
5895 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5896 if (nfonts
== 0 && !NILP (family
))
5900 /* Try alternative font families. */
5901 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5903 for (alter
= XCDR (alter
);
5904 CONSP (alter
) && nfonts
== 0;
5905 alter
= XCDR (alter
))
5907 if (STRINGP (XCAR (alter
)))
5908 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5911 /* Try font family of the default face or "fixed". */
5914 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5916 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5918 family
= build_string ("fixed");
5919 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5922 /* Try any family with the given registry. */
5924 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5931 /* Return the fontset id of the base fontset name or alias name given
5932 by the fontset attribute of ATTRS. Value is -1 if the fontset
5933 attribute of ATTRS doesn't name a fontset. */
5936 face_fontset (attrs
)
5942 name
= attrs
[LFACE_FONT_INDEX
];
5943 if (!STRINGP (name
))
5945 return fs_query_fontset (name
, 0);
5949 /* Choose a name of font to use on frame F to display character C with
5950 Lisp face attributes specified by ATTRS. The font name is
5951 determined by the font-related attributes in ATTRS and the name
5952 pattern for C in FONTSET. Value is the font name which is
5953 allocated from the heap and must be freed by the caller, or NULL if
5954 we can get no information about the font name of C. It is assured
5955 that we always get some information for a single byte
5959 choose_face_font (f
, attrs
, fontset
, c
)
5964 Lisp_Object pattern
;
5965 char *font_name
= NULL
;
5966 struct font_name
*fonts
;
5969 /* Get (foundry and) family name and registry (and encoding) name of
5971 pattern
= fontset_font_pattern (f
, fontset
, c
);
5974 xassert (!SINGLE_BYTE_CHAR_P (c
));
5977 /* If what we got is a name pattern, return it. */
5978 if (STRINGP (pattern
))
5979 return xstrdup (XSTRING (pattern
)->data
);
5981 /* Family name may be specified both in ATTRS and car part of
5982 PATTERN. The former has higher priority if C is a single byte
5984 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
5985 && SINGLE_BYTE_CHAR_P (c
))
5986 XCAR (pattern
) = Qnil
;
5988 /* Get a list of fonts matching that pattern and choose the
5989 best match for the specified face attributes from it. */
5990 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
5992 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
5996 #endif /* HAVE_WINDOW_SYSTEM */
6000 /***********************************************************************
6002 ***********************************************************************/
6004 /* Realize basic faces on frame F. Value is zero if frame parameters
6005 of F don't contain enough information needed to realize the default
6009 realize_basic_faces (f
)
6014 /* Block input there so that we won't be surprised by an X expose
6015 event, for instance without having the faces set up. */
6018 if (realize_default_face (f
))
6020 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6021 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6022 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6023 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6024 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6025 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6026 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6027 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6028 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6030 /* Reflect changes in the `menu' face in menu bars. */
6031 if (menu_face_change_count
)
6033 menu_face_change_count
= 0;
6035 #ifdef USE_X_TOOLKIT
6038 Widget menu
= f
->output_data
.x
->menubar_widget
;
6040 x_set_menu_resources_from_menu_face (f
, menu
);
6042 #endif /* USE_X_TOOLKIT */
6053 /* Realize the default face on frame F. If the face is not fully
6054 specified, make it fully-specified. Attributes of the default face
6055 that are not explicitly specified are taken from frame parameters. */
6058 realize_default_face (f
)
6061 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6063 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6064 Lisp_Object frame_font
;
6068 /* If the `default' face is not yet known, create it. */
6069 lface
= lface_from_face_name (f
, Qdefault
, 0);
6073 XSETFRAME (frame
, f
);
6074 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6077 #ifdef HAVE_WINDOW_SYSTEM
6078 if (FRAME_WINDOW_P (f
))
6080 /* Set frame_font to the value of the `font' frame parameter. */
6081 frame_font
= Fassq (Qfont
, f
->param_alist
);
6082 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6083 frame_font
= XCDR (frame_font
);
6084 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6086 #endif /* HAVE_WINDOW_SYSTEM */
6088 if (!FRAME_WINDOW_P (f
))
6090 LFACE_FAMILY (lface
) = build_string ("default");
6091 LFACE_SWIDTH (lface
) = Qnormal
;
6092 LFACE_HEIGHT (lface
) = make_number (1);
6093 LFACE_WEIGHT (lface
) = Qnormal
;
6094 LFACE_SLANT (lface
) = Qnormal
;
6097 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6098 LFACE_UNDERLINE (lface
) = Qnil
;
6100 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6101 LFACE_OVERLINE (lface
) = Qnil
;
6103 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6104 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6106 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6107 LFACE_BOX (lface
) = Qnil
;
6109 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6110 LFACE_INVERSE (lface
) = Qnil
;
6112 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6114 /* This function is called so early that colors are not yet
6115 set in the frame parameter list. */
6116 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6118 if (CONSP (color
) && STRINGP (XCDR (color
)))
6119 LFACE_FOREGROUND (lface
) = XCDR (color
);
6120 else if (FRAME_WINDOW_P (f
))
6122 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6123 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6128 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6130 /* This function is called so early that colors are not yet
6131 set in the frame parameter list. */
6132 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6133 if (CONSP (color
) && STRINGP (XCDR (color
)))
6134 LFACE_BACKGROUND (lface
) = XCDR (color
);
6135 else if (FRAME_WINDOW_P (f
))
6137 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6138 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6143 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6144 LFACE_STIPPLE (lface
) = Qnil
;
6146 /* Realize the face; it must be fully-specified now. */
6147 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6148 check_lface (lface
);
6149 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6150 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6155 /* Realize basic faces other than the default face in face cache C.
6156 SYMBOL is the face name, ID is the face id the realized face must
6157 have. The default face must have been realized already. */
6160 realize_named_face (f
, symbol
, id
)
6165 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6166 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6167 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6168 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6169 struct face
*new_face
;
6171 /* The default face must exist and be fully specified. */
6172 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6173 check_lface_attrs (attrs
);
6174 xassert (lface_fully_specified_p (attrs
));
6176 /* If SYMBOL isn't know as a face, create it. */
6180 XSETFRAME (frame
, f
);
6181 lface
= Finternal_make_lisp_face (symbol
, frame
);
6184 /* Merge SYMBOL's face with the default face. */
6185 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6186 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6188 /* Realize the face. */
6189 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6193 /* Realize the fully-specified face with attributes ATTRS in face
6194 cache CACHE for character C. If C is a multibyte character,
6195 BASE_FACE is a face that has the same attributes. Otherwise,
6196 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6197 ID of face to remove before caching the new face. Value is a
6198 pointer to the newly created realized face. */
6200 static struct face
*
6201 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6202 struct face_cache
*cache
;
6205 struct face
*base_face
;
6210 /* LFACE must be fully specified. */
6211 xassert (cache
!= NULL
);
6212 check_lface_attrs (attrs
);
6214 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6216 /* Remove the former face. */
6217 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6218 uncache_face (cache
, former_face
);
6219 free_realized_face (cache
->f
, former_face
);
6222 if (FRAME_WINDOW_P (cache
->f
))
6223 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6224 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6225 face
= realize_tty_face (cache
, attrs
, c
);
6229 /* Insert the new face. */
6230 cache_face (cache
, face
, lface_hash (attrs
));
6231 #ifdef HAVE_WINDOW_SYSTEM
6232 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6233 load_face_font (cache
->f
, face
, c
);
6234 #endif /* HAVE_WINDOW_SYSTEM */
6239 /* Realize the fully-specified face with attributes ATTRS in face
6240 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6241 a multibyte character, BASE_FACE is a face that has the same
6242 attributes. Otherwise, BASE_FACE is ignored. If the new face
6243 doesn't share font with the default face, a fontname is allocated
6244 from the heap and set in `font_name' of the new face, but it is not
6245 yet loaded here. Value is a pointer to the newly created realized
6248 static struct face
*
6249 realize_x_face (cache
, attrs
, c
, base_face
)
6250 struct face_cache
*cache
;
6253 struct face
*base_face
;
6255 #ifdef HAVE_WINDOW_SYSTEM
6256 struct face
*face
, *default_face
;
6258 Lisp_Object stipple
, overline
, strike_through
, box
;
6260 xassert (FRAME_WINDOW_P (cache
->f
));
6261 xassert (SINGLE_BYTE_CHAR_P (c
)
6264 /* Allocate a new realized face. */
6265 face
= make_realized_face (attrs
);
6269 /* If C is a multibyte character, we share all face attirbutes with
6270 BASE_FACE including the realized fontset. But, we must load a
6272 if (!SINGLE_BYTE_CHAR_P (c
))
6274 bcopy (base_face
, face
, sizeof *face
);
6277 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6278 face
->foreground_defaulted_p
= 1;
6279 face
->background_defaulted_p
= 1;
6280 face
->underline_defaulted_p
= 1;
6281 face
->overline_color_defaulted_p
= 1;
6282 face
->strike_through_color_defaulted_p
= 1;
6283 face
->box_color_defaulted_p
= 1;
6285 /* to force realize_face to load font */
6290 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6292 /* Determine the font to use. Most of the time, the font will be
6293 the same as the font of the default face, so try that first. */
6294 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6296 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6297 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6299 face
->font
= default_face
->font
;
6300 face
->fontset
= default_face
->fontset
;
6301 face
->font_info_id
= default_face
->font_info_id
;
6302 face
->font_name
= default_face
->font_name
;
6303 face
->ascii_face
= face
;
6305 /* But, as we can't share the fontset, make a new realized
6306 fontset that has the same base fontset as of the default
6309 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6313 /* If the face attribute ATTRS specifies a fontset, use it as
6314 the base of a new realized fontset. Otherwise, use the same
6315 base fontset as of the default face. The base determines
6316 registry and encoding of a font. It may also determine
6317 foundry and family. The other fields of font name pattern
6318 are constructed from ATTRS. */
6319 int fontset
= face_fontset (attrs
);
6321 if ((fontset
== -1) && default_face
)
6322 fontset
= default_face
->fontset
;
6323 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6324 face
->font
= NULL
; /* to force realize_face to load font */
6327 /* Load the font if it is specified in ATTRS. This fixes
6328 changing frame font on the Mac. */
6329 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6331 struct font_info
*font_info
=
6332 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6334 face
->font
= font_info
->font
;
6339 /* Load colors, and set remaining attributes. */
6341 load_face_colors (f
, face
, attrs
);
6344 box
= attrs
[LFACE_BOX_INDEX
];
6347 /* A simple box of line width 1 drawn in color given by
6349 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6351 face
->box
= FACE_SIMPLE_BOX
;
6352 face
->box_line_width
= 1;
6354 else if (INTEGERP (box
))
6356 /* Simple box of specified line width in foreground color of the
6358 xassert (XINT (box
) > 0);
6359 face
->box
= FACE_SIMPLE_BOX
;
6360 face
->box_line_width
= XFASTINT (box
);
6361 face
->box_color
= face
->foreground
;
6362 face
->box_color_defaulted_p
= 1;
6364 else if (CONSP (box
))
6366 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6367 being one of `raised' or `sunken'. */
6368 face
->box
= FACE_SIMPLE_BOX
;
6369 face
->box_color
= face
->foreground
;
6370 face
->box_color_defaulted_p
= 1;
6371 face
->box_line_width
= 1;
6375 Lisp_Object keyword
, value
;
6377 keyword
= XCAR (box
);
6385 if (EQ (keyword
, QCline_width
))
6387 if (INTEGERP (value
) && XINT (value
) > 0)
6388 face
->box_line_width
= XFASTINT (value
);
6390 else if (EQ (keyword
, QCcolor
))
6392 if (STRINGP (value
))
6394 face
->box_color
= load_color (f
, face
, value
,
6396 face
->use_box_color_for_shadows_p
= 1;
6399 else if (EQ (keyword
, QCstyle
))
6401 if (EQ (value
, Qreleased_button
))
6402 face
->box
= FACE_RAISED_BOX
;
6403 else if (EQ (value
, Qpressed_button
))
6404 face
->box
= FACE_SUNKEN_BOX
;
6409 /* Text underline, overline, strike-through. */
6411 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6413 /* Use default color (same as foreground color). */
6414 face
->underline_p
= 1;
6415 face
->underline_defaulted_p
= 1;
6416 face
->underline_color
= 0;
6418 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6420 /* Use specified color. */
6421 face
->underline_p
= 1;
6422 face
->underline_defaulted_p
= 0;
6423 face
->underline_color
6424 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6425 LFACE_UNDERLINE_INDEX
);
6427 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6429 face
->underline_p
= 0;
6430 face
->underline_defaulted_p
= 0;
6431 face
->underline_color
= 0;
6434 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6435 if (STRINGP (overline
))
6437 face
->overline_color
6438 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6439 LFACE_OVERLINE_INDEX
);
6440 face
->overline_p
= 1;
6442 else if (EQ (overline
, Qt
))
6444 face
->overline_color
= face
->foreground
;
6445 face
->overline_color_defaulted_p
= 1;
6446 face
->overline_p
= 1;
6449 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6450 if (STRINGP (strike_through
))
6452 face
->strike_through_color
6453 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6454 LFACE_STRIKE_THROUGH_INDEX
);
6455 face
->strike_through_p
= 1;
6457 else if (EQ (strike_through
, Qt
))
6459 face
->strike_through_color
= face
->foreground
;
6460 face
->strike_through_color_defaulted_p
= 1;
6461 face
->strike_through_p
= 1;
6464 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6465 if (!NILP (stipple
))
6466 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6468 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6470 #endif /* HAVE_WINDOW_SYSTEM */
6474 /* Map a specified color of face FACE on frame F to a tty color index.
6475 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6476 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6477 default foreground/background colors. */
6480 map_tty_color (f
, face
, idx
, defaulted
)
6483 enum lface_attribute_index idx
;
6486 Lisp_Object frame
, color
, def
;
6487 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6488 unsigned long default_pixel
, default_other_pixel
, pixel
;
6490 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6494 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6495 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6499 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6500 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6503 XSETFRAME (frame
, f
);
6504 color
= face
->lface
[idx
];
6507 && XSTRING (color
)->size
6508 && CONSP (Vtty_defined_color_alist
)
6509 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6512 /* Associations in tty-defined-color-alist are of the form
6513 (NAME INDEX R G B). We need the INDEX part. */
6514 pixel
= XINT (XCAR (XCDR (def
)));
6517 if (pixel
== default_pixel
&& STRINGP (color
))
6519 pixel
= load_color (f
, face
, color
, idx
);
6521 #if defined (MSDOS) || defined (WINDOWSNT)
6522 /* If the foreground of the default face is the default color,
6523 use the foreground color defined by the frame. */
6525 if (FRAME_MSDOS_P (f
))
6528 if (pixel
== default_pixel
6529 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6532 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6534 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6535 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6538 else if (pixel
== default_other_pixel
)
6541 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6543 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6544 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6550 #endif /* MSDOS or WINDOWSNT */
6554 face
->foreground
= pixel
;
6556 face
->background
= pixel
;
6560 /* Realize the fully-specified face with attributes ATTRS in face
6561 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6562 pointer to the newly created realized face. */
6564 static struct face
*
6565 realize_tty_face (cache
, attrs
, c
)
6566 struct face_cache
*cache
;
6572 int face_colors_defaulted
= 0;
6573 struct frame
*f
= cache
->f
;
6575 /* Frame must be a termcap frame. */
6576 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6578 /* Allocate a new realized face. */
6579 face
= make_realized_face (attrs
);
6580 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6582 /* Map face attributes to TTY appearances. We map slant to
6583 dimmed text because we want italic text to appear differently
6584 and because dimmed text is probably used infrequently. */
6585 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6586 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6588 if (weight
> XLFD_WEIGHT_MEDIUM
)
6589 face
->tty_bold_p
= 1;
6590 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6591 face
->tty_dim_p
= 1;
6592 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6593 face
->tty_underline_p
= 1;
6594 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6595 face
->tty_reverse_p
= 1;
6597 /* Map color names to color indices. */
6598 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6599 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6601 /* Swap colors if face is inverse-video. If the colors are taken
6602 from the frame colors, they are already inverted, since the
6603 frame-creation function calls x-handle-reverse-video. */
6604 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6606 unsigned long tem
= face
->foreground
;
6607 face
->foreground
= face
->background
;
6608 face
->background
= tem
;
6611 if (tty_suppress_bold_inverse_default_colors_p
6613 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6614 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6615 face
->tty_bold_p
= 0;
6621 DEFUN ("tty-suppress-bold-inverse-default-colors",
6622 Ftty_suppress_bold_inverse_default_colors
,
6623 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6624 "Suppress/allow boldness of faces with inverse default colors.\n\
6625 SUPPRESS non-nil means suppress it.\n\
6626 This affects bold faces on TTYs whose foreground is the default background\n\
6627 color of the display and whose background is the default foreground color.\n\
6628 For such faces, the bold face attribute is ignored if this variable\n\
6631 Lisp_Object suppress
;
6633 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6634 ++face_change_count
;
6640 /***********************************************************************
6642 ***********************************************************************/
6644 /* Return the ID of the face to use to display character CH with face
6645 property PROP on frame F in current_buffer. */
6648 compute_char_face (f
, ch
, prop
)
6655 if (NILP (current_buffer
->enable_multibyte_characters
))
6660 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6661 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6665 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6666 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6667 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6668 merge_face_vector_with_property (f
, attrs
, prop
);
6669 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6676 /* Return the face ID associated with buffer position POS for
6677 displaying ASCII characters. Return in *ENDPTR the position at
6678 which a different face is needed, as far as text properties and
6679 overlays are concerned. W is a window displaying current_buffer.
6681 REGION_BEG, REGION_END delimit the region, so it can be
6684 LIMIT is a position not to scan beyond. That is to limit the time
6685 this function can take.
6687 If MOUSE is non-zero, use the character's mouse-face, not its face.
6689 The face returned is suitable for displaying ASCII characters. */
6692 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6693 endptr
, limit
, mouse
)
6696 int region_beg
, region_end
;
6701 struct frame
*f
= XFRAME (w
->frame
);
6702 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6703 Lisp_Object prop
, position
;
6705 Lisp_Object
*overlay_vec
;
6708 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6709 Lisp_Object limit1
, end
;
6710 struct face
*default_face
;
6711 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6713 /* W must display the current buffer. We could write this function
6714 to use the frame and buffer of W, but right now it doesn't. */
6715 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6717 XSETFRAME (frame
, f
);
6718 XSETFASTINT (position
, pos
);
6721 if (pos
< region_beg
&& region_beg
< endpos
)
6722 endpos
= region_beg
;
6724 /* Get the `face' or `mouse_face' text property at POS, and
6725 determine the next position at which the property changes. */
6726 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6727 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6728 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6730 endpos
= XINT (end
);
6732 /* Look at properties from overlays. */
6737 /* First try with room for 40 overlays. */
6739 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6740 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6741 &next_overlay
, NULL
, 0);
6743 /* If there are more than 40, make enough space for all, and try
6745 if (noverlays
> len
)
6748 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6749 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6750 &next_overlay
, NULL
, 0);
6753 if (next_overlay
< endpos
)
6754 endpos
= next_overlay
;
6759 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6761 /* Optimize common cases where we can use the default face. */
6764 && !(pos
>= region_beg
&& pos
< region_end
))
6765 return DEFAULT_FACE_ID
;
6767 /* Begin with attributes from the default face. */
6768 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6770 /* Merge in attributes specified via text properties. */
6772 merge_face_vector_with_property (f
, attrs
, prop
);
6774 /* Now merge the overlay data. */
6775 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6776 for (i
= 0; i
< noverlays
; i
++)
6781 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6783 merge_face_vector_with_property (f
, attrs
, prop
);
6785 oend
= OVERLAY_END (overlay_vec
[i
]);
6786 oendpos
= OVERLAY_POSITION (oend
);
6787 if (oendpos
< endpos
)
6791 /* If in the region, merge in the region face. */
6792 if (pos
>= region_beg
&& pos
< region_end
)
6794 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6795 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6797 if (region_end
< endpos
)
6798 endpos
= region_end
;
6803 /* Look up a realized face with the given face attributes,
6804 or realize a new one for ASCII characters. */
6805 return lookup_face (f
, attrs
, 0, NULL
);
6809 /* Compute the face at character position POS in Lisp string STRING on
6810 window W, for ASCII characters.
6812 If STRING is an overlay string, it comes from position BUFPOS in
6813 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6814 not an overlay string. W must display the current buffer.
6815 REGION_BEG and REGION_END give the start and end positions of the
6816 region; both are -1 if no region is visible. BASE_FACE_ID is the
6817 id of the basic face to merge with. It is usually equal to
6818 DEFAULT_FACE_ID but can be MODE_LINE_FACE_ID or HEADER_LINE_FACE_ID
6819 for strings displayed in the mode or top line.
6821 Set *ENDPTR to the next position where to check for faces in
6822 STRING; -1 if the face is constant from POS to the end of the
6825 Value is the id of the face to use. The face returned is suitable
6826 for displaying ASCII characters. */
6829 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6830 region_end
, endptr
, base_face_id
)
6834 int region_beg
, region_end
;
6836 enum face_id base_face_id
;
6838 Lisp_Object prop
, position
, end
, limit
;
6839 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6840 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6841 struct face
*base_face
;
6842 int multibyte_p
= STRING_MULTIBYTE (string
);
6844 /* Get the value of the face property at the current position within
6845 STRING. Value is nil if there is no face property. */
6846 XSETFASTINT (position
, pos
);
6847 prop
= Fget_text_property (position
, Qface
, string
);
6849 /* Get the next position at which to check for faces. Value of end
6850 is nil if face is constant all the way to the end of the string.
6851 Otherwise it is a string position where to check faces next.
6852 Limit is the maximum position up to which to check for property
6853 changes in Fnext_single_property_change. Strings are usually
6854 short, so set the limit to the end of the string. */
6855 XSETFASTINT (limit
, XSTRING (string
)->size
);
6856 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6858 *endptr
= XFASTINT (end
);
6862 base_face
= FACE_FROM_ID (f
, base_face_id
);
6863 xassert (base_face
);
6865 /* Optimize the default case that there is no face property and we
6866 are not in the region. */
6868 && (base_face_id
!= DEFAULT_FACE_ID
6869 /* BUFPOS <= 0 means STRING is not an overlay string, so
6870 that the region doesn't have to be taken into account. */
6872 || bufpos
< region_beg
6873 || bufpos
>= region_end
)
6875 /* We can't realize faces for different charsets differently
6876 if we don't have fonts, so we can stop here if not working
6877 on a window-system frame. */
6878 || !FRAME_WINDOW_P (f
)
6879 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6880 return base_face
->id
;
6882 /* Begin with attributes from the base face. */
6883 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6885 /* Merge in attributes specified via text properties. */
6887 merge_face_vector_with_property (f
, attrs
, prop
);
6889 /* If in the region, merge in the region face. */
6891 && bufpos
>= region_beg
6892 && bufpos
< region_end
)
6894 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6895 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6898 /* Look up a realized face with the given face attributes,
6899 or realize a new one for ASCII characters. */
6900 return lookup_face (f
, attrs
, 0, NULL
);
6905 /***********************************************************************
6907 ***********************************************************************/
6911 /* Print the contents of the realized face FACE to stderr. */
6914 dump_realized_face (face
)
6917 fprintf (stderr
, "ID: %d\n", face
->id
);
6918 #ifdef HAVE_X_WINDOWS
6919 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6921 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6923 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6924 fprintf (stderr
, "background: 0x%lx (%s)\n",
6926 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6927 fprintf (stderr
, "font_name: %s (%s)\n",
6929 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6930 #ifdef HAVE_X_WINDOWS
6931 fprintf (stderr
, "font = %p\n", face
->font
);
6933 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6934 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6935 fprintf (stderr
, "underline: %d (%s)\n",
6937 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6938 fprintf (stderr
, "hash: %d\n", face
->hash
);
6939 fprintf (stderr
, "charset: %d\n", face
->charset
);
6943 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
6951 fprintf (stderr
, "font selection order: ");
6952 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
6953 fprintf (stderr
, "%d ", font_sort_order
[i
]);
6954 fprintf (stderr
, "\n");
6956 fprintf (stderr
, "alternative fonts: ");
6957 debug_print (Vface_alternative_font_family_alist
);
6958 fprintf (stderr
, "\n");
6960 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
6961 Fdump_face (make_number (i
));
6966 CHECK_NUMBER (n
, 0);
6967 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
6969 error ("Not a valid face");
6970 dump_realized_face (face
);
6977 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
6981 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
6982 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
6983 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
6987 #endif /* GLYPH_DEBUG != 0 */
6991 /***********************************************************************
6993 ***********************************************************************/
6998 Qface
= intern ("face");
7000 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7001 staticpro (&Qbitmap_spec_p
);
7002 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7003 staticpro (&Qframe_update_face_colors
);
7005 /* Lisp face attribute keywords. */
7006 QCfamily
= intern (":family");
7007 staticpro (&QCfamily
);
7008 QCheight
= intern (":height");
7009 staticpro (&QCheight
);
7010 QCweight
= intern (":weight");
7011 staticpro (&QCweight
);
7012 QCslant
= intern (":slant");
7013 staticpro (&QCslant
);
7014 QCunderline
= intern (":underline");
7015 staticpro (&QCunderline
);
7016 QCinverse_video
= intern (":inverse-video");
7017 staticpro (&QCinverse_video
);
7018 QCreverse_video
= intern (":reverse-video");
7019 staticpro (&QCreverse_video
);
7020 QCforeground
= intern (":foreground");
7021 staticpro (&QCforeground
);
7022 QCbackground
= intern (":background");
7023 staticpro (&QCbackground
);
7024 QCstipple
= intern (":stipple");;
7025 staticpro (&QCstipple
);
7026 QCwidth
= intern (":width");
7027 staticpro (&QCwidth
);
7028 QCfont
= intern (":font");
7029 staticpro (&QCfont
);
7030 QCbold
= intern (":bold");
7031 staticpro (&QCbold
);
7032 QCitalic
= intern (":italic");
7033 staticpro (&QCitalic
);
7034 QCoverline
= intern (":overline");
7035 staticpro (&QCoverline
);
7036 QCstrike_through
= intern (":strike-through");
7037 staticpro (&QCstrike_through
);
7038 QCbox
= intern (":box");
7040 QCinherit
= intern (":inherit");
7041 staticpro (&QCinherit
);
7043 /* Symbols used for Lisp face attribute values. */
7044 QCcolor
= intern (":color");
7045 staticpro (&QCcolor
);
7046 QCline_width
= intern (":line-width");
7047 staticpro (&QCline_width
);
7048 QCstyle
= intern (":style");
7049 staticpro (&QCstyle
);
7050 Qreleased_button
= intern ("released-button");
7051 staticpro (&Qreleased_button
);
7052 Qpressed_button
= intern ("pressed-button");
7053 staticpro (&Qpressed_button
);
7054 Qnormal
= intern ("normal");
7055 staticpro (&Qnormal
);
7056 Qultra_light
= intern ("ultra-light");
7057 staticpro (&Qultra_light
);
7058 Qextra_light
= intern ("extra-light");
7059 staticpro (&Qextra_light
);
7060 Qlight
= intern ("light");
7061 staticpro (&Qlight
);
7062 Qsemi_light
= intern ("semi-light");
7063 staticpro (&Qsemi_light
);
7064 Qsemi_bold
= intern ("semi-bold");
7065 staticpro (&Qsemi_bold
);
7066 Qbold
= intern ("bold");
7068 Qextra_bold
= intern ("extra-bold");
7069 staticpro (&Qextra_bold
);
7070 Qultra_bold
= intern ("ultra-bold");
7071 staticpro (&Qultra_bold
);
7072 Qoblique
= intern ("oblique");
7073 staticpro (&Qoblique
);
7074 Qitalic
= intern ("italic");
7075 staticpro (&Qitalic
);
7076 Qreverse_oblique
= intern ("reverse-oblique");
7077 staticpro (&Qreverse_oblique
);
7078 Qreverse_italic
= intern ("reverse-italic");
7079 staticpro (&Qreverse_italic
);
7080 Qultra_condensed
= intern ("ultra-condensed");
7081 staticpro (&Qultra_condensed
);
7082 Qextra_condensed
= intern ("extra-condensed");
7083 staticpro (&Qextra_condensed
);
7084 Qcondensed
= intern ("condensed");
7085 staticpro (&Qcondensed
);
7086 Qsemi_condensed
= intern ("semi-condensed");
7087 staticpro (&Qsemi_condensed
);
7088 Qsemi_expanded
= intern ("semi-expanded");
7089 staticpro (&Qsemi_expanded
);
7090 Qexpanded
= intern ("expanded");
7091 staticpro (&Qexpanded
);
7092 Qextra_expanded
= intern ("extra-expanded");
7093 staticpro (&Qextra_expanded
);
7094 Qultra_expanded
= intern ("ultra-expanded");
7095 staticpro (&Qultra_expanded
);
7096 Qbackground_color
= intern ("background-color");
7097 staticpro (&Qbackground_color
);
7098 Qforeground_color
= intern ("foreground-color");
7099 staticpro (&Qforeground_color
);
7100 Qunspecified
= intern ("unspecified");
7101 staticpro (&Qunspecified
);
7103 Qface_alias
= intern ("face-alias");
7104 staticpro (&Qface_alias
);
7105 Qdefault
= intern ("default");
7106 staticpro (&Qdefault
);
7107 Qtool_bar
= intern ("tool-bar");
7108 staticpro (&Qtool_bar
);
7109 Qregion
= intern ("region");
7110 staticpro (&Qregion
);
7111 Qfringe
= intern ("fringe");
7112 staticpro (&Qfringe
);
7113 Qheader_line
= intern ("header-line");
7114 staticpro (&Qheader_line
);
7115 Qscroll_bar
= intern ("scroll-bar");
7116 staticpro (&Qscroll_bar
);
7117 Qmenu
= intern ("menu");
7119 Qcursor
= intern ("cursor");
7120 staticpro (&Qcursor
);
7121 Qborder
= intern ("border");
7122 staticpro (&Qborder
);
7123 Qmouse
= intern ("mouse");
7124 staticpro (&Qmouse
);
7125 Qtty_color_desc
= intern ("tty-color-desc");
7126 staticpro (&Qtty_color_desc
);
7127 Qtty_color_by_index
= intern ("tty-color-by-index");
7128 staticpro (&Qtty_color_by_index
);
7129 Qtty_color_alist
= intern ("tty-color-alist");
7130 staticpro (&Qtty_color_alist
);
7132 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7133 staticpro (&Vparam_value_alist
);
7134 Vface_alternative_font_family_alist
= Qnil
;
7135 staticpro (&Vface_alternative_font_family_alist
);
7136 Vface_alternative_font_registry_alist
= Qnil
;
7137 staticpro (&Vface_alternative_font_registry_alist
);
7139 defsubr (&Sinternal_make_lisp_face
);
7140 defsubr (&Sinternal_lisp_face_p
);
7141 defsubr (&Sinternal_set_lisp_face_attribute
);
7142 #ifdef HAVE_WINDOW_SYSTEM
7143 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7145 defsubr (&Scolor_gray_p
);
7146 defsubr (&Scolor_supported_p
);
7147 defsubr (&Sinternal_get_lisp_face_attribute
);
7148 defsubr (&Sinternal_lisp_face_attribute_values
);
7149 defsubr (&Sinternal_lisp_face_equal_p
);
7150 defsubr (&Sinternal_lisp_face_empty_p
);
7151 defsubr (&Sinternal_copy_lisp_face
);
7152 defsubr (&Sinternal_merge_in_global_face
);
7153 defsubr (&Sface_font
);
7154 defsubr (&Sframe_face_alist
);
7155 defsubr (&Sinternal_set_font_selection_order
);
7156 defsubr (&Sinternal_set_alternative_font_family_alist
);
7157 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7159 defsubr (&Sdump_face
);
7160 defsubr (&Sshow_face_resources
);
7161 #endif /* GLYPH_DEBUG */
7162 defsubr (&Sclear_face_cache
);
7163 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7165 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7166 defsubr (&Sdump_colors
);
7169 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7170 "*Limit for font matching.\n\
7171 If an integer > 0, font matching functions won't load more than\n\
7172 that number of fonts when searching for a matching font.");
7173 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7175 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7176 "List of global face definitions (for internal use only.)");
7177 Vface_new_frame_defaults
= Qnil
;
7179 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7180 "*Default stipple pattern used on monochrome displays.\n\
7181 This stipple pattern is used on monochrome displays\n\
7182 instead of shades of gray for a face background color.\n\
7183 See `set-face-stipple' for possible values for this variable.");
7184 Vface_default_stipple
= build_string ("gray3");
7186 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7187 "An alist of defined terminal colors and their RGB values.");
7188 Vtty_defined_color_alist
= Qnil
;
7190 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7191 "Allowed scalable fonts.\n\
7192 A value of nil means don't allow any scalable fonts.\n\
7193 A value of t means allow any scalable font.\n\
7194 Otherwise, value must be a list of regular expressions. A font may be\n\
7195 scaled if its name matches a regular expression in the list.");
7196 #if defined (WINDOWSNT) || defined (macintosh)
7197 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7198 by default limits the fonts available severely. */
7199 Vscalable_fonts_allowed
= Qt
;
7201 Vscalable_fonts_allowed
= Qnil
;
7204 #ifdef HAVE_WINDOW_SYSTEM
7205 defsubr (&Sbitmap_spec_p
);
7206 defsubr (&Sx_list_fonts
);
7207 defsubr (&Sinternal_face_x_get_resource
);
7208 defsubr (&Sx_family_fonts
);
7209 defsubr (&Sx_font_family_list
);
7210 #endif /* HAVE_WINDOW_SYSTEM */