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
];
1831 /* Lower value mean higher priority. */
1832 int registry_priority
;
1835 /* The frame in effect when sorting font names. Set temporarily in
1836 sort_fonts so that it is available in font comparison functions. */
1838 static struct frame
*font_frame
;
1840 /* Order by which font selection chooses fonts. The default values
1841 mean `first, find a best match for the font width, then for the
1842 font height, then for weight, then for slant.' This variable can be
1843 set via set-face-font-sort-order. */
1846 static int font_sort_order
[4] = { XLFD_SWIDTH
, XLFD_POINT_SIZE
, XLFD_WEIGHT
, XLFD_SLANT
};
1848 static int font_sort_order
[4];
1851 /* Look up FONT.fields[FIELD_INDEX] in TABLE which has DIM entries.
1852 TABLE must be sorted by TABLE[i]->name in ascending order. Value
1853 is a pointer to the matching table entry or null if no table entry
1856 static struct table_entry
*
1857 xlfd_lookup_field_contents (table
, dim
, font
, field_index
)
1858 struct table_entry
*table
;
1860 struct font_name
*font
;
1863 /* Function split_font_name converts fields to lower-case, so there
1864 is no need to use xstrlwr or xstricmp here. */
1865 char *s
= font
->fields
[field_index
];
1866 int low
, mid
, high
, cmp
;
1873 mid
= (low
+ high
) / 2;
1874 cmp
= strcmp (table
[mid
].name
, s
);
1888 /* Return a numeric representation for font name field
1889 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1890 has DIM entries. Value is the numeric value found or DFLT if no
1891 table entry matches. This function is used to translate weight,
1892 slant, and swidth names of XLFD font names to numeric values. */
1895 xlfd_numeric_value (table
, dim
, font
, field_index
, dflt
)
1896 struct table_entry
*table
;
1898 struct font_name
*font
;
1902 struct table_entry
*p
;
1903 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1904 return p
? p
->numeric
: dflt
;
1908 /* Return a symbolic representation for font name field
1909 FONT.fields[FIELD_INDEX]. The field is looked up in TABLE which
1910 has DIM entries. Value is the symbolic value found or DFLT if no
1911 table entry matches. This function is used to translate weight,
1912 slant, and swidth names of XLFD font names to symbols. */
1914 static INLINE Lisp_Object
1915 xlfd_symbolic_value (table
, dim
, font
, field_index
, dflt
)
1916 struct table_entry
*table
;
1918 struct font_name
*font
;
1922 struct table_entry
*p
;
1923 p
= xlfd_lookup_field_contents (table
, dim
, font
, field_index
);
1924 return p
? *p
->symbol
: dflt
;
1928 /* Return a numeric value for the slant of the font given by FONT. */
1931 xlfd_numeric_slant (font
)
1932 struct font_name
*font
;
1934 return xlfd_numeric_value (slant_table
, DIM (slant_table
),
1935 font
, XLFD_SLANT
, XLFD_SLANT_ROMAN
);
1939 /* Return a symbol representing the weight of the font given by FONT. */
1941 static INLINE Lisp_Object
1942 xlfd_symbolic_slant (font
)
1943 struct font_name
*font
;
1945 return xlfd_symbolic_value (slant_table
, DIM (slant_table
),
1946 font
, XLFD_SLANT
, Qnormal
);
1950 /* Return a numeric value for the weight of the font given by FONT. */
1953 xlfd_numeric_weight (font
)
1954 struct font_name
*font
;
1956 return xlfd_numeric_value (weight_table
, DIM (weight_table
),
1957 font
, XLFD_WEIGHT
, XLFD_WEIGHT_MEDIUM
);
1961 /* Return a symbol representing the slant of the font given by FONT. */
1963 static INLINE Lisp_Object
1964 xlfd_symbolic_weight (font
)
1965 struct font_name
*font
;
1967 return xlfd_symbolic_value (weight_table
, DIM (weight_table
),
1968 font
, XLFD_WEIGHT
, Qnormal
);
1972 /* Return a numeric value for the swidth of the font whose XLFD font
1973 name fields are found in FONT. */
1976 xlfd_numeric_swidth (font
)
1977 struct font_name
*font
;
1979 return xlfd_numeric_value (swidth_table
, DIM (swidth_table
),
1980 font
, XLFD_SWIDTH
, XLFD_SWIDTH_MEDIUM
);
1984 /* Return a symbolic value for the swidth of FONT. */
1986 static INLINE Lisp_Object
1987 xlfd_symbolic_swidth (font
)
1988 struct font_name
*font
;
1990 return xlfd_symbolic_value (swidth_table
, DIM (swidth_table
),
1991 font
, XLFD_SWIDTH
, Qnormal
);
1995 /* Look up the entry of SYMBOL in the vector TABLE which has DIM
1996 entries. Value is a pointer to the matching table entry or null if
1997 no element of TABLE contains SYMBOL. */
1999 static struct table_entry
*
2000 face_value (table
, dim
, symbol
)
2001 struct table_entry
*table
;
2007 xassert (SYMBOLP (symbol
));
2009 for (i
= 0; i
< dim
; ++i
)
2010 if (EQ (*table
[i
].symbol
, symbol
))
2013 return i
< dim
? table
+ i
: NULL
;
2017 /* Return a numeric value for SYMBOL in the vector TABLE which has DIM
2018 entries. Value is -1 if SYMBOL is not found in TABLE. */
2021 face_numeric_value (table
, dim
, symbol
)
2022 struct table_entry
*table
;
2026 struct table_entry
*p
= face_value (table
, dim
, symbol
);
2027 return p
? p
->numeric
: -1;
2031 /* Return a numeric value representing the weight specified by Lisp
2032 symbol WEIGHT. Value is one of the enumerators of enum
2036 face_numeric_weight (weight
)
2039 return face_numeric_value (weight_table
, DIM (weight_table
), weight
);
2043 /* Return a numeric value representing the slant specified by Lisp
2044 symbol SLANT. Value is one of the enumerators of enum xlfd_slant. */
2047 face_numeric_slant (slant
)
2050 return face_numeric_value (slant_table
, DIM (slant_table
), slant
);
2054 /* Return a numeric value representing the swidth specified by Lisp
2055 symbol WIDTH. Value is one of the enumerators of enum xlfd_swidth. */
2058 face_numeric_swidth (width
)
2061 return face_numeric_value (swidth_table
, DIM (swidth_table
), width
);
2065 #ifdef HAVE_WINDOW_SYSTEM
2067 /* Return non-zero if FONT is the name of a fixed-pitch font. */
2071 struct font_name
*font
;
2073 /* Function split_font_name converts fields to lower-case, so there
2074 is no need to use tolower here. */
2075 return *font
->fields
[XLFD_SPACING
] != 'p';
2079 /* Return the point size of FONT on frame F, measured in 1/10 pt.
2081 The actual height of the font when displayed on F depends on the
2082 resolution of both the font and frame. For example, a 10pt font
2083 designed for a 100dpi display will display larger than 10pt on a
2084 75dpi display. (It's not unusual to use fonts not designed for the
2085 display one is using. For example, some intlfonts are available in
2086 72dpi versions, only.)
2088 Value is the real point size of FONT on frame F, or 0 if it cannot
2092 xlfd_point_size (f
, font
)
2094 struct font_name
*font
;
2096 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2097 double font_resy
= atoi (font
->fields
[XLFD_RESY
]);
2098 double font_pt
= atoi (font
->fields
[XLFD_POINT_SIZE
]);
2101 if (font_resy
== 0 || font_pt
== 0)
2104 real_pt
= (font_resy
/ resy
) * font_pt
+ 0.5;
2110 /* Return point size of PIXEL dots while considering Y-resultion (DPI)
2111 of frame F. This function is used to guess a point size of font
2112 when only the pixel height of the font is available. */
2115 pixel_point_size (f
, pixel
)
2119 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
2123 /* As one inch is 72 points, 72/RESY gives the point size of one dot. */
2124 real_pt
= pixel
* 72 / resy
;
2125 int_pt
= real_pt
+ 0.5;
2131 /* Split XLFD font name FONT->name destructively into NUL-terminated,
2132 lower-case fields in FONT->fields. NUMERIC_P non-zero means
2133 compute numeric values for fields XLFD_POINT_SIZE, XLFD_SWIDTH,
2134 XLFD_RESY, XLFD_SLANT, and XLFD_WEIGHT in FONT->numeric. Value is
2135 zero if the font name doesn't have the format we expect. The
2136 expected format is a font name that starts with a `-' and has
2137 XLFD_LAST fields separated by `-'. (The XLFD specification allows
2138 forms of font names where certain field contents are enclosed in
2139 square brackets. We don't support that, for now. */
2142 split_font_name (f
, font
, numeric_p
)
2144 struct font_name
*font
;
2150 if (*font
->name
== '-')
2152 char *p
= xstrlwr (font
->name
) + 1;
2154 while (i
< XLFD_LAST
)
2156 font
->fields
[i
] = p
;
2159 while (*p
&& *p
!= '-')
2169 success_p
= i
== XLFD_LAST
;
2171 /* If requested, and font name was in the expected format,
2172 compute numeric values for some fields. */
2173 if (numeric_p
&& success_p
)
2175 font
->numeric
[XLFD_POINT_SIZE
] = xlfd_point_size (f
, font
);
2176 font
->numeric
[XLFD_RESY
] = atoi (font
->fields
[XLFD_RESY
]);
2177 font
->numeric
[XLFD_SLANT
] = xlfd_numeric_slant (font
);
2178 font
->numeric
[XLFD_WEIGHT
] = xlfd_numeric_weight (font
);
2179 font
->numeric
[XLFD_SWIDTH
] = xlfd_numeric_swidth (font
);
2182 /* Initialize it to zero. It will be overridden by font_list while
2183 trying alternate registries. */
2184 font
->registry_priority
= 0;
2190 /* Build an XLFD font name from font name fields in FONT. Value is a
2191 pointer to the font name, which is allocated via xmalloc. */
2194 build_font_name (font
)
2195 struct font_name
*font
;
2199 char *font_name
= (char *) xmalloc (size
);
2200 int total_length
= 0;
2202 for (i
= 0; i
< XLFD_LAST
; ++i
)
2204 /* Add 1 because of the leading `-'. */
2205 int len
= strlen (font
->fields
[i
]) + 1;
2207 /* Reallocate font_name if necessary. Add 1 for the final
2209 if (total_length
+ len
+ 1 >= size
)
2211 int new_size
= max (2 * size
, size
+ len
+ 1);
2212 int sz
= new_size
* sizeof *font_name
;
2213 font_name
= (char *) xrealloc (font_name
, sz
);
2217 font_name
[total_length
] = '-';
2218 bcopy (font
->fields
[i
], font_name
+ total_length
+ 1, len
- 1);
2219 total_length
+= len
;
2222 font_name
[total_length
] = 0;
2227 /* Free an array FONTS of N font_name structures. This frees FONTS
2228 itself and all `name' fields in its elements. */
2231 free_font_names (fonts
, n
)
2232 struct font_name
*fonts
;
2236 xfree (fonts
[--n
].name
);
2241 /* Sort vector FONTS of font_name structures which contains NFONTS
2242 elements using qsort and comparison function CMPFN. F is the frame
2243 on which the fonts will be used. The global variable font_frame
2244 is temporarily set to F to make it available in CMPFN. */
2247 sort_fonts (f
, fonts
, nfonts
, cmpfn
)
2249 struct font_name
*fonts
;
2251 int (*cmpfn
) P_ ((const void *, const void *));
2254 qsort (fonts
, nfonts
, sizeof *fonts
, cmpfn
);
2259 /* Get fonts matching PATTERN on frame F. If F is null, use the first
2260 display in x_display_list. FONTS is a pointer to a vector of
2261 NFONTS font_name structures. TRY_ALTERNATIVES_P non-zero means try
2262 alternative patterns from Valternate_fontname_alist if no fonts are
2263 found matching PATTERN. SCALABLE_FONTS_P non-zero means include
2266 For all fonts found, set FONTS[i].name to the name of the font,
2267 allocated via xmalloc, and split font names into fields. Ignore
2268 fonts that we can't parse. Value is the number of fonts found.
2270 This is similar to x_list_fonts. The differences are:
2272 1. It avoids consing.
2273 2. It never calls XLoadQueryFont. */
2276 x_face_list_fonts (f
, pattern
, fonts
, nfonts
, try_alternatives_p
,
2280 struct font_name
*fonts
;
2281 int nfonts
, try_alternatives_p
;
2282 int scalable_fonts_p
;
2286 #ifdef HAVE_X_WINDOWS
2287 Display
*dpy
= f
? FRAME_X_DISPLAY (f
) : x_display_list
->display
;
2289 /* Get the list of fonts matching PATTERN from the X server. */
2291 names
= XListFonts (dpy
, pattern
, nfonts
, &n
);
2293 #endif /* HAVE_X_WINDOWS */
2294 #if defined (WINDOWSNT) || defined (macintosh)
2295 /* NTEMACS_TODO : currently this uses w32_list_fonts, but it may be
2296 better to do it the other way around. */
2298 Lisp_Object lpattern
, tem
;
2303 lpattern
= build_string (pattern
);
2305 /* Get the list of fonts matching PATTERN. */
2308 lfonts
= w32_list_fonts (f
, lpattern
, 0, nfonts
);
2309 #else /* macintosh */
2310 lfonts
= x_list_fonts (f
, lpattern
, 0, nfonts
);
2314 /* Count fonts returned */
2315 for (tem
= lfonts
; CONSP (tem
); tem
= XCDR (tem
))
2318 /* Allocate array. */
2320 names
= (char **) xmalloc (n
* sizeof (char *));
2322 /* Extract font names into char * array. */
2324 for (i
= 0; i
< n
; i
++)
2326 names
[i
] = XSTRING (XCAR (tem
))->data
;
2329 #endif /* defined (WINDOWSNT) || defined (macintosh) */
2333 /* Make a copy of the font names we got from X, and
2334 split them into fields. */
2335 for (i
= j
= 0; i
< n
; ++i
)
2337 /* Make a copy of the font name. */
2338 fonts
[j
].name
= xstrdup (names
[i
]);
2340 /* Ignore fonts having a name that we can't parse. */
2341 if (!split_font_name (f
, fonts
+ j
, 1))
2342 xfree (fonts
[j
].name
);
2343 else if (font_scalable_p (fonts
+ j
))
2345 if (!scalable_fonts_p
2346 || !may_use_scalable_font_p (fonts
+ j
, names
[i
]))
2347 xfree (fonts
[j
].name
);
2357 #ifdef HAVE_X_WINDOWS
2358 /* Free font names. */
2360 XFreeFontNames (names
);
2366 /* If no fonts found, try patterns from Valternate_fontname_alist. */
2367 if (n
== 0 && try_alternatives_p
)
2369 Lisp_Object list
= Valternate_fontname_alist
;
2371 while (CONSP (list
))
2373 Lisp_Object entry
= XCAR (list
);
2375 && STRINGP (XCAR (entry
))
2376 && strcmp (XSTRING (XCAR (entry
))->data
, pattern
) == 0)
2383 Lisp_Object patterns
= XCAR (list
);
2386 while (CONSP (patterns
)
2387 /* If list is screwed up, give up. */
2388 && (name
= XCAR (patterns
),
2390 /* Ignore patterns equal to PATTERN because we tried that
2391 already with no success. */
2392 && (strcmp (XSTRING (name
)->data
, pattern
) == 0
2393 || (n
= x_face_list_fonts (f
, XSTRING (name
)->data
,
2397 patterns
= XCDR (patterns
);
2405 /* Determine the first font matching PATTERN on frame F. Return in
2406 *FONT the matching font name, split into fields. Value is non-zero
2407 if a match was found. */
2410 first_font_matching (f
, pattern
, font
)
2413 struct font_name
*font
;
2416 struct font_name
*fonts
;
2418 fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof *fonts
);
2419 nfonts
= x_face_list_fonts (f
, pattern
, fonts
, nfonts
, 1, 0);
2423 bcopy (&fonts
[0], font
, sizeof *font
);
2425 fonts
[0].name
= NULL
;
2426 free_font_names (fonts
, nfonts
);
2433 /* Determine fonts matching PATTERN on frame F. Sort resulting fonts
2434 using comparison function CMPFN. Value is the number of fonts
2435 found. If value is non-zero, *FONTS is set to a vector of
2436 font_name structures allocated from the heap containing matching
2437 fonts. Each element of *FONTS contains a name member that is also
2438 allocated from the heap. Font names in these structures are split
2439 into fields. Use free_font_names to free such an array. */
2442 sorted_font_list (f
, pattern
, cmpfn
, fonts
)
2445 int (*cmpfn
) P_ ((const void *, const void *));
2446 struct font_name
**fonts
;
2450 /* Get the list of fonts matching pattern. 100 should suffice. */
2451 nfonts
= DEFAULT_FONT_LIST_LIMIT
;
2452 if (INTEGERP (Vfont_list_limit
) && XINT (Vfont_list_limit
) > 0)
2453 nfonts
= XFASTINT (Vfont_list_limit
);
2455 *fonts
= (struct font_name
*) xmalloc (nfonts
* sizeof **fonts
);
2456 nfonts
= x_face_list_fonts (f
, pattern
, *fonts
, nfonts
, 1, 1);
2458 /* Sort the resulting array and return it in *FONTS. If no
2459 fonts were found, make sure to set *FONTS to null. */
2461 sort_fonts (f
, *fonts
, nfonts
, cmpfn
);
2472 /* Compare two font_name structures *A and *B. Value is analogous to
2473 strcmp. Sort order is given by the global variable
2474 font_sort_order. Font names are sorted so that, everything else
2475 being equal, fonts with a resolution closer to that of the frame on
2476 which they are used are listed first. The global variable
2477 font_frame is the frame on which we operate. */
2480 cmp_font_names (a
, b
)
2483 struct font_name
*x
= (struct font_name
*) a
;
2484 struct font_name
*y
= (struct font_name
*) b
;
2487 /* All strings have been converted to lower-case by split_font_name,
2488 so we can use strcmp here. */
2489 cmp
= strcmp (x
->fields
[XLFD_FAMILY
], y
->fields
[XLFD_FAMILY
]);
2494 for (i
= 0; i
< DIM (font_sort_order
) && cmp
== 0; ++i
)
2496 int j
= font_sort_order
[i
];
2497 cmp
= x
->numeric
[j
] - y
->numeric
[j
];
2502 /* Everything else being equal, we prefer fonts with an
2503 y-resolution closer to that of the frame. */
2504 int resy
= FRAME_X_DISPLAY_INFO (font_frame
)->resy
;
2505 int x_resy
= x
->numeric
[XLFD_RESY
];
2506 int y_resy
= y
->numeric
[XLFD_RESY
];
2507 cmp
= abs (resy
- x_resy
) - abs (resy
- y_resy
);
2515 /* Get a sorted list of fonts of family FAMILY on frame F. If PATTERN
2516 is non-nil list fonts matching that pattern. Otherwise, if
2517 REGISTRY is non-nil return only fonts with that registry, otherwise
2518 return fonts of any registry. Set *FONTS to a vector of font_name
2519 structures allocated from the heap containing the fonts found.
2520 Value is the number of fonts found. */
2523 font_list_1 (f
, pattern
, family
, registry
, fonts
)
2525 Lisp_Object pattern
, family
, registry
;
2526 struct font_name
**fonts
;
2528 char *pattern_str
, *family_str
, *registry_str
;
2532 family_str
= (NILP (family
) ? "*" : (char *) XSTRING (family
)->data
);
2533 registry_str
= (NILP (registry
) ? "*" : (char *) XSTRING (registry
)->data
);
2535 pattern_str
= (char *) alloca (strlen (family_str
)
2536 + strlen (registry_str
)
2538 strcpy (pattern_str
, index (family_str
, '-') ? "-" : "-*-");
2539 strcat (pattern_str
, family_str
);
2540 strcat (pattern_str
, "-*-");
2541 strcat (pattern_str
, registry_str
);
2542 if (!index (registry_str
, '-'))
2544 if (registry_str
[strlen (registry_str
) - 1] == '*')
2545 strcat (pattern_str
, "-*");
2547 strcat (pattern_str
, "*-*");
2551 pattern_str
= (char *) XSTRING (pattern
)->data
;
2553 return sorted_font_list (f
, pattern_str
, cmp_font_names
, fonts
);
2557 /* Concatenate font list FONTS1 and FONTS2. FONTS1 and FONTS2
2558 contains NFONTS1 fonts and NFONTS2 fonts respectively. Return a
2559 pointer to a newly allocated font list. FONTS1 and FONTS2 are
2562 static struct font_name
*
2563 concat_font_list (fonts1
, nfonts1
, fonts2
, nfonts2
)
2564 struct font_name
*fonts1
, *fonts2
;
2565 int nfonts1
, nfonts2
;
2567 int new_nfonts
= nfonts1
+ nfonts2
;
2568 struct font_name
*new_fonts
;
2570 new_fonts
= (struct font_name
*) xmalloc (sizeof *new_fonts
* new_nfonts
);
2571 bcopy (fonts1
, new_fonts
, sizeof *new_fonts
* nfonts1
);
2572 bcopy (fonts2
, new_fonts
+ nfonts1
, sizeof *new_fonts
* nfonts2
);
2579 /* Get a sorted list of fonts of family FAMILY on frame F.
2581 If PATTERN is non-nil list fonts matching that pattern.
2583 If REGISTRY is non-nil, return fonts with that registry and the
2584 alternative registries from Vface_alternative_font_registry_alist.
2586 If REGISTRY is nil return fonts of any registry.
2588 Set *FONTS to a vector of font_name structures allocated from the
2589 heap containing the fonts found. Value is the number of fonts
2593 font_list (f
, pattern
, family
, registry
, fonts
)
2595 Lisp_Object pattern
, family
, registry
;
2596 struct font_name
**fonts
;
2598 int nfonts
= font_list_1 (f
, pattern
, family
, registry
, fonts
);
2600 if (!NILP (registry
)
2601 && CONSP (Vface_alternative_font_registry_alist
))
2605 alter
= Fassoc (registry
, Vface_alternative_font_registry_alist
);
2610 for (alter
= XCDR (alter
), reg_prio
= 1;
2612 alter
= XCDR (alter
), reg_prio
++)
2613 if (STRINGP (XCAR (alter
)))
2616 struct font_name
*fonts2
;
2618 nfonts2
= font_list_1 (f
, pattern
, family
, XCAR (alter
),
2620 for (i
= 0; i
< nfonts2
; i
++)
2621 fonts2
[i
].registry_priority
= reg_prio
;
2622 *fonts
= (nfonts
> 0
2623 ? concat_font_list (*fonts
, nfonts
, fonts2
, nfonts2
)
2634 /* Remove elements from LIST whose cars are `equal'. Called from
2635 x-family-fonts and x-font-family-list to remove duplicate font
2639 remove_duplicates (list
)
2642 Lisp_Object tail
= list
;
2644 while (!NILP (tail
) && !NILP (XCDR (tail
)))
2646 Lisp_Object next
= XCDR (tail
);
2647 if (!NILP (Fequal (XCAR (next
), XCAR (tail
))))
2648 XCDR (tail
) = XCDR (next
);
2655 DEFUN ("x-family-fonts", Fx_family_fonts
, Sx_family_fonts
, 0, 2, 0,
2656 "Return a list of available fonts of family FAMILY on FRAME.\n\
2657 If FAMILY is omitted or nil, list all families.\n\
2658 Otherwise, FAMILY must be a string, possibly containing wildcards\n\
2660 If FRAME is omitted or nil, use the selected frame.\n\
2661 Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT\n\
2662 SLANT FIXED-P FULL REGISTRY-AND-ENCODING].\n\
2663 FAMILY is the font family name. POINT-SIZE is the size of the\n\
2664 font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the\n\
2665 width, weight and slant of the font. These symbols are the same as for\n\
2666 face attributes. FIXED-P is non-nil if the font is fixed-pitch.\n\
2667 FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string\n\
2668 giving the registry and encoding of the font.\n\
2669 The result list is sorted according to the current setting of\n\
2670 the face font sort order.")
2672 Lisp_Object family
, frame
;
2674 struct frame
*f
= check_x_frame (frame
);
2675 struct font_name
*fonts
;
2678 struct gcpro gcpro1
;
2681 CHECK_STRING (family
, 1);
2685 nfonts
= font_list (f
, Qnil
, family
, Qnil
, &fonts
);
2686 for (i
= nfonts
- 1; i
>= 0; --i
)
2688 Lisp_Object v
= Fmake_vector (make_number (8), Qnil
);
2691 ASET (v
, 0, build_string (fonts
[i
].fields
[XLFD_FAMILY
]));
2692 ASET (v
, 1, xlfd_symbolic_swidth (fonts
+ i
));
2693 ASET (v
, 2, make_number (xlfd_point_size (f
, fonts
+ i
)));
2694 ASET (v
, 3, xlfd_symbolic_weight (fonts
+ i
));
2695 ASET (v
, 4, xlfd_symbolic_slant (fonts
+ i
));
2696 ASET (v
, 5, xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
);
2697 tem
= build_font_name (fonts
+ i
);
2698 ASET (v
, 6, build_string (tem
));
2699 sprintf (tem
, "%s-%s", fonts
[i
].fields
[XLFD_REGISTRY
],
2700 fonts
[i
].fields
[XLFD_ENCODING
]);
2701 ASET (v
, 7, build_string (tem
));
2704 result
= Fcons (v
, result
);
2707 remove_duplicates (result
);
2708 free_font_names (fonts
, nfonts
);
2714 DEFUN ("x-font-family-list", Fx_font_family_list
, Sx_font_family_list
,
2716 "Return a list of available font families on FRAME.\n\
2717 If FRAME is omitted or nil, use the selected frame.\n\
2718 Value is a list of conses (FAMILY . FIXED-P) where FAMILY\n\
2719 is a font family, and FIXED-P is non-nil if fonts of that family\n\
2724 struct frame
*f
= check_x_frame (frame
);
2726 struct font_name
*fonts
;
2728 struct gcpro gcpro1
;
2729 int count
= specpdl_ptr
- specpdl
;
2732 /* Let's consider all fonts. Increase the limit for matching
2733 fonts until we have them all. */
2736 specbind (intern ("font-list-limit"), make_number (limit
));
2737 nfonts
= font_list (f
, Qnil
, Qnil
, Qnil
, &fonts
);
2739 if (nfonts
== limit
)
2741 free_font_names (fonts
, nfonts
);
2750 for (i
= nfonts
- 1; i
>= 0; --i
)
2751 result
= Fcons (Fcons (build_string (fonts
[i
].fields
[XLFD_FAMILY
]),
2752 xlfd_fixed_p (fonts
+ i
) ? Qt
: Qnil
),
2755 remove_duplicates (result
);
2756 free_font_names (fonts
, nfonts
);
2758 return unbind_to (count
, result
);
2762 DEFUN ("x-list-fonts", Fx_list_fonts
, Sx_list_fonts
, 1, 5, 0,
2763 "Return a list of the names of available fonts matching PATTERN.\n\
2764 If optional arguments FACE and FRAME are specified, return only fonts\n\
2765 the same size as FACE on FRAME.\n\
2766 PATTERN is a string, perhaps with wildcard characters;\n\
2767 the * character matches any substring, and\n\
2768 the ? character matches any single character.\n\
2769 PATTERN is case-insensitive.\n\
2770 FACE is a face name--a symbol.\n\
2772 The return value is a list of strings, suitable as arguments to\n\
2775 Fonts Emacs can't use may or may not be excluded\n\
2776 even if they match PATTERN and FACE.\n\
2777 The optional fourth argument MAXIMUM sets a limit on how many\n\
2778 fonts to match. The first MAXIMUM fonts are reported.\n\
2779 The optional fifth argument WIDTH, if specified, is a number of columns\n\
2780 occupied by a character of a font. In that case, return only fonts\n\
2781 the WIDTH times as wide as FACE on FRAME.")
2782 (pattern
, face
, frame
, maximum
, width
)
2783 Lisp_Object pattern
, face
, frame
, maximum
, width
;
2790 CHECK_STRING (pattern
, 0);
2796 CHECK_NATNUM (maximum
, 0);
2797 maxnames
= XINT (maximum
);
2801 CHECK_NUMBER (width
, 4);
2803 /* We can't simply call check_x_frame because this function may be
2804 called before any frame is created. */
2805 f
= frame_or_selected_frame (frame
, 2);
2806 if (!FRAME_WINDOW_P (f
))
2808 /* Perhaps we have not yet created any frame. */
2813 /* Determine the width standard for comparison with the fonts we find. */
2819 /* This is of limited utility since it works with character
2820 widths. Keep it for compatibility. --gerd. */
2821 int face_id
= lookup_named_face (f
, face
, 0);
2822 struct face
*face
= (face_id
< 0
2824 : FACE_FROM_ID (f
, face_id
));
2826 if (face
&& face
->font
)
2827 size
= FONT_WIDTH (face
->font
);
2829 size
= FONT_WIDTH (FRAME_FONT (f
));
2832 size
*= XINT (width
);
2836 Lisp_Object args
[2];
2838 args
[0] = x_list_fonts (f
, pattern
, size
, maxnames
);
2840 /* We don't have to check fontsets. */
2842 args
[1] = list_fontsets (f
, pattern
, size
);
2843 return Fnconc (2, args
);
2847 #endif /* HAVE_WINDOW_SYSTEM */
2851 /***********************************************************************
2853 ***********************************************************************/
2855 /* Access face attributes of face FACE, a Lisp vector. */
2857 #define LFACE_FAMILY(LFACE) \
2858 XVECTOR (LFACE)->contents[LFACE_FAMILY_INDEX]
2859 #define LFACE_HEIGHT(LFACE) \
2860 XVECTOR (LFACE)->contents[LFACE_HEIGHT_INDEX]
2861 #define LFACE_WEIGHT(LFACE) \
2862 XVECTOR (LFACE)->contents[LFACE_WEIGHT_INDEX]
2863 #define LFACE_SLANT(LFACE) \
2864 XVECTOR (LFACE)->contents[LFACE_SLANT_INDEX]
2865 #define LFACE_UNDERLINE(LFACE) \
2866 XVECTOR (LFACE)->contents[LFACE_UNDERLINE_INDEX]
2867 #define LFACE_INVERSE(LFACE) \
2868 XVECTOR (LFACE)->contents[LFACE_INVERSE_INDEX]
2869 #define LFACE_FOREGROUND(LFACE) \
2870 XVECTOR (LFACE)->contents[LFACE_FOREGROUND_INDEX]
2871 #define LFACE_BACKGROUND(LFACE) \
2872 XVECTOR (LFACE)->contents[LFACE_BACKGROUND_INDEX]
2873 #define LFACE_STIPPLE(LFACE) \
2874 XVECTOR (LFACE)->contents[LFACE_STIPPLE_INDEX]
2875 #define LFACE_SWIDTH(LFACE) \
2876 XVECTOR (LFACE)->contents[LFACE_SWIDTH_INDEX]
2877 #define LFACE_OVERLINE(LFACE) \
2878 XVECTOR (LFACE)->contents[LFACE_OVERLINE_INDEX]
2879 #define LFACE_STRIKE_THROUGH(LFACE) \
2880 XVECTOR (LFACE)->contents[LFACE_STRIKE_THROUGH_INDEX]
2881 #define LFACE_BOX(LFACE) \
2882 XVECTOR (LFACE)->contents[LFACE_BOX_INDEX]
2883 #define LFACE_FONT(LFACE) \
2884 XVECTOR (LFACE)->contents[LFACE_FONT_INDEX]
2885 #define LFACE_INHERIT(LFACE) \
2886 XVECTOR (LFACE)->contents[LFACE_INHERIT_INDEX]
2888 /* Non-zero if LFACE is a Lisp face. A Lisp face is a vector of size
2889 LFACE_VECTOR_SIZE which has the symbol `face' in slot 0. */
2891 #define LFACEP(LFACE) \
2893 && XVECTOR (LFACE)->size == LFACE_VECTOR_SIZE \
2894 && EQ (XVECTOR (LFACE)->contents[0], Qface))
2899 /* Check consistency of Lisp face attribute vector ATTRS. */
2902 check_lface_attrs (attrs
)
2905 xassert (UNSPECIFIEDP (attrs
[LFACE_FAMILY_INDEX
])
2906 || STRINGP (attrs
[LFACE_FAMILY_INDEX
]));
2907 xassert (UNSPECIFIEDP (attrs
[LFACE_SWIDTH_INDEX
])
2908 || SYMBOLP (attrs
[LFACE_SWIDTH_INDEX
]));
2909 xassert (UNSPECIFIEDP (attrs
[LFACE_HEIGHT_INDEX
])
2910 || INTEGERP (attrs
[LFACE_HEIGHT_INDEX
])
2911 || FLOATP (attrs
[LFACE_HEIGHT_INDEX
])
2912 || FUNCTIONP (attrs
[LFACE_HEIGHT_INDEX
]));
2913 xassert (UNSPECIFIEDP (attrs
[LFACE_WEIGHT_INDEX
])
2914 || SYMBOLP (attrs
[LFACE_WEIGHT_INDEX
]));
2915 xassert (UNSPECIFIEDP (attrs
[LFACE_SLANT_INDEX
])
2916 || SYMBOLP (attrs
[LFACE_SLANT_INDEX
]));
2917 xassert (UNSPECIFIEDP (attrs
[LFACE_UNDERLINE_INDEX
])
2918 || SYMBOLP (attrs
[LFACE_UNDERLINE_INDEX
])
2919 || STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]));
2920 xassert (UNSPECIFIEDP (attrs
[LFACE_OVERLINE_INDEX
])
2921 || SYMBOLP (attrs
[LFACE_OVERLINE_INDEX
])
2922 || STRINGP (attrs
[LFACE_OVERLINE_INDEX
]));
2923 xassert (UNSPECIFIEDP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2924 || SYMBOLP (attrs
[LFACE_STRIKE_THROUGH_INDEX
])
2925 || STRINGP (attrs
[LFACE_STRIKE_THROUGH_INDEX
]));
2926 xassert (UNSPECIFIEDP (attrs
[LFACE_BOX_INDEX
])
2927 || SYMBOLP (attrs
[LFACE_BOX_INDEX
])
2928 || STRINGP (attrs
[LFACE_BOX_INDEX
])
2929 || INTEGERP (attrs
[LFACE_BOX_INDEX
])
2930 || CONSP (attrs
[LFACE_BOX_INDEX
]));
2931 xassert (UNSPECIFIEDP (attrs
[LFACE_INVERSE_INDEX
])
2932 || SYMBOLP (attrs
[LFACE_INVERSE_INDEX
]));
2933 xassert (UNSPECIFIEDP (attrs
[LFACE_FOREGROUND_INDEX
])
2934 || STRINGP (attrs
[LFACE_FOREGROUND_INDEX
]));
2935 xassert (UNSPECIFIEDP (attrs
[LFACE_BACKGROUND_INDEX
])
2936 || STRINGP (attrs
[LFACE_BACKGROUND_INDEX
]));
2937 xassert (UNSPECIFIEDP (attrs
[LFACE_INHERIT_INDEX
])
2938 || NILP (attrs
[LFACE_INHERIT_INDEX
])
2939 || SYMBOLP (attrs
[LFACE_INHERIT_INDEX
])
2940 || CONSP (attrs
[LFACE_INHERIT_INDEX
]));
2941 #ifdef HAVE_WINDOW_SYSTEM
2942 xassert (UNSPECIFIEDP (attrs
[LFACE_STIPPLE_INDEX
])
2943 || SYMBOLP (attrs
[LFACE_STIPPLE_INDEX
])
2944 || !NILP (Fbitmap_spec_p (attrs
[LFACE_STIPPLE_INDEX
])));
2945 xassert (UNSPECIFIEDP (attrs
[LFACE_FONT_INDEX
])
2946 || NILP (attrs
[LFACE_FONT_INDEX
])
2947 || STRINGP (attrs
[LFACE_FONT_INDEX
]));
2952 /* Check consistency of attributes of Lisp face LFACE (a Lisp vector). */
2960 xassert (LFACEP (lface
));
2961 check_lface_attrs (XVECTOR (lface
)->contents
);
2965 #else /* GLYPH_DEBUG == 0 */
2967 #define check_lface_attrs(attrs) (void) 0
2968 #define check_lface(lface) (void) 0
2970 #endif /* GLYPH_DEBUG == 0 */
2973 /* Resolve face name FACE_NAME. If FACE_NAME is a string, intern it
2974 to make it a symvol. If FACE_NAME is an alias for another face,
2975 return that face's name. */
2978 resolve_face_name (face_name
)
2979 Lisp_Object face_name
;
2981 Lisp_Object aliased
;
2983 if (STRINGP (face_name
))
2984 face_name
= intern (XSTRING (face_name
)->data
);
2986 while (SYMBOLP (face_name
))
2988 aliased
= Fget (face_name
, Qface_alias
);
2992 face_name
= aliased
;
2999 /* Return the face definition of FACE_NAME on frame F. F null means
3000 return the definition for new frames. FACE_NAME may be a string or
3001 a symbol (apparently Emacs 20.2 allowed strings as face names in
3002 face text properties; Ediff uses that). If FACE_NAME is an alias
3003 for another face, return that face's definition. If SIGNAL_P is
3004 non-zero, signal an error if FACE_NAME is not a valid face name.
3005 If SIGNAL_P is zero, value is nil if FACE_NAME is not a valid face
3008 static INLINE Lisp_Object
3009 lface_from_face_name (f
, face_name
, signal_p
)
3011 Lisp_Object face_name
;
3016 face_name
= resolve_face_name (face_name
);
3019 lface
= assq_no_quit (face_name
, f
->face_alist
);
3021 lface
= assq_no_quit (face_name
, Vface_new_frame_defaults
);
3024 lface
= XCDR (lface
);
3026 signal_error ("Invalid face", face_name
);
3028 check_lface (lface
);
3033 /* Get face attributes of face FACE_NAME from frame-local faces on
3034 frame F. Store the resulting attributes in ATTRS which must point
3035 to a vector of Lisp_Objects of size LFACE_VECTOR_SIZE. If SIGNAL_P
3036 is non-zero, signal an error if FACE_NAME does not name a face.
3037 Otherwise, value is zero if FACE_NAME is not a face. */
3040 get_lface_attributes (f
, face_name
, attrs
, signal_p
)
3042 Lisp_Object face_name
;
3049 lface
= lface_from_face_name (f
, face_name
, signal_p
);
3052 bcopy (XVECTOR (lface
)->contents
, attrs
,
3053 LFACE_VECTOR_SIZE
* sizeof *attrs
);
3063 /* Non-zero if all attributes in face attribute vector ATTRS are
3064 specified, i.e. are non-nil. */
3067 lface_fully_specified_p (attrs
)
3072 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3073 if (i
!= LFACE_FONT_INDEX
&& i
!= LFACE_INHERIT_INDEX
)
3074 if (UNSPECIFIEDP (attrs
[i
]))
3077 return i
== LFACE_VECTOR_SIZE
;
3080 #ifdef HAVE_WINDOW_SYSTEM
3082 /* Set font-related attributes of Lisp face LFACE from the fullname of
3083 the font opened by FONTNAME. If FORCE_P is zero, set only
3084 unspecified attributes of LFACE. The exception is `font'
3085 attribute. It is set to FONTNAME as is regardless of FORCE_P.
3087 If FONTNAME is not available on frame F,
3088 return 0 if MAY_FAIL_P is non-zero, otherwise abort.
3089 If the fullname is not in a valid XLFD format,
3090 return 0 if MAY_FAIL_P is non-zero, otherwise set normal values
3091 in LFACE and return 1.
3092 Otherwise, return 1. */
3095 set_lface_from_font_name (f
, lface
, fontname
, force_p
, may_fail_p
)
3098 Lisp_Object fontname
;
3099 int force_p
, may_fail_p
;
3101 struct font_name font
;
3106 char *font_name
= XSTRING (fontname
)->data
;
3107 struct font_info
*font_info
;
3109 /* If FONTNAME is actually a fontset name, get ASCII font name of it. */
3110 fontset
= fs_query_fontset (fontname
, 0);
3112 font_name
= XSTRING (fontset_ascii (fontset
))->data
;
3114 /* Check if FONT_NAME is surely available on the system. Usually
3115 FONT_NAME is already cached for the frame F and FS_LOAD_FONT
3116 returns quickly. But, even if FONT_NAME is not yet cached,
3117 caching it now is not futail because we anyway load the font
3120 font_info
= FS_LOAD_FONT (f
, 0, font_name
, -1);
3130 font
.name
= STRDUPA (font_info
->full_name
);
3131 have_xlfd_p
= split_font_name (f
, &font
, 1);
3133 /* Set attributes only if unspecified, otherwise face defaults for
3134 new frames would never take effect. If we couldn't get a font
3135 name conforming to XLFD, set normal values. */
3137 if (force_p
|| UNSPECIFIEDP (LFACE_FAMILY (lface
)))
3142 buffer
= (char *) alloca (strlen (font
.fields
[XLFD_FAMILY
])
3143 + strlen (font
.fields
[XLFD_FOUNDRY
])
3145 sprintf (buffer
, "%s-%s", font
.fields
[XLFD_FOUNDRY
],
3146 font
.fields
[XLFD_FAMILY
]);
3147 val
= build_string (buffer
);
3150 val
= build_string ("*");
3151 LFACE_FAMILY (lface
) = val
;
3154 if (force_p
|| UNSPECIFIEDP (LFACE_HEIGHT (lface
)))
3157 pt
= xlfd_point_size (f
, &font
);
3159 pt
= pixel_point_size (f
, font_info
->height
* 10);
3161 LFACE_HEIGHT (lface
) = make_number (pt
);
3164 if (force_p
|| UNSPECIFIEDP (LFACE_SWIDTH (lface
)))
3165 LFACE_SWIDTH (lface
)
3166 = have_xlfd_p
? xlfd_symbolic_swidth (&font
) : Qnormal
;
3168 if (force_p
|| UNSPECIFIEDP (LFACE_WEIGHT (lface
)))
3169 LFACE_WEIGHT (lface
)
3170 = have_xlfd_p
? xlfd_symbolic_weight (&font
) : Qnormal
;
3172 if (force_p
|| UNSPECIFIEDP (LFACE_SLANT (lface
)))
3174 = have_xlfd_p
? xlfd_symbolic_slant (&font
) : Qnormal
;
3176 LFACE_FONT (lface
) = fontname
;
3181 #endif /* HAVE_WINDOW_SYSTEM */
3184 /* Merges the face height FROM with the face height TO, and returns the
3185 merged height. If FROM is an invalid height, then INVALID is
3186 returned instead. FROM may be a either an absolute face height or a
3187 `relative' height, and TO must be an absolute height. The returned
3188 value is always an absolute height. GCPRO is a lisp value that will
3189 be protected from garbage-collection if this function makes a call
3193 merge_face_heights (from
, to
, invalid
, gcpro
)
3194 Lisp_Object from
, to
, invalid
, gcpro
;
3198 if (INTEGERP (from
))
3199 result
= XINT (from
);
3200 else if (NUMBERP (from
))
3201 result
= XFLOATINT (from
) * XINT (to
);
3202 #if 0 /* Probably not so useful. */
3203 else if (CONSP (from
) && CONSP (XCDR (from
)))
3205 if (EQ (XCAR(from
), Qplus
) || EQ (XCAR(from
), Qminus
))
3207 if (INTEGERP (XCAR (XCDR (from
))))
3209 int inc
= XINT (XCAR (XCDR (from
)));
3210 if (EQ (XCAR (from
), Qminus
))
3213 result
= XFASTINT (to
);
3214 if (result
+ inc
> 0)
3215 /* Note that `underflows' don't mean FROM is invalid, so
3216 we just pin the result at TO if it would otherwise be
3223 else if (FUNCTIONP (from
))
3225 /* Call function with current height as argument.
3226 From is the new height. */
3227 Lisp_Object args
[2], height
;
3228 struct gcpro gcpro1
;
3234 height
= safe_call (2, args
);
3238 if (NUMBERP (height
))
3239 result
= XFLOATINT (height
);
3243 return make_number (result
);
3249 /* Merge two Lisp face attribute vectors on frame F, FROM and TO, and
3250 store the resulting attributes in TO, which must be already be
3251 completely specified and contain only absolute attributes. Every
3252 specified attribute of FROM overrides the corresponding attribute of
3253 TO; relative attributes in FROM are merged with the absolute value in
3254 TO and replace it. CYCLE_CHECK is used internally to detect loops in
3255 face inheritance; it should be Qnil when called from other places. */
3258 merge_face_vectors (f
, from
, to
, cycle_check
)
3260 Lisp_Object
*from
, *to
;
3261 Lisp_Object cycle_check
;
3265 /* If FROM inherits from some other faces, merge their attributes into
3266 TO before merging FROM's direct attributes. Note that an :inherit
3267 attribute of `unspecified' is the same as one of nil; we never
3268 merge :inherit attributes, so nil is more correct, but lots of
3269 other code uses `unspecified' as a generic value for face attributes. */
3270 if (!UNSPECIFIEDP (from
[LFACE_INHERIT_INDEX
])
3271 && !NILP (from
[LFACE_INHERIT_INDEX
]))
3272 merge_face_inheritance (f
, from
[LFACE_INHERIT_INDEX
], to
, cycle_check
);
3274 /* If TO specifies a :font attribute, and FROM specifies some
3275 font-related attribute, we need to clear TO's :font attribute
3276 (because it will be inconsistent with whatever FROM specifies, and
3277 FROM takes precedence). */
3278 if (!NILP (to
[LFACE_FONT_INDEX
])
3279 && (!UNSPECIFIEDP (from
[LFACE_FAMILY_INDEX
])
3280 || !UNSPECIFIEDP (from
[LFACE_HEIGHT_INDEX
])
3281 || !UNSPECIFIEDP (from
[LFACE_WEIGHT_INDEX
])
3282 || !UNSPECIFIEDP (from
[LFACE_SLANT_INDEX
])
3283 || !UNSPECIFIEDP (from
[LFACE_SWIDTH_INDEX
])))
3284 to
[LFACE_FONT_INDEX
] = Qnil
;
3286 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3287 if (!UNSPECIFIEDP (from
[i
]))
3288 if (i
== LFACE_HEIGHT_INDEX
&& !INTEGERP (from
[i
]))
3289 to
[i
] = merge_face_heights (from
[i
], to
[i
], to
[i
], cycle_check
);
3293 /* TO is always an absolute face, which should inherit from nothing.
3294 We blindly copy the :inherit attribute above and fix it up here. */
3295 to
[LFACE_INHERIT_INDEX
] = Qnil
;
3299 /* Checks the `cycle check' variable CHECK to see if it indicates that
3300 EL is part of a cycle; CHECK must be either Qnil or a value returned
3301 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3302 elements after which a cycle might be suspected; after that many
3303 elements, this macro begins consing in order to keep more precise
3306 Returns NIL if a cycle was detected, otherwise a new value for CHECK
3309 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3310 the caller should make sure that's ok. */
3312 #define CYCLE_CHECK(check, el, suspicious) \
3315 : (INTEGERP (check) \
3316 ? (XFASTINT (check) < (suspicious) \
3317 ? make_number (XFASTINT (check) + 1) \
3318 : Fcons (el, Qnil)) \
3319 : (!NILP (Fmemq ((el), (check))) \
3321 : Fcons ((el), (check)))))
3324 /* Merge face attributes from the face on frame F whose name is
3325 INHERITS, into the vector of face attributes TO; INHERITS may also be
3326 a list of face names, in which case they are applied in order.
3327 CYCLE_CHECK is used to detect loops in face inheritance.
3328 Returns true if any of the inherited attributes are `font-related'. */
3331 merge_face_inheritance (f
, inherit
, to
, cycle_check
)
3333 Lisp_Object inherit
;
3335 Lisp_Object cycle_check
;
3337 if (SYMBOLP (inherit
) && !EQ (inherit
, Qunspecified
))
3338 /* Inherit from the named face INHERIT. */
3342 /* Make sure we're not in an inheritance loop. */
3343 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3344 if (NILP (cycle_check
))
3345 /* Cycle detected, ignore any further inheritance. */
3348 lface
= lface_from_face_name (f
, inherit
, 0);
3350 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, cycle_check
);
3352 else if (CONSP (inherit
))
3353 /* Handle a list of inherited faces by calling ourselves recursively
3354 on each element. Note that we only do so for symbol elements, so
3355 it's not possible to infinitely recurse. */
3357 while (CONSP (inherit
))
3359 if (SYMBOLP (XCAR (inherit
)))
3360 merge_face_inheritance (f
, XCAR (inherit
), to
, cycle_check
);
3362 /* Check for a circular inheritance list. */
3363 cycle_check
= CYCLE_CHECK (cycle_check
, inherit
, 15);
3364 if (NILP (cycle_check
))
3365 /* Cycle detected. */
3368 inherit
= XCDR (inherit
);
3374 /* Given a Lisp face attribute vector TO and a Lisp object PROP that
3375 is a face property, determine the resulting face attributes on
3376 frame F, and store them in TO. PROP may be a single face
3377 specification or a list of such specifications. Each face
3378 specification can be
3380 1. A symbol or string naming a Lisp face.
3382 2. A property list of the form (KEYWORD VALUE ...) where each
3383 KEYWORD is a face attribute name, and value is an appropriate value
3386 3. Conses or the form (FOREGROUND-COLOR . COLOR) or
3387 (BACKGROUND-COLOR . COLOR) where COLOR is a color name. This is
3388 for compatibility with 20.2.
3390 Face specifications earlier in lists take precedence over later
3394 merge_face_vector_with_property (f
, to
, prop
)
3401 Lisp_Object first
= XCAR (prop
);
3403 if (EQ (first
, Qforeground_color
)
3404 || EQ (first
, Qbackground_color
))
3406 /* One of (FOREGROUND-COLOR . COLOR) or (BACKGROUND-COLOR
3407 . COLOR). COLOR must be a string. */
3408 Lisp_Object color_name
= XCDR (prop
);
3409 Lisp_Object color
= first
;
3411 if (STRINGP (color_name
))
3413 if (EQ (color
, Qforeground_color
))
3414 to
[LFACE_FOREGROUND_INDEX
] = color_name
;
3416 to
[LFACE_BACKGROUND_INDEX
] = color_name
;
3419 add_to_log ("Invalid face color", color_name
, Qnil
);
3421 else if (SYMBOLP (first
)
3422 && *XSYMBOL (first
)->name
->data
== ':')
3424 /* Assume this is the property list form. */
3425 while (CONSP (prop
) && CONSP (XCDR (prop
)))
3427 Lisp_Object keyword
= XCAR (prop
);
3428 Lisp_Object value
= XCAR (XCDR (prop
));
3430 if (EQ (keyword
, QCfamily
))
3432 if (STRINGP (value
))
3433 to
[LFACE_FAMILY_INDEX
] = value
;
3435 add_to_log ("Invalid face font family", value
, Qnil
);
3437 else if (EQ (keyword
, QCheight
))
3439 Lisp_Object new_height
=
3440 merge_face_heights (value
, to
[LFACE_HEIGHT_INDEX
],
3443 if (NILP (new_height
))
3444 add_to_log ("Invalid face font height", value
, Qnil
);
3446 to
[LFACE_HEIGHT_INDEX
] = new_height
;
3448 else if (EQ (keyword
, QCweight
))
3451 && face_numeric_weight (value
) >= 0)
3452 to
[LFACE_WEIGHT_INDEX
] = value
;
3454 add_to_log ("Invalid face weight", value
, Qnil
);
3456 else if (EQ (keyword
, QCslant
))
3459 && face_numeric_slant (value
) >= 0)
3460 to
[LFACE_SLANT_INDEX
] = value
;
3462 add_to_log ("Invalid face slant", value
, Qnil
);
3464 else if (EQ (keyword
, QCunderline
))
3469 to
[LFACE_UNDERLINE_INDEX
] = value
;
3471 add_to_log ("Invalid face underline", value
, Qnil
);
3473 else if (EQ (keyword
, QCoverline
))
3478 to
[LFACE_OVERLINE_INDEX
] = value
;
3480 add_to_log ("Invalid face overline", value
, Qnil
);
3482 else if (EQ (keyword
, QCstrike_through
))
3487 to
[LFACE_STRIKE_THROUGH_INDEX
] = value
;
3489 add_to_log ("Invalid face strike-through", value
, Qnil
);
3491 else if (EQ (keyword
, QCbox
))
3494 value
= make_number (1);
3495 if (INTEGERP (value
)
3499 to
[LFACE_BOX_INDEX
] = value
;
3501 add_to_log ("Invalid face box", value
, Qnil
);
3503 else if (EQ (keyword
, QCinverse_video
)
3504 || EQ (keyword
, QCreverse_video
))
3506 if (EQ (value
, Qt
) || NILP (value
))
3507 to
[LFACE_INVERSE_INDEX
] = value
;
3509 add_to_log ("Invalid face inverse-video", value
, Qnil
);
3511 else if (EQ (keyword
, QCforeground
))
3513 if (STRINGP (value
))
3514 to
[LFACE_FOREGROUND_INDEX
] = value
;
3516 add_to_log ("Invalid face foreground", value
, Qnil
);
3518 else if (EQ (keyword
, QCbackground
))
3520 if (STRINGP (value
))
3521 to
[LFACE_BACKGROUND_INDEX
] = value
;
3523 add_to_log ("Invalid face background", value
, Qnil
);
3525 else if (EQ (keyword
, QCstipple
))
3527 #ifdef HAVE_X_WINDOWS
3528 Lisp_Object pixmap_p
= Fbitmap_spec_p (value
);
3529 if (!NILP (pixmap_p
))
3530 to
[LFACE_STIPPLE_INDEX
] = value
;
3532 add_to_log ("Invalid face stipple", value
, Qnil
);
3535 else if (EQ (keyword
, QCwidth
))
3538 && face_numeric_swidth (value
) >= 0)
3539 to
[LFACE_SWIDTH_INDEX
] = value
;
3541 add_to_log ("Invalid face width", value
, Qnil
);
3543 else if (EQ (keyword
, QCinherit
))
3545 if (SYMBOLP (value
))
3546 to
[LFACE_INHERIT_INDEX
] = value
;
3550 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
3551 if (!SYMBOLP (XCAR (tail
)))
3554 to
[LFACE_INHERIT_INDEX
] = value
;
3556 add_to_log ("Invalid face inherit", value
, Qnil
);
3560 add_to_log ("Invalid attribute %s in face property",
3563 prop
= XCDR (XCDR (prop
));
3568 /* This is a list of face specs. Specifications at the
3569 beginning of the list take precedence over later
3570 specifications, so we have to merge starting with the
3571 last specification. */
3572 Lisp_Object next
= XCDR (prop
);
3574 merge_face_vector_with_property (f
, to
, next
);
3575 merge_face_vector_with_property (f
, to
, first
);
3580 /* PROP ought to be a face name. */
3581 Lisp_Object lface
= lface_from_face_name (f
, prop
, 0);
3583 add_to_log ("Invalid face text property value: %s", prop
, Qnil
);
3585 merge_face_vectors (f
, XVECTOR (lface
)->contents
, to
, Qnil
);
3590 DEFUN ("internal-make-lisp-face", Finternal_make_lisp_face
,
3591 Sinternal_make_lisp_face
, 1, 2, 0,
3592 "Make FACE, a symbol, a Lisp face with all attributes nil.\n\
3593 If FACE was not known as a face before, create a new one.\n\
3594 If optional argument FRAME is specified, make a frame-local face\n\
3595 for that frame. Otherwise operate on the global face definition.\n\
3596 Value is a vector of face attributes.")
3598 Lisp_Object face
, frame
;
3600 Lisp_Object global_lface
, lface
;
3604 CHECK_SYMBOL (face
, 0);
3605 global_lface
= lface_from_face_name (NULL
, face
, 0);
3609 CHECK_LIVE_FRAME (frame
, 1);
3611 lface
= lface_from_face_name (f
, face
, 0);
3614 f
= NULL
, lface
= Qnil
;
3616 /* Add a global definition if there is none. */
3617 if (NILP (global_lface
))
3619 global_lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3621 XVECTOR (global_lface
)->contents
[0] = Qface
;
3622 Vface_new_frame_defaults
= Fcons (Fcons (face
, global_lface
),
3623 Vface_new_frame_defaults
);
3625 /* Assign the new Lisp face a unique ID. The mapping from Lisp
3626 face id to Lisp face is given by the vector lface_id_to_name.
3627 The mapping from Lisp face to Lisp face id is given by the
3628 property `face' of the Lisp face name. */
3629 if (next_lface_id
== lface_id_to_name_size
)
3631 int new_size
= max (50, 2 * lface_id_to_name_size
);
3632 int sz
= new_size
* sizeof *lface_id_to_name
;
3633 lface_id_to_name
= (Lisp_Object
*) xrealloc (lface_id_to_name
, sz
);
3634 lface_id_to_name_size
= new_size
;
3637 lface_id_to_name
[next_lface_id
] = face
;
3638 Fput (face
, Qface
, make_number (next_lface_id
));
3642 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3643 XVECTOR (global_lface
)->contents
[i
] = Qunspecified
;
3645 /* Add a frame-local definition. */
3650 lface
= Fmake_vector (make_number (LFACE_VECTOR_SIZE
),
3652 XVECTOR (lface
)->contents
[0] = Qface
;
3653 f
->face_alist
= Fcons (Fcons (face
, lface
), f
->face_alist
);
3656 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
3657 XVECTOR (lface
)->contents
[i
] = Qunspecified
;
3660 lface
= global_lface
;
3662 xassert (LFACEP (lface
));
3663 check_lface (lface
);
3668 DEFUN ("internal-lisp-face-p", Finternal_lisp_face_p
,
3669 Sinternal_lisp_face_p
, 1, 2, 0,
3670 "Return non-nil if FACE names a face.\n\
3671 If optional second parameter FRAME is non-nil, check for the\n\
3672 existence of a frame-local face with name FACE on that frame.\n\
3673 Otherwise check for the existence of a global face.")
3675 Lisp_Object face
, frame
;
3681 CHECK_LIVE_FRAME (frame
, 1);
3682 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3685 lface
= lface_from_face_name (NULL
, face
, 0);
3691 DEFUN ("internal-copy-lisp-face", Finternal_copy_lisp_face
,
3692 Sinternal_copy_lisp_face
, 4, 4, 0,
3693 "Copy face FROM to TO.\n\
3694 If FRAME it t, copy the global face definition of FROM to the\n\
3695 global face definition of TO. Otherwise, copy the frame-local\n\
3696 definition of FROM on FRAME to the frame-local definition of TO\n\
3697 on NEW-FRAME, or FRAME if NEW-FRAME is nil.\n\
3700 (from
, to
, frame
, new_frame
)
3701 Lisp_Object from
, to
, frame
, new_frame
;
3703 Lisp_Object lface
, copy
;
3705 CHECK_SYMBOL (from
, 0);
3706 CHECK_SYMBOL (to
, 1);
3707 if (NILP (new_frame
))
3712 /* Copy global definition of FROM. We don't make copies of
3713 strings etc. because 20.2 didn't do it either. */
3714 lface
= lface_from_face_name (NULL
, from
, 1);
3715 copy
= Finternal_make_lisp_face (to
, Qnil
);
3719 /* Copy frame-local definition of FROM. */
3720 CHECK_LIVE_FRAME (frame
, 2);
3721 CHECK_LIVE_FRAME (new_frame
, 3);
3722 lface
= lface_from_face_name (XFRAME (frame
), from
, 1);
3723 copy
= Finternal_make_lisp_face (to
, new_frame
);
3726 bcopy (XVECTOR (lface
)->contents
, XVECTOR (copy
)->contents
,
3727 LFACE_VECTOR_SIZE
* sizeof (Lisp_Object
));
3733 DEFUN ("internal-set-lisp-face-attribute", Finternal_set_lisp_face_attribute
,
3734 Sinternal_set_lisp_face_attribute
, 3, 4, 0,
3735 "Set attribute ATTR of FACE to VALUE.\n\
3736 FRAME being a frame means change the face on that frame.\n\
3737 FRAME nil means change change the face of the selected frame.\n\
3738 FRAME t means change the default for new frames.\n\
3739 FRAME 0 means change the face on all frames, and change the default\n\
3741 (face
, attr
, value
, frame
)
3742 Lisp_Object face
, attr
, value
, frame
;
3745 Lisp_Object old_value
= Qnil
;
3746 /* Set 1 if ATTR is QCfont. */
3747 int font_attr_p
= 0;
3748 /* Set 1 if ATTR is one of font-related attributes other than QCfont. */
3749 int font_related_attr_p
= 0;
3751 CHECK_SYMBOL (face
, 0);
3752 CHECK_SYMBOL (attr
, 1);
3754 face
= resolve_face_name (face
);
3756 /* If FRAME is 0, change face on all frames, and change the
3757 default for new frames. */
3758 if (INTEGERP (frame
) && XINT (frame
) == 0)
3761 Finternal_set_lisp_face_attribute (face
, attr
, value
, Qt
);
3762 FOR_EACH_FRAME (tail
, frame
)
3763 Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
3767 /* Set lface to the Lisp attribute vector of FACE. */
3769 lface
= lface_from_face_name (NULL
, face
, 1);
3773 frame
= selected_frame
;
3775 CHECK_LIVE_FRAME (frame
, 3);
3776 lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
3778 /* If a frame-local face doesn't exist yet, create one. */
3780 lface
= Finternal_make_lisp_face (face
, frame
);
3783 if (EQ (attr
, QCfamily
))
3785 if (!UNSPECIFIEDP (value
))
3787 CHECK_STRING (value
, 3);
3788 if (XSTRING (value
)->size
== 0)
3789 signal_error ("Invalid face family", value
);
3791 old_value
= LFACE_FAMILY (lface
);
3792 LFACE_FAMILY (lface
) = value
;
3793 font_related_attr_p
= 1;
3795 else if (EQ (attr
, QCheight
))
3797 if (!UNSPECIFIEDP (value
))
3800 (EQ (face
, Qdefault
) ? value
:
3801 /* The default face must have an absolute size, otherwise, we do
3802 a test merge with a random height to see if VALUE's ok. */
3803 merge_face_heights (value
, make_number(10), Qnil
, Qnil
));
3805 if (!INTEGERP(test
) || XINT(test
) <= 0)
3806 signal_error ("Invalid face height", value
);
3809 old_value
= LFACE_HEIGHT (lface
);
3810 LFACE_HEIGHT (lface
) = value
;
3811 font_related_attr_p
= 1;
3813 else if (EQ (attr
, QCweight
))
3815 if (!UNSPECIFIEDP (value
))
3817 CHECK_SYMBOL (value
, 3);
3818 if (face_numeric_weight (value
) < 0)
3819 signal_error ("Invalid face weight", value
);
3821 old_value
= LFACE_WEIGHT (lface
);
3822 LFACE_WEIGHT (lface
) = value
;
3823 font_related_attr_p
= 1;
3825 else if (EQ (attr
, QCslant
))
3827 if (!UNSPECIFIEDP (value
))
3829 CHECK_SYMBOL (value
, 3);
3830 if (face_numeric_slant (value
) < 0)
3831 signal_error ("Invalid face slant", value
);
3833 old_value
= LFACE_SLANT (lface
);
3834 LFACE_SLANT (lface
) = value
;
3835 font_related_attr_p
= 1;
3837 else if (EQ (attr
, QCunderline
))
3839 if (!UNSPECIFIEDP (value
))
3840 if ((SYMBOLP (value
)
3842 && !EQ (value
, Qnil
))
3843 /* Underline color. */
3845 && XSTRING (value
)->size
== 0))
3846 signal_error ("Invalid face underline", value
);
3848 old_value
= LFACE_UNDERLINE (lface
);
3849 LFACE_UNDERLINE (lface
) = value
;
3851 else if (EQ (attr
, QCoverline
))
3853 if (!UNSPECIFIEDP (value
))
3854 if ((SYMBOLP (value
)
3856 && !EQ (value
, Qnil
))
3857 /* Overline color. */
3859 && XSTRING (value
)->size
== 0))
3860 signal_error ("Invalid face overline", value
);
3862 old_value
= LFACE_OVERLINE (lface
);
3863 LFACE_OVERLINE (lface
) = value
;
3865 else if (EQ (attr
, QCstrike_through
))
3867 if (!UNSPECIFIEDP (value
))
3868 if ((SYMBOLP (value
)
3870 && !EQ (value
, Qnil
))
3871 /* Strike-through color. */
3873 && XSTRING (value
)->size
== 0))
3874 signal_error ("Invalid face strike-through", value
);
3876 old_value
= LFACE_STRIKE_THROUGH (lface
);
3877 LFACE_STRIKE_THROUGH (lface
) = value
;
3879 else if (EQ (attr
, QCbox
))
3883 /* Allow t meaning a simple box of width 1 in foreground color
3886 value
= make_number (1);
3888 if (UNSPECIFIEDP (value
))
3890 else if (NILP (value
))
3892 else if (INTEGERP (value
))
3893 valid_p
= XINT (value
) > 0;
3894 else if (STRINGP (value
))
3895 valid_p
= XSTRING (value
)->size
> 0;
3896 else if (CONSP (value
))
3912 if (EQ (k
, QCline_width
))
3914 if (!INTEGERP (v
) || XINT (v
) <= 0)
3917 else if (EQ (k
, QCcolor
))
3919 if (!STRINGP (v
) || XSTRING (v
)->size
== 0)
3922 else if (EQ (k
, QCstyle
))
3924 if (!EQ (v
, Qpressed_button
) && !EQ (v
, Qreleased_button
))
3931 valid_p
= NILP (tem
);
3937 signal_error ("Invalid face box", value
);
3939 old_value
= LFACE_BOX (lface
);
3940 LFACE_BOX (lface
) = value
;
3942 else if (EQ (attr
, QCinverse_video
)
3943 || EQ (attr
, QCreverse_video
))
3945 if (!UNSPECIFIEDP (value
))
3947 CHECK_SYMBOL (value
, 3);
3948 if (!EQ (value
, Qt
) && !NILP (value
))
3949 signal_error ("Invalid inverse-video face attribute value", value
);
3951 old_value
= LFACE_INVERSE (lface
);
3952 LFACE_INVERSE (lface
) = value
;
3954 else if (EQ (attr
, QCforeground
))
3956 if (!UNSPECIFIEDP (value
))
3958 /* Don't check for valid color names here because it depends
3959 on the frame (display) whether the color will be valid
3960 when the face is realized. */
3961 CHECK_STRING (value
, 3);
3962 if (XSTRING (value
)->size
== 0)
3963 signal_error ("Empty foreground color value", value
);
3965 old_value
= LFACE_FOREGROUND (lface
);
3966 LFACE_FOREGROUND (lface
) = value
;
3968 else if (EQ (attr
, QCbackground
))
3970 if (!UNSPECIFIEDP (value
))
3972 /* Don't check for valid color names here because it depends
3973 on the frame (display) whether the color will be valid
3974 when the face is realized. */
3975 CHECK_STRING (value
, 3);
3976 if (XSTRING (value
)->size
== 0)
3977 signal_error ("Empty background color value", value
);
3979 old_value
= LFACE_BACKGROUND (lface
);
3980 LFACE_BACKGROUND (lface
) = value
;
3982 else if (EQ (attr
, QCstipple
))
3984 #ifdef HAVE_X_WINDOWS
3985 if (!UNSPECIFIEDP (value
)
3987 && NILP (Fbitmap_spec_p (value
)))
3988 signal_error ("Invalid stipple attribute", value
);
3989 old_value
= LFACE_STIPPLE (lface
);
3990 LFACE_STIPPLE (lface
) = value
;
3991 #endif /* HAVE_X_WINDOWS */
3993 else if (EQ (attr
, QCwidth
))
3995 if (!UNSPECIFIEDP (value
))
3997 CHECK_SYMBOL (value
, 3);
3998 if (face_numeric_swidth (value
) < 0)
3999 signal_error ("Invalid face width", value
);
4001 old_value
= LFACE_SWIDTH (lface
);
4002 LFACE_SWIDTH (lface
) = value
;
4003 font_related_attr_p
= 1;
4005 else if (EQ (attr
, QCfont
))
4007 #ifdef HAVE_WINDOW_SYSTEM
4008 /* Set font-related attributes of the Lisp face from an
4013 CHECK_STRING (value
, 3);
4015 f
= SELECTED_FRAME ();
4017 f
= check_x_frame (frame
);
4019 /* VALUE may be a fontset name or an alias of fontset. In such
4020 a case, use the base fontset name. */
4021 tmp
= Fquery_fontset (value
, Qnil
);
4025 if (!set_lface_from_font_name (f
, lface
, value
, 1, 1))
4026 signal_error ("Invalid font or fontset name", value
);
4029 #endif /* HAVE_WINDOW_SYSTEM */
4031 else if (EQ (attr
, QCinherit
))
4034 if (SYMBOLP (value
))
4037 for (tail
= value
; CONSP (tail
); tail
= XCDR (tail
))
4038 if (!SYMBOLP (XCAR (tail
)))
4041 LFACE_INHERIT (lface
) = value
;
4043 signal_error ("Invalid face inheritance", value
);
4045 else if (EQ (attr
, QCbold
))
4047 old_value
= LFACE_WEIGHT (lface
);
4048 LFACE_WEIGHT (lface
) = NILP (value
) ? Qnormal
: Qbold
;
4049 font_related_attr_p
= 1;
4051 else if (EQ (attr
, QCitalic
))
4053 old_value
= LFACE_SLANT (lface
);
4054 LFACE_SLANT (lface
) = NILP (value
) ? Qnormal
: Qitalic
;
4055 font_related_attr_p
= 1;
4058 signal_error ("Invalid face attribute name", attr
);
4060 if (font_related_attr_p
4061 && !UNSPECIFIEDP (value
))
4062 /* If a font-related attribute other than QCfont is specified, the
4063 original `font' attribute nor that of default face is useless
4064 to determine a new font. Thus, we set it to nil so that font
4065 selection mechanism doesn't use it. */
4066 LFACE_FONT (lface
) = Qnil
;
4068 /* Changing a named face means that all realized faces depending on
4069 that face are invalid. Since we cannot tell which realized faces
4070 depend on the face, make sure they are all removed. This is done
4071 by incrementing face_change_count. The next call to
4072 init_iterator will then free realized faces. */
4074 && (EQ (attr
, QCfont
)
4075 || NILP (Fequal (old_value
, value
))))
4077 ++face_change_count
;
4078 ++windows_or_buffers_changed
;
4081 #ifdef HAVE_WINDOW_SYSTEM
4083 if (!UNSPECIFIEDP (value
)
4084 && NILP (Fequal (old_value
, value
)))
4090 if (EQ (face
, Qdefault
))
4092 /* Changed font-related attributes of the `default' face are
4093 reflected in changed `font' frame parameters. */
4094 if ((font_related_attr_p
|| font_attr_p
)
4095 && lface_fully_specified_p (XVECTOR (lface
)->contents
))
4096 set_font_frame_param (frame
, lface
);
4097 else if (EQ (attr
, QCforeground
))
4098 param
= Qforeground_color
;
4099 else if (EQ (attr
, QCbackground
))
4100 param
= Qbackground_color
;
4103 else if (EQ (face
, Qscroll_bar
))
4105 /* Changing the colors of `scroll-bar' sets frame parameters
4106 `scroll-bar-foreground' and `scroll-bar-background'. */
4107 if (EQ (attr
, QCforeground
))
4108 param
= Qscroll_bar_foreground
;
4109 else if (EQ (attr
, QCbackground
))
4110 param
= Qscroll_bar_background
;
4112 #endif /* not WINDOWSNT */
4113 else if (EQ (face
, Qborder
))
4115 /* Changing background color of `border' sets frame parameter
4117 if (EQ (attr
, QCbackground
))
4118 param
= Qborder_color
;
4120 else if (EQ (face
, Qcursor
))
4122 /* Changing background color of `cursor' sets frame parameter
4124 if (EQ (attr
, QCbackground
))
4125 param
= Qcursor_color
;
4127 else if (EQ (face
, Qmouse
))
4129 /* Changing background color of `mouse' sets frame parameter
4131 if (EQ (attr
, QCbackground
))
4132 param
= Qmouse_color
;
4134 else if (EQ (face
, Qmenu
))
4135 ++menu_face_change_count
;
4139 /* Update `default-frame-alist', which is used for new frames. */
4141 store_in_alist (&Vdefault_frame_alist
, param
, value
);
4144 /* Update the current frame's parameters. */
4147 cons
= XCAR (Vparam_value_alist
);
4148 XCAR (cons
) = param
;
4149 XCDR (cons
) = value
;
4150 Fmodify_frame_parameters (frame
, Vparam_value_alist
);
4154 #endif /* HAVE_WINDOW_SYSTEM */
4160 #ifdef HAVE_WINDOW_SYSTEM
4162 /* Set the `font' frame parameter of FRAME determined from `default'
4163 face attributes LFACE. If a face or fontset name is explicitely
4164 specfied in LFACE, use it as is. Otherwise, determine a font name
4165 from the other font-related atrributes of LFACE. In that case, if
4166 there's no matching font, signals an error. */
4169 set_font_frame_param (frame
, lface
)
4170 Lisp_Object frame
, lface
;
4172 struct frame
*f
= XFRAME (frame
);
4173 Lisp_Object font_name
;
4176 if (STRINGP (LFACE_FONT (lface
)))
4177 font_name
= LFACE_FONT (lface
);
4180 /* Choose a font name that reflects LFACE's attributes and has
4181 the registry and encoding pattern specified in the default
4182 fontset (3rd arg: -1) for ASCII characters (4th arg: 0). */
4183 font
= choose_face_font (f
, XVECTOR (lface
)->contents
, -1, 0);
4185 error ("No font matches the specified attribute");
4186 font_name
= build_string (font
);
4190 Fmodify_frame_parameters (frame
, Fcons (Fcons (Qfont
, font_name
), Qnil
));
4194 /* Update the corresponding face when frame parameter PARAM on frame F
4195 has been assigned the value NEW_VALUE. */
4198 update_face_from_frame_parameter (f
, param
, new_value
)
4200 Lisp_Object param
, new_value
;
4204 /* If there are no faces yet, give up. This is the case when called
4205 from Fx_create_frame, and we do the necessary things later in
4206 face-set-after-frame-defaults. */
4207 if (NILP (f
->face_alist
))
4210 if (EQ (param
, Qforeground_color
))
4212 lface
= lface_from_face_name (f
, Qdefault
, 1);
4213 LFACE_FOREGROUND (lface
) = (STRINGP (new_value
)
4214 ? new_value
: Qunspecified
);
4215 realize_basic_faces (f
);
4217 else if (EQ (param
, Qbackground_color
))
4221 /* Changing the background color might change the background
4222 mode, so that we have to load new defface specs. Call
4223 frame-update-face-colors to do that. */
4224 XSETFRAME (frame
, f
);
4225 call1 (Qframe_update_face_colors
, frame
);
4227 lface
= lface_from_face_name (f
, Qdefault
, 1);
4228 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4229 ? new_value
: Qunspecified
);
4230 realize_basic_faces (f
);
4232 if (EQ (param
, Qborder_color
))
4234 lface
= lface_from_face_name (f
, Qborder
, 1);
4235 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4236 ? new_value
: Qunspecified
);
4238 else if (EQ (param
, Qcursor_color
))
4240 lface
= lface_from_face_name (f
, Qcursor
, 1);
4241 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4242 ? new_value
: Qunspecified
);
4244 else if (EQ (param
, Qmouse_color
))
4246 lface
= lface_from_face_name (f
, Qmouse
, 1);
4247 LFACE_BACKGROUND (lface
) = (STRINGP (new_value
)
4248 ? new_value
: Qunspecified
);
4253 /* Get the value of X resource RESOURCE, class CLASS for the display
4254 of frame FRAME. This is here because ordinary `x-get-resource'
4255 doesn't take a frame argument. */
4257 DEFUN ("internal-face-x-get-resource", Finternal_face_x_get_resource
,
4258 Sinternal_face_x_get_resource
, 3, 3, 0, "")
4259 (resource
, class, frame
)
4260 Lisp_Object resource
, class, frame
;
4262 Lisp_Object value
= Qnil
;
4265 CHECK_STRING (resource
, 0);
4266 CHECK_STRING (class, 1);
4267 CHECK_LIVE_FRAME (frame
, 2);
4269 value
= display_x_get_resource (FRAME_X_DISPLAY_INFO (XFRAME (frame
)),
4270 resource
, class, Qnil
, Qnil
);
4272 #endif /* not macintosh */
4273 #endif /* not WINDOWSNT */
4278 /* Return resource string VALUE as a boolean value, i.e. nil, or t.
4279 If VALUE is "on" or "true", return t. If VALUE is "off" or
4280 "false", return nil. Otherwise, if SIGNAL_P is non-zero, signal an
4281 error; if SIGNAL_P is zero, return 0. */
4284 face_boolean_x_resource_value (value
, signal_p
)
4288 Lisp_Object result
= make_number (0);
4290 xassert (STRINGP (value
));
4292 if (xstricmp (XSTRING (value
)->data
, "on") == 0
4293 || xstricmp (XSTRING (value
)->data
, "true") == 0)
4295 else if (xstricmp (XSTRING (value
)->data
, "off") == 0
4296 || xstricmp (XSTRING (value
)->data
, "false") == 0)
4298 else if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4299 result
= Qunspecified
;
4301 signal_error ("Invalid face attribute value from X resource", value
);
4307 DEFUN ("internal-set-lisp-face-attribute-from-resource",
4308 Finternal_set_lisp_face_attribute_from_resource
,
4309 Sinternal_set_lisp_face_attribute_from_resource
,
4311 (face
, attr
, value
, frame
)
4312 Lisp_Object face
, attr
, value
, frame
;
4314 CHECK_SYMBOL (face
, 0);
4315 CHECK_SYMBOL (attr
, 1);
4316 CHECK_STRING (value
, 2);
4318 if (xstricmp (XSTRING (value
)->data
, "unspecified") == 0)
4319 value
= Qunspecified
;
4320 else if (EQ (attr
, QCheight
))
4322 value
= Fstring_to_number (value
, make_number (10));
4323 if (XINT (value
) <= 0)
4324 signal_error ("Invalid face height from X resource", value
);
4326 else if (EQ (attr
, QCbold
) || EQ (attr
, QCitalic
))
4327 value
= face_boolean_x_resource_value (value
, 1);
4328 else if (EQ (attr
, QCweight
) || EQ (attr
, QCslant
) || EQ (attr
, QCwidth
))
4329 value
= intern (XSTRING (value
)->data
);
4330 else if (EQ (attr
, QCreverse_video
) || EQ (attr
, QCinverse_video
))
4331 value
= face_boolean_x_resource_value (value
, 1);
4332 else if (EQ (attr
, QCunderline
)
4333 || EQ (attr
, QCoverline
)
4334 || EQ (attr
, QCstrike_through
)
4335 || EQ (attr
, QCbox
))
4337 Lisp_Object boolean_value
;
4339 /* If the result of face_boolean_x_resource_value is t or nil,
4340 VALUE does NOT specify a color. */
4341 boolean_value
= face_boolean_x_resource_value (value
, 0);
4342 if (SYMBOLP (boolean_value
))
4343 value
= boolean_value
;
4346 return Finternal_set_lisp_face_attribute (face
, attr
, value
, frame
);
4349 #endif /* HAVE_WINDOW_SYSTEM */
4352 #ifdef HAVE_X_WINDOWS
4353 /***********************************************************************
4355 ***********************************************************************/
4357 #ifdef USE_X_TOOLKIT
4359 #include "../lwlib/lwlib-utils.h"
4361 /* Structure used to pass X resources to functions called via
4362 XtApplyToWidgets. */
4373 static void xm_apply_resources
P_ ((Widget
, XtPointer
));
4374 static void xm_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4377 /* Set widget W's X resources from P which points to an x_resources
4378 structure. If W is a cascade button, apply resources to W's
4382 xm_apply_resources (w
, p
)
4387 struct x_resources
*res
= (struct x_resources
*) p
;
4389 XtSetValues (w
, res
->av
, res
->ac
);
4390 XtVaGetValues (w
, XmNsubMenuId
, &submenu
, NULL
);
4393 XtSetValues (submenu
, res
->av
, res
->ac
);
4394 XtApplyToWidgets (submenu
, xm_apply_resources
, p
);
4399 /* Set X resources of menu-widget WIDGET on frame F from face `menu'.
4400 This is the LessTif/Motif version. As of LessTif 0.88 it has the
4403 1. Setting the XmNfontList resource leads to an infinite loop
4404 somewhere in LessTif. */
4407 xm_set_menu_resources_from_menu_face (f
, widget
)
4417 lface
= lface_from_face_name (f
, Qmenu
, 1);
4418 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4420 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4422 XtSetArg (av
[ac
], XmNforeground
, face
->foreground
);
4426 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4428 XtSetArg (av
[ac
], XmNbackground
, face
->background
);
4432 /* If any font-related attribute of `menu' is set, set the font. */
4434 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4435 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4436 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4437 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4438 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4440 #if 0 /* Setting the font leads to an infinite loop somewhere
4441 in LessTif during geometry computation. */
4443 fe
= XmFontListEntryCreate ("menu_font", XmFONT_IS_FONT
, face
->font
);
4444 fl
= XmFontListAppendEntry (NULL
, fe
);
4445 XtSetArg (av
[ac
], XmNfontList
, fl
);
4450 xassert (ac
<= sizeof av
/ sizeof *av
);
4454 struct x_resources res
;
4456 XtSetValues (widget
, av
, ac
);
4457 res
.av
= av
, res
.ac
= ac
;
4458 XtApplyToWidgets (widget
, xm_apply_resources
, &res
);
4460 XmFontListFree (fl
);
4464 #endif /* USE_MOTIF */
4468 static void xl_apply_resources
P_ ((Widget
, XtPointer
));
4469 static void xl_set_menu_resources_from_menu_face
P_ ((struct frame
*, Widget
));
4472 /* Set widget W's resources from P which points to an x_resources
4476 xl_apply_resources (widget
, p
)
4480 struct x_resources
*res
= (struct x_resources
*) p
;
4481 XtSetValues (widget
, res
->av
, res
->ac
);
4485 /* On frame F, set X resources of menu-widget WIDGET from face `menu'.
4486 This is the Lucid version. */
4489 xl_set_menu_resources_from_menu_face (f
, widget
)
4498 lface
= lface_from_face_name (f
, Qmenu
, 1);
4499 face
= FACE_FROM_ID (f
, MENU_FACE_ID
);
4501 if (!UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
4503 XtSetArg (av
[ac
], XtNforeground
, face
->foreground
);
4507 if (!UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
4509 XtSetArg (av
[ac
], XtNbackground
, face
->background
);
4514 && (!UNSPECIFIEDP (LFACE_FAMILY (lface
))
4515 || !UNSPECIFIEDP (LFACE_SWIDTH (lface
))
4516 || !UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4517 || !UNSPECIFIEDP (LFACE_SLANT (lface
))
4518 || !UNSPECIFIEDP (LFACE_HEIGHT (lface
))))
4520 XtSetArg (av
[ac
], XtNfont
, face
->font
);
4526 struct x_resources res
;
4528 XtSetValues (widget
, av
, ac
);
4530 /* We must do children here in case we're handling a pop-up menu
4531 in which case WIDGET is a popup shell. XtApplyToWidgets
4532 is a function from lwlib. */
4533 res
.av
= av
, res
.ac
= ac
;
4534 XtApplyToWidgets (widget
, xl_apply_resources
, &res
);
4538 #endif /* USE_LUCID */
4541 /* On frame F, set X resources of menu-widget WIDGET from face `menu'. */
4544 x_set_menu_resources_from_menu_face (f
, widget
)
4548 /* Realized faces may have been removed on frame F, e.g. because of
4549 face attribute changes. Recompute them, if necessary, since we
4550 will need the `menu' face. */
4551 if (f
->face_cache
->used
== 0)
4552 recompute_basic_faces (f
);
4556 xl_set_menu_resources_from_menu_face (f
, widget
);
4559 xm_set_menu_resources_from_menu_face (f
, widget
);
4564 #endif /* USE_X_TOOLKIT */
4566 #endif /* HAVE_X_WINDOWS */
4570 DEFUN ("internal-get-lisp-face-attribute", Finternal_get_lisp_face_attribute
,
4571 Sinternal_get_lisp_face_attribute
,
4573 "Return face attribute KEYWORD of face SYMBOL.\n\
4574 If SYMBOL does not name a valid Lisp face or KEYWORD isn't a valid\n\
4575 face attribute name, signal an error.\n\
4576 If the optional argument FRAME is given, report on face FACE in that\n\
4577 frame. If FRAME is t, report on the defaults for face FACE (for new\n\
4578 frames). If FRAME is omitted or nil, use the selected frame.")
4579 (symbol
, keyword
, frame
)
4580 Lisp_Object symbol
, keyword
, frame
;
4582 Lisp_Object lface
, value
= Qnil
;
4584 CHECK_SYMBOL (symbol
, 0);
4585 CHECK_SYMBOL (keyword
, 1);
4588 lface
= lface_from_face_name (NULL
, symbol
, 1);
4592 frame
= selected_frame
;
4593 CHECK_LIVE_FRAME (frame
, 2);
4594 lface
= lface_from_face_name (XFRAME (frame
), symbol
, 1);
4597 if (EQ (keyword
, QCfamily
))
4598 value
= LFACE_FAMILY (lface
);
4599 else if (EQ (keyword
, QCheight
))
4600 value
= LFACE_HEIGHT (lface
);
4601 else if (EQ (keyword
, QCweight
))
4602 value
= LFACE_WEIGHT (lface
);
4603 else if (EQ (keyword
, QCslant
))
4604 value
= LFACE_SLANT (lface
);
4605 else if (EQ (keyword
, QCunderline
))
4606 value
= LFACE_UNDERLINE (lface
);
4607 else if (EQ (keyword
, QCoverline
))
4608 value
= LFACE_OVERLINE (lface
);
4609 else if (EQ (keyword
, QCstrike_through
))
4610 value
= LFACE_STRIKE_THROUGH (lface
);
4611 else if (EQ (keyword
, QCbox
))
4612 value
= LFACE_BOX (lface
);
4613 else if (EQ (keyword
, QCinverse_video
)
4614 || EQ (keyword
, QCreverse_video
))
4615 value
= LFACE_INVERSE (lface
);
4616 else if (EQ (keyword
, QCforeground
))
4617 value
= LFACE_FOREGROUND (lface
);
4618 else if (EQ (keyword
, QCbackground
))
4619 value
= LFACE_BACKGROUND (lface
);
4620 else if (EQ (keyword
, QCstipple
))
4621 value
= LFACE_STIPPLE (lface
);
4622 else if (EQ (keyword
, QCwidth
))
4623 value
= LFACE_SWIDTH (lface
);
4624 else if (EQ (keyword
, QCinherit
))
4625 value
= LFACE_INHERIT (lface
);
4626 else if (EQ (keyword
, QCfont
))
4627 value
= LFACE_FONT (lface
);
4629 signal_error ("Invalid face attribute name", keyword
);
4635 DEFUN ("internal-lisp-face-attribute-values",
4636 Finternal_lisp_face_attribute_values
,
4637 Sinternal_lisp_face_attribute_values
, 1, 1, 0,
4638 "Return a list of valid discrete values for face attribute ATTR.\n\
4639 Value is nil if ATTR doesn't have a discrete set of valid values.")
4643 Lisp_Object result
= Qnil
;
4645 CHECK_SYMBOL (attr
, 0);
4647 if (EQ (attr
, QCweight
)
4648 || EQ (attr
, QCslant
)
4649 || EQ (attr
, QCwidth
))
4651 /* Extract permissible symbols from tables. */
4652 struct table_entry
*table
;
4655 if (EQ (attr
, QCweight
))
4656 table
= weight_table
, dim
= DIM (weight_table
);
4657 else if (EQ (attr
, QCslant
))
4658 table
= slant_table
, dim
= DIM (slant_table
);
4660 table
= swidth_table
, dim
= DIM (swidth_table
);
4662 for (i
= 0; i
< dim
; ++i
)
4664 Lisp_Object symbol
= *table
[i
].symbol
;
4665 Lisp_Object tail
= result
;
4668 && !EQ (XCAR (tail
), symbol
))
4672 result
= Fcons (symbol
, result
);
4675 else if (EQ (attr
, QCunderline
))
4676 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4677 else if (EQ (attr
, QCoverline
))
4678 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4679 else if (EQ (attr
, QCstrike_through
))
4680 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4681 else if (EQ (attr
, QCinverse_video
) || EQ (attr
, QCreverse_video
))
4682 result
= Fcons (Qt
, Fcons (Qnil
, Qnil
));
4688 DEFUN ("internal-merge-in-global-face", Finternal_merge_in_global_face
,
4689 Sinternal_merge_in_global_face
, 2, 2, 0,
4690 "Add attributes from frame-default definition of FACE to FACE on FRAME.\n\
4691 Default face attributes override any local face attributes.")
4693 Lisp_Object face
, frame
;
4696 Lisp_Object global_lface
, local_lface
, *gvec
, *lvec
;
4698 CHECK_LIVE_FRAME (frame
, 1);
4699 global_lface
= lface_from_face_name (NULL
, face
, 1);
4700 local_lface
= lface_from_face_name (XFRAME (frame
), face
, 0);
4701 if (NILP (local_lface
))
4702 local_lface
= Finternal_make_lisp_face (face
, frame
);
4704 /* Make every specified global attribute override the local one.
4705 BEWARE!! This is only used from `face-set-after-frame-default' where
4706 the local frame is defined from default specs in `face-defface-spec'
4707 and those should be overridden by global settings. Hence the strange
4708 "global before local" priority. */
4709 lvec
= XVECTOR (local_lface
)->contents
;
4710 gvec
= XVECTOR (global_lface
)->contents
;
4711 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4712 if (! UNSPECIFIEDP (gvec
[i
]))
4719 /* The following function is implemented for compatibility with 20.2.
4720 The function is used in x-resolve-fonts when it is asked to
4721 return fonts with the same size as the font of a face. This is
4722 done in fontset.el. */
4724 DEFUN ("face-font", Fface_font
, Sface_font
, 1, 2, 0,
4725 "Return the font name of face FACE, or nil if it is unspecified.\n\
4726 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4727 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4728 The font default for a face is either nil, or a list\n\
4729 of the form (bold), (italic) or (bold italic).\n\
4730 If FRAME is omitted or nil, use the selected frame.")
4732 Lisp_Object face
, frame
;
4736 Lisp_Object result
= Qnil
;
4737 Lisp_Object lface
= lface_from_face_name (NULL
, face
, 1);
4739 if (!UNSPECIFIEDP (LFACE_WEIGHT (lface
))
4740 && !EQ (LFACE_WEIGHT (lface
), Qnormal
))
4741 result
= Fcons (Qbold
, result
);
4743 if (!NILP (LFACE_SLANT (lface
))
4744 && !EQ (LFACE_SLANT (lface
), Qnormal
))
4745 result
= Fcons (Qitalic
, result
);
4751 struct frame
*f
= frame_or_selected_frame (frame
, 1);
4752 int face_id
= lookup_named_face (f
, face
, 0);
4753 struct face
*face
= FACE_FROM_ID (f
, face_id
);
4754 return face
? build_string (face
->font_name
) : Qnil
;
4759 /* Compare face vectors V1 and V2 for equality. Value is non-zero if
4760 all attributes are `equal'. Tries to be fast because this function
4761 is called quite often. */
4764 lface_equal_p (v1
, v2
)
4765 Lisp_Object
*v1
, *v2
;
4769 for (i
= 1; i
< LFACE_VECTOR_SIZE
&& equal_p
; ++i
)
4771 Lisp_Object a
= v1
[i
];
4772 Lisp_Object b
= v2
[i
];
4774 /* Type can differ, e.g. when one attribute is unspecified, i.e. nil,
4775 and the other is specified. */
4776 equal_p
= XTYPE (a
) == XTYPE (b
);
4785 equal_p
= ((STRING_BYTES (XSTRING (a
))
4786 == STRING_BYTES (XSTRING (b
)))
4787 && bcmp (XSTRING (a
)->data
, XSTRING (b
)->data
,
4788 STRING_BYTES (XSTRING (a
))) == 0);
4797 equal_p
= !NILP (Fequal (a
, b
));
4807 DEFUN ("internal-lisp-face-equal-p", Finternal_lisp_face_equal_p
,
4808 Sinternal_lisp_face_equal_p
, 2, 3, 0,
4809 "True if FACE1 and FACE2 are equal.\n\
4810 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4811 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4812 If FRAME is omitted or nil, use the selected frame.")
4813 (face1
, face2
, frame
)
4814 Lisp_Object face1
, face2
, frame
;
4818 Lisp_Object lface1
, lface2
;
4823 /* Don't use check_x_frame here because this function is called
4824 before X frames exist. At that time, if FRAME is nil,
4825 selected_frame will be used which is the frame dumped with
4826 Emacs. That frame is not an X frame. */
4827 f
= frame_or_selected_frame (frame
, 2);
4829 lface1
= lface_from_face_name (NULL
, face1
, 1);
4830 lface2
= lface_from_face_name (NULL
, face2
, 1);
4831 equal_p
= lface_equal_p (XVECTOR (lface1
)->contents
,
4832 XVECTOR (lface2
)->contents
);
4833 return equal_p
? Qt
: Qnil
;
4837 DEFUN ("internal-lisp-face-empty-p", Finternal_lisp_face_empty_p
,
4838 Sinternal_lisp_face_empty_p
, 1, 2, 0,
4839 "True if FACE has no attribute specified.\n\
4840 If the optional argument FRAME is given, report on face FACE in that frame.\n\
4841 If FRAME is t, report on the defaults for face FACE (for new frames).\n\
4842 If FRAME is omitted or nil, use the selected frame.")
4844 Lisp_Object face
, frame
;
4851 frame
= selected_frame
;
4852 CHECK_LIVE_FRAME (frame
, 0);
4856 lface
= lface_from_face_name (NULL
, face
, 1);
4858 lface
= lface_from_face_name (f
, face
, 1);
4860 for (i
= 1; i
< LFACE_VECTOR_SIZE
; ++i
)
4861 if (!UNSPECIFIEDP (XVECTOR (lface
)->contents
[i
]))
4864 return i
== LFACE_VECTOR_SIZE
? Qt
: Qnil
;
4868 DEFUN ("frame-face-alist", Fframe_face_alist
, Sframe_face_alist
,
4870 "Return an alist of frame-local faces defined on FRAME.\n\
4871 For internal use only.")
4875 struct frame
*f
= frame_or_selected_frame (frame
, 0);
4876 return f
->face_alist
;
4880 /* Return a hash code for Lisp string STRING with case ignored. Used
4881 below in computing a hash value for a Lisp face. */
4883 static INLINE
unsigned
4884 hash_string_case_insensitive (string
)
4889 xassert (STRINGP (string
));
4890 for (s
= XSTRING (string
)->data
; *s
; ++s
)
4891 hash
= (hash
<< 1) ^ tolower (*s
);
4896 /* Return a hash code for face attribute vector V. */
4898 static INLINE
unsigned
4902 return (hash_string_case_insensitive (v
[LFACE_FAMILY_INDEX
])
4903 ^ hash_string_case_insensitive (v
[LFACE_FOREGROUND_INDEX
])
4904 ^ hash_string_case_insensitive (v
[LFACE_BACKGROUND_INDEX
])
4905 ^ XFASTINT (v
[LFACE_WEIGHT_INDEX
])
4906 ^ XFASTINT (v
[LFACE_SLANT_INDEX
])
4907 ^ XFASTINT (v
[LFACE_SWIDTH_INDEX
])
4908 ^ XFASTINT (v
[LFACE_HEIGHT_INDEX
]));
4912 /* Return non-zero if LFACE1 and LFACE2 specify the same font (without
4913 considering charsets/registries). They do if they specify the same
4914 family, point size, weight, width, slant, and fontset. Both LFACE1
4915 and LFACE2 must be fully-specified. */
4918 lface_same_font_attributes_p (lface1
, lface2
)
4919 Lisp_Object
*lface1
, *lface2
;
4921 xassert (lface_fully_specified_p (lface1
)
4922 && lface_fully_specified_p (lface2
));
4923 return (xstricmp (XSTRING (lface1
[LFACE_FAMILY_INDEX
])->data
,
4924 XSTRING (lface2
[LFACE_FAMILY_INDEX
])->data
) == 0
4925 && EQ (lface1
[LFACE_HEIGHT_INDEX
], lface2
[LFACE_HEIGHT_INDEX
])
4926 && EQ (lface1
[LFACE_SWIDTH_INDEX
], lface2
[LFACE_SWIDTH_INDEX
])
4927 && EQ (lface1
[LFACE_WEIGHT_INDEX
], lface2
[LFACE_WEIGHT_INDEX
])
4928 && EQ (lface1
[LFACE_SLANT_INDEX
], lface2
[LFACE_SLANT_INDEX
])
4929 && (EQ (lface1
[LFACE_FONT_INDEX
], lface2
[LFACE_FONT_INDEX
])
4930 || (STRINGP (lface1
[LFACE_FONT_INDEX
])
4931 && STRINGP (lface2
[LFACE_FONT_INDEX
])
4932 && xstricmp (XSTRING (lface1
[LFACE_FONT_INDEX
])->data
,
4933 XSTRING (lface2
[LFACE_FONT_INDEX
])->data
))));
4938 /***********************************************************************
4940 ***********************************************************************/
4942 /* Allocate and return a new realized face for Lisp face attribute
4945 static struct face
*
4946 make_realized_face (attr
)
4949 struct face
*face
= (struct face
*) xmalloc (sizeof *face
);
4950 bzero (face
, sizeof *face
);
4951 face
->ascii_face
= face
;
4952 bcopy (attr
, face
->lface
, sizeof face
->lface
);
4957 /* Free realized face FACE, including its X resources. FACE may
4961 free_realized_face (f
, face
)
4967 #ifdef HAVE_WINDOW_SYSTEM
4968 if (FRAME_WINDOW_P (f
))
4970 /* Free fontset of FACE if it is ASCII face. */
4971 if (face
->fontset
>= 0 && face
== face
->ascii_face
)
4972 free_face_fontset (f
, face
);
4975 x_free_gc (f
, face
->gc
);
4979 free_face_colors (f
, face
);
4980 x_destroy_bitmap (f
, face
->stipple
);
4982 #endif /* HAVE_WINDOW_SYSTEM */
4989 /* Prepare face FACE for subsequent display on frame F. This
4990 allocated GCs if they haven't been allocated yet or have been freed
4991 by clearing the face cache. */
4994 prepare_face_for_display (f
, face
)
4998 #ifdef HAVE_WINDOW_SYSTEM
4999 xassert (FRAME_WINDOW_P (f
));
5004 unsigned long mask
= GCForeground
| GCBackground
| GCGraphicsExposures
;
5006 xgcv
.foreground
= face
->foreground
;
5007 xgcv
.background
= face
->background
;
5008 #ifdef HAVE_X_WINDOWS
5009 xgcv
.graphics_exposures
= False
;
5011 /* The font of FACE may be null if we couldn't load it. */
5014 #ifdef HAVE_X_WINDOWS
5015 xgcv
.font
= face
->font
->fid
;
5018 xgcv
.font
= face
->font
;
5021 xgcv
.font
= face
->font
;
5027 #ifdef HAVE_X_WINDOWS
5030 xgcv
.fill_style
= FillOpaqueStippled
;
5031 xgcv
.stipple
= x_bitmap_pixmap (f
, face
->stipple
);
5032 mask
|= GCFillStyle
| GCStipple
;
5035 face
->gc
= x_create_gc (f
, mask
, &xgcv
);
5038 #endif /* HAVE_WINDOW_SYSTEM */
5042 /***********************************************************************
5044 ***********************************************************************/
5046 /* Return a new face cache for frame F. */
5048 static struct face_cache
*
5052 struct face_cache
*c
;
5055 c
= (struct face_cache
*) xmalloc (sizeof *c
);
5056 bzero (c
, sizeof *c
);
5057 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5058 c
->buckets
= (struct face
**) xmalloc (size
);
5059 bzero (c
->buckets
, size
);
5061 c
->faces_by_id
= (struct face
**) xmalloc (c
->size
* sizeof *c
->faces_by_id
);
5067 /* Clear out all graphics contexts for all realized faces, except for
5068 the basic faces. This should be done from time to time just to avoid
5069 keeping too many graphics contexts that are no longer needed. */
5073 struct face_cache
*c
;
5075 if (c
&& FRAME_WINDOW_P (c
->f
))
5077 #ifdef HAVE_WINDOW_SYSTEM
5079 for (i
= BASIC_FACE_ID_SENTINEL
; i
< c
->used
; ++i
)
5081 struct face
*face
= c
->faces_by_id
[i
];
5082 if (face
&& face
->gc
)
5084 x_free_gc (c
->f
, face
->gc
);
5088 #endif /* HAVE_WINDOW_SYSTEM */
5093 /* Free all realized faces in face cache C, including basic faces. C
5094 may be null. If faces are freed, make sure the frame's current
5095 matrix is marked invalid, so that a display caused by an expose
5096 event doesn't try to use faces we destroyed. */
5099 free_realized_faces (c
)
5100 struct face_cache
*c
;
5105 struct frame
*f
= c
->f
;
5107 /* We must block input here because we can't process X events
5108 safely while only some faces are freed, or when the frame's
5109 current matrix still references freed faces. */
5112 for (i
= 0; i
< c
->used
; ++i
)
5114 free_realized_face (f
, c
->faces_by_id
[i
]);
5115 c
->faces_by_id
[i
] = NULL
;
5119 size
= FACE_CACHE_BUCKETS_SIZE
* sizeof *c
->buckets
;
5120 bzero (c
->buckets
, size
);
5122 /* Must do a thorough redisplay the next time. Mark current
5123 matrices as invalid because they will reference faces freed
5124 above. This function is also called when a frame is
5125 destroyed. In this case, the root window of F is nil. */
5126 if (WINDOWP (f
->root_window
))
5128 clear_current_matrices (f
);
5129 ++windows_or_buffers_changed
;
5137 /* Free all faces realized for multibyte characters on frame F that
5141 free_realized_multibyte_face (f
, fontset
)
5145 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5149 /* We must block input here because we can't process X events safely
5150 while only some faces are freed, or when the frame's current
5151 matrix still references freed faces. */
5154 for (i
= 0; i
< cache
->used
; i
++)
5156 face
= cache
->faces_by_id
[i
];
5158 && face
!= face
->ascii_face
5159 && face
->fontset
== fontset
)
5161 uncache_face (cache
, face
);
5162 free_realized_face (f
, face
);
5166 /* Must do a thorough redisplay the next time. Mark current
5167 matrices as invalid because they will reference faces freed
5168 above. This function is also called when a frame is destroyed.
5169 In this case, the root window of F is nil. */
5170 if (WINDOWP (f
->root_window
))
5172 clear_current_matrices (f
);
5173 ++windows_or_buffers_changed
;
5180 /* Free all realized faces on FRAME or on all frames if FRAME is nil.
5181 This is done after attributes of a named face have been changed,
5182 because we can't tell which realized faces depend on that face. */
5185 free_all_realized_faces (frame
)
5191 FOR_EACH_FRAME (rest
, frame
)
5192 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5195 free_realized_faces (FRAME_FACE_CACHE (XFRAME (frame
)));
5199 /* Free face cache C and faces in it, including their X resources. */
5203 struct face_cache
*c
;
5207 free_realized_faces (c
);
5209 xfree (c
->faces_by_id
);
5215 /* Cache realized face FACE in face cache C. HASH is the hash value
5216 of FACE. If FACE->fontset >= 0, add the new face to the end of the
5217 collision list of the face hash table of C. This is done because
5218 otherwise lookup_face would find FACE for every character, even if
5219 faces with the same attributes but for specific characters exist. */
5222 cache_face (c
, face
, hash
)
5223 struct face_cache
*c
;
5227 int i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5231 if (face
->fontset
>= 0)
5233 struct face
*last
= c
->buckets
[i
];
5244 c
->buckets
[i
] = face
;
5245 face
->prev
= face
->next
= NULL
;
5251 face
->next
= c
->buckets
[i
];
5253 face
->next
->prev
= face
;
5254 c
->buckets
[i
] = face
;
5257 /* Find a free slot in C->faces_by_id and use the index of the free
5258 slot as FACE->id. */
5259 for (i
= 0; i
< c
->used
; ++i
)
5260 if (c
->faces_by_id
[i
] == NULL
)
5264 /* Maybe enlarge C->faces_by_id. */
5265 if (i
== c
->used
&& c
->used
== c
->size
)
5267 int new_size
= 2 * c
->size
;
5268 int sz
= new_size
* sizeof *c
->faces_by_id
;
5269 c
->faces_by_id
= (struct face
**) xrealloc (c
->faces_by_id
, sz
);
5274 /* Check that FACE got a unique id. */
5279 for (j
= n
= 0; j
< FACE_CACHE_BUCKETS_SIZE
; ++j
)
5280 for (face
= c
->buckets
[j
]; face
; face
= face
->next
)
5286 #endif /* GLYPH_DEBUG */
5288 c
->faces_by_id
[i
] = face
;
5294 /* Remove face FACE from cache C. */
5297 uncache_face (c
, face
)
5298 struct face_cache
*c
;
5301 int i
= face
->hash
% FACE_CACHE_BUCKETS_SIZE
;
5304 face
->prev
->next
= face
->next
;
5306 c
->buckets
[i
] = face
->next
;
5309 face
->next
->prev
= face
->prev
;
5311 c
->faces_by_id
[face
->id
] = NULL
;
5312 if (face
->id
== c
->used
)
5317 /* Look up a realized face with face attributes ATTR in the face cache
5318 of frame F. The face will be used to display character C. Value
5319 is the ID of the face found. If no suitable face is found, realize
5320 a new one. In that case, if C is a multibyte character, BASE_FACE
5321 is a face that has the same attributes. */
5324 lookup_face (f
, attr
, c
, base_face
)
5328 struct face
*base_face
;
5330 struct face_cache
*cache
= FRAME_FACE_CACHE (f
);
5335 xassert (cache
!= NULL
);
5336 check_lface_attrs (attr
);
5338 /* Look up ATTR in the face cache. */
5339 hash
= lface_hash (attr
);
5340 i
= hash
% FACE_CACHE_BUCKETS_SIZE
;
5342 for (face
= cache
->buckets
[i
]; face
; face
= face
->next
)
5343 if (face
->hash
== hash
5344 && (!FRAME_WINDOW_P (f
)
5345 || FACE_SUITABLE_FOR_CHAR_P (face
, c
))
5346 && lface_equal_p (face
->lface
, attr
))
5349 /* If not found, realize a new face. */
5351 face
= realize_face (cache
, attr
, c
, base_face
, -1);
5354 xassert (face
== FACE_FROM_ID (f
, face
->id
));
5356 /* When this function is called from face_for_char (in this case, C is
5357 a multibyte character), a fontset of a face returned by
5358 realize_face is not yet set, i.e. FACE_SUITABLE_FOR_CHAR_P (FACE,
5359 C) is not sutisfied. The fontset is set for this face by
5360 face_for_char later. */
5362 if (FRAME_WINDOW_P (f
))
5363 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
5365 #endif /* GLYPH_DEBUG */
5371 /* Return the face id of the realized face for named face SYMBOL on
5372 frame F suitable for displaying character C. Value is -1 if the
5373 face couldn't be determined, which might happen if the default face
5374 isn't realized and cannot be realized. */
5377 lookup_named_face (f
, symbol
, c
)
5382 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5383 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5384 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5386 if (default_face
== NULL
)
5388 if (!realize_basic_faces (f
))
5390 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5393 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5394 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5395 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5396 return lookup_face (f
, attrs
, c
, NULL
);
5400 /* Return the ID of the realized ASCII face of Lisp face with ID
5401 LFACE_ID on frame F. Value is -1 if LFACE_ID isn't valid. */
5404 ascii_face_of_lisp_face (f
, lface_id
)
5410 if (lface_id
>= 0 && lface_id
< lface_id_to_name_size
)
5412 Lisp_Object face_name
= lface_id_to_name
[lface_id
];
5413 face_id
= lookup_named_face (f
, face_name
, 0);
5422 /* Return a face for charset ASCII that is like the face with id
5423 FACE_ID on frame F, but has a font that is STEPS steps smaller.
5424 STEPS < 0 means larger. Value is the id of the face. */
5427 smaller_face (f
, face_id
, steps
)
5431 #ifdef HAVE_WINDOW_SYSTEM
5433 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5434 int pt
, last_pt
, last_height
;
5437 struct face
*new_face
;
5439 /* If not called for an X frame, just return the original face. */
5440 if (FRAME_TERMCAP_P (f
))
5443 /* Try in increments of 1/2 pt. */
5444 delta
= steps
< 0 ? 5 : -5;
5445 steps
= abs (steps
);
5447 face
= FACE_FROM_ID (f
, face_id
);
5448 bcopy (face
->lface
, attrs
, sizeof attrs
);
5449 pt
= last_pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5450 new_face_id
= face_id
;
5451 last_height
= FONT_HEIGHT (face
->font
);
5455 /* Give up if we cannot find a font within 10pt. */
5456 && abs (last_pt
- pt
) < 100)
5458 /* Look up a face for a slightly smaller/larger font. */
5460 attrs
[LFACE_HEIGHT_INDEX
] = make_number (pt
);
5461 new_face_id
= lookup_face (f
, attrs
, 0, NULL
);
5462 new_face
= FACE_FROM_ID (f
, new_face_id
);
5464 /* If height changes, count that as one step. */
5465 if ((delta
< 0 && FONT_HEIGHT (new_face
->font
) < last_height
)
5466 || (delta
> 0 && FONT_HEIGHT (new_face
->font
) > last_height
))
5469 last_height
= FONT_HEIGHT (new_face
->font
);
5476 #else /* not HAVE_WINDOW_SYSTEM */
5480 #endif /* not HAVE_WINDOW_SYSTEM */
5484 /* Return a face for charset ASCII that is like the face with id
5485 FACE_ID on frame F, but has height HEIGHT. */
5488 face_with_height (f
, face_id
, height
)
5493 #ifdef HAVE_WINDOW_SYSTEM
5495 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5497 if (FRAME_TERMCAP_P (f
)
5501 face
= FACE_FROM_ID (f
, face_id
);
5502 bcopy (face
->lface
, attrs
, sizeof attrs
);
5503 attrs
[LFACE_HEIGHT_INDEX
] = make_number (height
);
5504 face_id
= lookup_face (f
, attrs
, 0, NULL
);
5505 #endif /* HAVE_WINDOW_SYSTEM */
5511 /* Return the face id of the realized face for named face SYMBOL on
5512 frame F suitable for displaying character C, and use attributes of
5513 the face FACE_ID for attributes that aren't completely specified by
5514 SYMBOL. This is like lookup_named_face, except that the default
5515 attributes come from FACE_ID, not from the default face. FACE_ID
5516 is assumed to be already realized. */
5519 lookup_derived_face (f
, symbol
, c
, face_id
)
5525 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
5526 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
5527 struct face
*default_face
= FACE_FROM_ID (f
, face_id
);
5532 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
5533 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
5534 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
5535 return lookup_face (f
, attrs
, c
, default_face
);
5540 /***********************************************************************
5542 ***********************************************************************/
5544 DEFUN ("internal-set-font-selection-order",
5545 Finternal_set_font_selection_order
,
5546 Sinternal_set_font_selection_order
, 1, 1, 0,
5547 "Set font selection order for face font selection to ORDER.\n\
5548 ORDER must be a list of length 4 containing the symbols `:width',\n\
5549 `:height', `:weight', and `:slant'. Face attributes appearing\n\
5550 first in ORDER are matched first, e.g. if `:height' appears before\n\
5551 `:weight' in ORDER, font selection first tries to find a font with\n\
5552 a suitable height, and then tries to match the font weight.\n\
5561 CHECK_LIST (order
, 0);
5562 bzero (indices
, sizeof indices
);
5566 CONSP (list
) && i
< DIM (indices
);
5567 list
= XCDR (list
), ++i
)
5569 Lisp_Object attr
= XCAR (list
);
5572 if (EQ (attr
, QCwidth
))
5574 else if (EQ (attr
, QCheight
))
5575 xlfd
= XLFD_POINT_SIZE
;
5576 else if (EQ (attr
, QCweight
))
5578 else if (EQ (attr
, QCslant
))
5583 if (indices
[i
] != 0)
5589 || i
!= DIM (indices
)
5594 signal_error ("Invalid font sort order", order
);
5596 if (bcmp (indices
, font_sort_order
, sizeof indices
) != 0)
5598 bcopy (indices
, font_sort_order
, sizeof font_sort_order
);
5599 free_all_realized_faces (Qnil
);
5606 DEFUN ("internal-set-alternative-font-family-alist",
5607 Finternal_set_alternative_font_family_alist
,
5608 Sinternal_set_alternative_font_family_alist
, 1, 1, 0,
5609 "Define alternative font families to try in face font selection.\n\
5610 ALIST is an alist of (FAMILY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5611 Each ALTERNATIVE is tried in order if no fonts of font family FAMILY can\n\
5612 be found. Value is ALIST.")
5616 CHECK_LIST (alist
, 0);
5617 Vface_alternative_font_family_alist
= alist
;
5618 free_all_realized_faces (Qnil
);
5623 DEFUN ("internal-set-alternative-font-registry-alist",
5624 Finternal_set_alternative_font_registry_alist
,
5625 Sinternal_set_alternative_font_registry_alist
, 1, 1, 0,
5626 "Define alternative font registries to try in face font selection.\n\
5627 ALIST is an alist of (REGISTRY ALTERNATIVE1 ALTERNATIVE2 ...) entries.\n\
5628 Each ALTERNATIVE is tried in order if no fonts of font registry REGISTRY can\n\
5629 be found. Value is ALIST.")
5633 CHECK_LIST (alist
, 0);
5634 Vface_alternative_font_registry_alist
= alist
;
5635 free_all_realized_faces (Qnil
);
5640 #ifdef HAVE_WINDOW_SYSTEM
5642 /* Value is non-zero if FONT is the name of a scalable font. The
5643 X11R6 XLFD spec says that point size, pixel size, and average width
5644 are zero for scalable fonts. Intlfonts contain at least one
5645 scalable font ("*-muleindian-1") for which this isn't true, so we
5646 just test average width. */
5649 font_scalable_p (font
)
5650 struct font_name
*font
;
5652 char *s
= font
->fields
[XLFD_AVGWIDTH
];
5653 return (*s
== '0' && *(s
+ 1) == '\0')
5655 /* Windows implementation of XLFD is slightly broken for backward
5656 compatibility with previous broken versions, so test for
5657 wildcards as well as 0. */
5664 /* Ignore the difference of font point size less than this value. */
5666 #define FONT_POINT_SIZE_QUANTUM 5
5668 /* Value is non-zero if FONT1 is a better match for font attributes
5669 VALUES than FONT2. VALUES is an array of face attribute values in
5670 font sort order. COMPARE_PT_P zero means don't compare point
5674 better_font_p (values
, font1
, font2
, compare_pt_p
)
5676 struct font_name
*font1
, *font2
;
5681 for (i
= 0; i
< 4; ++i
)
5683 int xlfd_idx
= font_sort_order
[i
];
5685 if (compare_pt_p
|| xlfd_idx
!= XLFD_POINT_SIZE
)
5687 int delta1
= abs (values
[i
] - font1
->numeric
[xlfd_idx
]);
5688 int delta2
= abs (values
[i
] - font2
->numeric
[xlfd_idx
]);
5690 if (xlfd_idx
== XLFD_POINT_SIZE
5691 && abs (delta1
- delta2
) < FONT_POINT_SIZE_QUANTUM
)
5693 if (delta1
> delta2
)
5695 else if (delta1
< delta2
)
5699 /* The difference may be equal because, e.g., the face
5700 specifies `italic' but we have only `regular' and
5701 `oblique'. Prefer `oblique' in this case. */
5702 if ((xlfd_idx
== XLFD_WEIGHT
|| xlfd_idx
== XLFD_SLANT
)
5703 && font1
->numeric
[xlfd_idx
] > values
[i
]
5704 && font2
->numeric
[xlfd_idx
] < values
[i
])
5710 return (font1
->registry_priority
< font2
->registry_priority
);
5714 /* Value is non-zero if FONT is an exact match for face attributes in
5715 SPECIFIED. SPECIFIED is an array of face attribute values in font
5719 exact_face_match_p (specified
, font
)
5721 struct font_name
*font
;
5725 for (i
= 0; i
< 4; ++i
)
5726 if (specified
[i
] != font
->numeric
[font_sort_order
[i
]])
5733 /* Value is the name of a scaled font, generated from scalable font
5734 FONT on frame F. SPECIFIED_PT is the point-size to scale FONT to.
5735 Value is allocated from heap. */
5738 build_scalable_font_name (f
, font
, specified_pt
)
5740 struct font_name
*font
;
5743 char point_size
[20], pixel_size
[20];
5745 double resy
= FRAME_X_DISPLAY_INFO (f
)->resy
;
5748 /* If scalable font is for a specific resolution, compute
5749 the point size we must specify from the resolution of
5750 the display and the specified resolution of the font. */
5751 if (font
->numeric
[XLFD_RESY
] != 0)
5753 pt
= resy
/ font
->numeric
[XLFD_RESY
] * specified_pt
+ 0.5;
5754 pixel_value
= font
->numeric
[XLFD_RESY
] / 720.0 * pt
;
5759 pixel_value
= resy
/ 720.0 * pt
;
5762 /* Set point size of the font. */
5763 sprintf (point_size
, "%d", (int) pt
);
5764 font
->fields
[XLFD_POINT_SIZE
] = point_size
;
5765 font
->numeric
[XLFD_POINT_SIZE
] = pt
;
5767 /* Set pixel size. */
5768 sprintf (pixel_size
, "%d", pixel_value
);
5769 font
->fields
[XLFD_PIXEL_SIZE
] = pixel_size
;
5770 font
->numeric
[XLFD_PIXEL_SIZE
] = pixel_value
;
5772 /* If font doesn't specify its resolution, use the
5773 resolution of the display. */
5774 if (font
->numeric
[XLFD_RESY
] == 0)
5777 sprintf (buffer
, "%d", (int) resy
);
5778 font
->fields
[XLFD_RESY
] = buffer
;
5779 font
->numeric
[XLFD_RESY
] = resy
;
5782 if (strcmp (font
->fields
[XLFD_RESX
], "0") == 0)
5785 int resx
= FRAME_X_DISPLAY_INFO (f
)->resx
;
5786 sprintf (buffer
, "%d", resx
);
5787 font
->fields
[XLFD_RESX
] = buffer
;
5788 font
->numeric
[XLFD_RESX
] = resx
;
5791 return build_font_name (font
);
5795 /* Value is non-zero if we are allowed to use scalable font FONT. We
5796 can't run a Lisp function here since this function may be called
5797 with input blocked. */
5800 may_use_scalable_font_p (font
, name
)
5801 struct font_name
*font
;
5804 if (EQ (Vscalable_fonts_allowed
, Qt
))
5806 else if (CONSP (Vscalable_fonts_allowed
))
5808 Lisp_Object tail
, regexp
;
5810 for (tail
= Vscalable_fonts_allowed
; CONSP (tail
); tail
= XCDR (tail
))
5812 regexp
= XCAR (tail
);
5813 if (STRINGP (regexp
)
5814 && fast_c_string_match_ignore_case (regexp
, name
) >= 0)
5824 /* Return the name of the best matching font for face attributes
5825 ATTRS in the array of font_name structures FONTS which contains
5826 NFONTS elements. Value is a font name which is allocated from
5827 the heap. FONTS is freed by this function. */
5830 best_matching_font (f
, attrs
, fonts
, nfonts
)
5833 struct font_name
*fonts
;
5837 struct font_name
*best
;
5845 /* Make specified font attributes available in `specified',
5846 indexed by sort order. */
5847 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
5849 int xlfd_idx
= font_sort_order
[i
];
5851 if (xlfd_idx
== XLFD_SWIDTH
)
5852 specified
[i
] = face_numeric_swidth (attrs
[LFACE_SWIDTH_INDEX
]);
5853 else if (xlfd_idx
== XLFD_POINT_SIZE
)
5854 specified
[i
] = pt
= XFASTINT (attrs
[LFACE_HEIGHT_INDEX
]);
5855 else if (xlfd_idx
== XLFD_WEIGHT
)
5856 specified
[i
] = face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
5857 else if (xlfd_idx
== XLFD_SLANT
)
5858 specified
[i
] = face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
5865 /* Start with the first non-scalable font in the list. */
5866 for (i
= 0; i
< nfonts
; ++i
)
5867 if (!font_scalable_p (fonts
+ i
))
5870 /* Find the best match among the non-scalable fonts. */
5875 for (i
= 1; i
< nfonts
; ++i
)
5876 if (!font_scalable_p (fonts
+ i
)
5877 && better_font_p (specified
, fonts
+ i
, best
, 1))
5881 exact_p
= exact_face_match_p (specified
, best
);
5890 /* Unless we found an exact match among non-scalable fonts, see if
5891 we can find a better match among scalable fonts. */
5894 /* A scalable font is better if
5896 1. its weight, slant, swidth attributes are better, or.
5898 2. the best non-scalable font doesn't have the required
5899 point size, and the scalable fonts weight, slant, swidth
5902 int non_scalable_has_exact_height_p
;
5904 if (best
&& best
->numeric
[XLFD_POINT_SIZE
] == pt
)
5905 non_scalable_has_exact_height_p
= 1;
5907 non_scalable_has_exact_height_p
= 0;
5909 for (i
= 0; i
< nfonts
; ++i
)
5910 if (font_scalable_p (fonts
+ i
))
5913 || better_font_p (specified
, fonts
+ i
, best
, 0)
5914 || (!non_scalable_has_exact_height_p
5915 && !better_font_p (specified
, best
, fonts
+ i
, 0)))
5920 if (font_scalable_p (best
))
5921 font_name
= build_scalable_font_name (f
, best
, pt
);
5923 font_name
= build_font_name (best
);
5925 /* Free font_name structures. */
5926 free_font_names (fonts
, nfonts
);
5932 /* Try to get a list of fonts on frame F with font family FAMILY and
5933 registry/encoding REGISTRY. Return in *FONTS a pointer to a vector
5934 of font_name structures for the fonts matched. Value is the number
5938 try_font_list (f
, attrs
, pattern
, family
, registry
, fonts
)
5941 Lisp_Object pattern
, family
, registry
;
5942 struct font_name
**fonts
;
5946 if (NILP (family
) && STRINGP (attrs
[LFACE_FAMILY_INDEX
]))
5947 family
= attrs
[LFACE_FAMILY_INDEX
];
5949 nfonts
= font_list (f
, pattern
, family
, registry
, fonts
);
5950 if (nfonts
== 0 && !NILP (family
))
5954 /* Try alternative font families. */
5955 alter
= Fassoc (family
, Vface_alternative_font_family_alist
);
5957 for (alter
= XCDR (alter
);
5958 CONSP (alter
) && nfonts
== 0;
5959 alter
= XCDR (alter
))
5961 if (STRINGP (XCAR (alter
)))
5962 nfonts
= font_list (f
, Qnil
, XCAR (alter
), registry
, fonts
);
5965 /* Try font family of the default face or "fixed". */
5968 struct face
*dflt
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
5970 family
= dflt
->lface
[LFACE_FAMILY_INDEX
];
5972 family
= build_string ("fixed");
5973 nfonts
= font_list (f
, Qnil
, family
, registry
, fonts
);
5976 /* Try any family with the given registry. */
5978 nfonts
= font_list (f
, Qnil
, Qnil
, registry
, fonts
);
5985 /* Return the fontset id of the base fontset name or alias name given
5986 by the fontset attribute of ATTRS. Value is -1 if the fontset
5987 attribute of ATTRS doesn't name a fontset. */
5990 face_fontset (attrs
)
5996 name
= attrs
[LFACE_FONT_INDEX
];
5997 if (!STRINGP (name
))
5999 return fs_query_fontset (name
, 0);
6003 /* Choose a name of font to use on frame F to display character C with
6004 Lisp face attributes specified by ATTRS. The font name is
6005 determined by the font-related attributes in ATTRS and the name
6006 pattern for C in FONTSET. Value is the font name which is
6007 allocated from the heap and must be freed by the caller, or NULL if
6008 we can get no information about the font name of C. It is assured
6009 that we always get some information for a single byte
6013 choose_face_font (f
, attrs
, fontset
, c
)
6018 Lisp_Object pattern
;
6019 char *font_name
= NULL
;
6020 struct font_name
*fonts
;
6023 /* Get (foundry and) family name and registry (and encoding) name of
6025 pattern
= fontset_font_pattern (f
, fontset
, c
);
6028 xassert (!SINGLE_BYTE_CHAR_P (c
));
6031 /* If what we got is a name pattern, return it. */
6032 if (STRINGP (pattern
))
6033 return xstrdup (XSTRING (pattern
)->data
);
6035 /* Family name may be specified both in ATTRS and car part of
6036 PATTERN. The former has higher priority if C is a single byte
6038 if (STRINGP (attrs
[LFACE_FAMILY_INDEX
])
6039 && SINGLE_BYTE_CHAR_P (c
))
6040 XCAR (pattern
) = Qnil
;
6042 /* Get a list of fonts matching that pattern and choose the
6043 best match for the specified face attributes from it. */
6044 nfonts
= try_font_list (f
, attrs
, Qnil
, XCAR (pattern
), XCDR (pattern
),
6046 font_name
= best_matching_font (f
, attrs
, fonts
, nfonts
);
6050 #endif /* HAVE_WINDOW_SYSTEM */
6054 /***********************************************************************
6056 ***********************************************************************/
6058 /* Realize basic faces on frame F. Value is zero if frame parameters
6059 of F don't contain enough information needed to realize the default
6063 realize_basic_faces (f
)
6068 /* Block input there so that we won't be surprised by an X expose
6069 event, for instance without having the faces set up. */
6072 if (realize_default_face (f
))
6074 realize_named_face (f
, Qmode_line
, MODE_LINE_FACE_ID
);
6075 realize_named_face (f
, Qtool_bar
, TOOL_BAR_FACE_ID
);
6076 realize_named_face (f
, Qfringe
, BITMAP_AREA_FACE_ID
);
6077 realize_named_face (f
, Qheader_line
, HEADER_LINE_FACE_ID
);
6078 realize_named_face (f
, Qscroll_bar
, SCROLL_BAR_FACE_ID
);
6079 realize_named_face (f
, Qborder
, BORDER_FACE_ID
);
6080 realize_named_face (f
, Qcursor
, CURSOR_FACE_ID
);
6081 realize_named_face (f
, Qmouse
, MOUSE_FACE_ID
);
6082 realize_named_face (f
, Qmenu
, MENU_FACE_ID
);
6084 /* Reflect changes in the `menu' face in menu bars. */
6085 if (menu_face_change_count
)
6087 menu_face_change_count
= 0;
6089 #ifdef USE_X_TOOLKIT
6092 Widget menu
= f
->output_data
.x
->menubar_widget
;
6094 x_set_menu_resources_from_menu_face (f
, menu
);
6096 #endif /* USE_X_TOOLKIT */
6107 /* Realize the default face on frame F. If the face is not fully
6108 specified, make it fully-specified. Attributes of the default face
6109 that are not explicitly specified are taken from frame parameters. */
6112 realize_default_face (f
)
6115 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6117 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6118 Lisp_Object frame_font
;
6122 /* If the `default' face is not yet known, create it. */
6123 lface
= lface_from_face_name (f
, Qdefault
, 0);
6127 XSETFRAME (frame
, f
);
6128 lface
= Finternal_make_lisp_face (Qdefault
, frame
);
6131 #ifdef HAVE_WINDOW_SYSTEM
6132 if (FRAME_WINDOW_P (f
))
6134 /* Set frame_font to the value of the `font' frame parameter. */
6135 frame_font
= Fassq (Qfont
, f
->param_alist
);
6136 xassert (CONSP (frame_font
) && STRINGP (XCDR (frame_font
)));
6137 frame_font
= XCDR (frame_font
);
6138 set_lface_from_font_name (f
, lface
, frame_font
, 1, 1);
6140 #endif /* HAVE_WINDOW_SYSTEM */
6142 if (!FRAME_WINDOW_P (f
))
6144 LFACE_FAMILY (lface
) = build_string ("default");
6145 LFACE_SWIDTH (lface
) = Qnormal
;
6146 LFACE_HEIGHT (lface
) = make_number (1);
6147 LFACE_WEIGHT (lface
) = Qnormal
;
6148 LFACE_SLANT (lface
) = Qnormal
;
6151 if (UNSPECIFIEDP (LFACE_UNDERLINE (lface
)))
6152 LFACE_UNDERLINE (lface
) = Qnil
;
6154 if (UNSPECIFIEDP (LFACE_OVERLINE (lface
)))
6155 LFACE_OVERLINE (lface
) = Qnil
;
6157 if (UNSPECIFIEDP (LFACE_STRIKE_THROUGH (lface
)))
6158 LFACE_STRIKE_THROUGH (lface
) = Qnil
;
6160 if (UNSPECIFIEDP (LFACE_BOX (lface
)))
6161 LFACE_BOX (lface
) = Qnil
;
6163 if (UNSPECIFIEDP (LFACE_INVERSE (lface
)))
6164 LFACE_INVERSE (lface
) = Qnil
;
6166 if (UNSPECIFIEDP (LFACE_FOREGROUND (lface
)))
6168 /* This function is called so early that colors are not yet
6169 set in the frame parameter list. */
6170 Lisp_Object color
= Fassq (Qforeground_color
, f
->param_alist
);
6172 if (CONSP (color
) && STRINGP (XCDR (color
)))
6173 LFACE_FOREGROUND (lface
) = XCDR (color
);
6174 else if (FRAME_WINDOW_P (f
))
6176 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6177 LFACE_FOREGROUND (lface
) = build_string (unspecified_fg
);
6182 if (UNSPECIFIEDP (LFACE_BACKGROUND (lface
)))
6184 /* This function is called so early that colors are not yet
6185 set in the frame parameter list. */
6186 Lisp_Object color
= Fassq (Qbackground_color
, f
->param_alist
);
6187 if (CONSP (color
) && STRINGP (XCDR (color
)))
6188 LFACE_BACKGROUND (lface
) = XCDR (color
);
6189 else if (FRAME_WINDOW_P (f
))
6191 else if (FRAME_TERMCAP_P (f
) || FRAME_MSDOS_P (f
))
6192 LFACE_BACKGROUND (lface
) = build_string (unspecified_bg
);
6197 if (UNSPECIFIEDP (LFACE_STIPPLE (lface
)))
6198 LFACE_STIPPLE (lface
) = Qnil
;
6200 /* Realize the face; it must be fully-specified now. */
6201 xassert (lface_fully_specified_p (XVECTOR (lface
)->contents
));
6202 check_lface (lface
);
6203 bcopy (XVECTOR (lface
)->contents
, attrs
, sizeof attrs
);
6204 face
= realize_face (c
, attrs
, 0, NULL
, DEFAULT_FACE_ID
);
6209 /* Realize basic faces other than the default face in face cache C.
6210 SYMBOL is the face name, ID is the face id the realized face must
6211 have. The default face must have been realized already. */
6214 realize_named_face (f
, symbol
, id
)
6219 struct face_cache
*c
= FRAME_FACE_CACHE (f
);
6220 Lisp_Object lface
= lface_from_face_name (f
, symbol
, 0);
6221 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6222 Lisp_Object symbol_attrs
[LFACE_VECTOR_SIZE
];
6223 struct face
*new_face
;
6225 /* The default face must exist and be fully specified. */
6226 get_lface_attributes (f
, Qdefault
, attrs
, 1);
6227 check_lface_attrs (attrs
);
6228 xassert (lface_fully_specified_p (attrs
));
6230 /* If SYMBOL isn't know as a face, create it. */
6234 XSETFRAME (frame
, f
);
6235 lface
= Finternal_make_lisp_face (symbol
, frame
);
6238 /* Merge SYMBOL's face with the default face. */
6239 get_lface_attributes (f
, symbol
, symbol_attrs
, 1);
6240 merge_face_vectors (f
, symbol_attrs
, attrs
, Qnil
);
6242 /* Realize the face. */
6243 new_face
= realize_face (c
, attrs
, 0, NULL
, id
);
6247 /* Realize the fully-specified face with attributes ATTRS in face
6248 cache CACHE for character C. If C is a multibyte character,
6249 BASE_FACE is a face that has the same attributes. Otherwise,
6250 BASE_FACE is ignored. If FORMER_FACE_ID is non-negative, it is an
6251 ID of face to remove before caching the new face. Value is a
6252 pointer to the newly created realized face. */
6254 static struct face
*
6255 realize_face (cache
, attrs
, c
, base_face
, former_face_id
)
6256 struct face_cache
*cache
;
6259 struct face
*base_face
;
6264 /* LFACE must be fully specified. */
6265 xassert (cache
!= NULL
);
6266 check_lface_attrs (attrs
);
6268 if (former_face_id
>= 0 && cache
->used
> former_face_id
)
6270 /* Remove the former face. */
6271 struct face
*former_face
= cache
->faces_by_id
[former_face_id
];
6272 uncache_face (cache
, former_face
);
6273 free_realized_face (cache
->f
, former_face
);
6276 if (FRAME_WINDOW_P (cache
->f
))
6277 face
= realize_x_face (cache
, attrs
, c
, base_face
);
6278 else if (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
))
6279 face
= realize_tty_face (cache
, attrs
, c
);
6283 /* Insert the new face. */
6284 cache_face (cache
, face
, lface_hash (attrs
));
6285 #ifdef HAVE_WINDOW_SYSTEM
6286 if (FRAME_WINDOW_P (cache
->f
) && face
->font
== NULL
)
6287 load_face_font (cache
->f
, face
, c
);
6288 #endif /* HAVE_WINDOW_SYSTEM */
6293 /* Realize the fully-specified face with attributes ATTRS in face
6294 cache CACHE for character C. Do it for X frame CACHE->f. If C is
6295 a multibyte character, BASE_FACE is a face that has the same
6296 attributes. Otherwise, BASE_FACE is ignored. If the new face
6297 doesn't share font with the default face, a fontname is allocated
6298 from the heap and set in `font_name' of the new face, but it is not
6299 yet loaded here. Value is a pointer to the newly created realized
6302 static struct face
*
6303 realize_x_face (cache
, attrs
, c
, base_face
)
6304 struct face_cache
*cache
;
6307 struct face
*base_face
;
6309 #ifdef HAVE_WINDOW_SYSTEM
6310 struct face
*face
, *default_face
;
6312 Lisp_Object stipple
, overline
, strike_through
, box
;
6314 xassert (FRAME_WINDOW_P (cache
->f
));
6315 xassert (SINGLE_BYTE_CHAR_P (c
)
6318 /* Allocate a new realized face. */
6319 face
= make_realized_face (attrs
);
6323 /* If C is a multibyte character, we share all face attirbutes with
6324 BASE_FACE including the realized fontset. But, we must load a
6326 if (!SINGLE_BYTE_CHAR_P (c
))
6328 bcopy (base_face
, face
, sizeof *face
);
6331 /* Don't try to free the colors copied bitwise from BASE_FACE. */
6332 face
->foreground_defaulted_p
= 1;
6333 face
->background_defaulted_p
= 1;
6334 face
->underline_defaulted_p
= 1;
6335 face
->overline_color_defaulted_p
= 1;
6336 face
->strike_through_color_defaulted_p
= 1;
6337 face
->box_color_defaulted_p
= 1;
6339 /* to force realize_face to load font */
6344 /* Now we are realizing a face for ASCII (and unibyte) characters. */
6346 /* Determine the font to use. Most of the time, the font will be
6347 the same as the font of the default face, so try that first. */
6348 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6350 && FACE_SUITABLE_FOR_CHAR_P (default_face
, c
)
6351 && lface_same_font_attributes_p (default_face
->lface
, attrs
))
6353 face
->font
= default_face
->font
;
6354 face
->fontset
= default_face
->fontset
;
6355 face
->font_info_id
= default_face
->font_info_id
;
6356 face
->font_name
= default_face
->font_name
;
6357 face
->ascii_face
= face
;
6359 /* But, as we can't share the fontset, make a new realized
6360 fontset that has the same base fontset as of the default
6363 = make_fontset_for_ascii_face (f
, default_face
->fontset
);
6367 /* If the face attribute ATTRS specifies a fontset, use it as
6368 the base of a new realized fontset. Otherwise, use the same
6369 base fontset as of the default face. The base determines
6370 registry and encoding of a font. It may also determine
6371 foundry and family. The other fields of font name pattern
6372 are constructed from ATTRS. */
6373 int fontset
= face_fontset (attrs
);
6375 if ((fontset
== -1) && default_face
)
6376 fontset
= default_face
->fontset
;
6377 face
->fontset
= make_fontset_for_ascii_face (f
, fontset
);
6378 face
->font
= NULL
; /* to force realize_face to load font */
6381 /* Load the font if it is specified in ATTRS. This fixes
6382 changing frame font on the Mac. */
6383 if (STRINGP (attrs
[LFACE_FONT_INDEX
]))
6385 struct font_info
*font_info
=
6386 FS_LOAD_FONT (f
, 0, XSTRING (attrs
[LFACE_FONT_INDEX
])->data
, -1);
6388 face
->font
= font_info
->font
;
6393 /* Load colors, and set remaining attributes. */
6395 load_face_colors (f
, face
, attrs
);
6398 box
= attrs
[LFACE_BOX_INDEX
];
6401 /* A simple box of line width 1 drawn in color given by
6403 face
->box_color
= load_color (f
, face
, attrs
[LFACE_BOX_INDEX
],
6405 face
->box
= FACE_SIMPLE_BOX
;
6406 face
->box_line_width
= 1;
6408 else if (INTEGERP (box
))
6410 /* Simple box of specified line width in foreground color of the
6412 xassert (XINT (box
) > 0);
6413 face
->box
= FACE_SIMPLE_BOX
;
6414 face
->box_line_width
= XFASTINT (box
);
6415 face
->box_color
= face
->foreground
;
6416 face
->box_color_defaulted_p
= 1;
6418 else if (CONSP (box
))
6420 /* `(:width WIDTH :color COLOR :shadow SHADOW)'. SHADOW
6421 being one of `raised' or `sunken'. */
6422 face
->box
= FACE_SIMPLE_BOX
;
6423 face
->box_color
= face
->foreground
;
6424 face
->box_color_defaulted_p
= 1;
6425 face
->box_line_width
= 1;
6429 Lisp_Object keyword
, value
;
6431 keyword
= XCAR (box
);
6439 if (EQ (keyword
, QCline_width
))
6441 if (INTEGERP (value
) && XINT (value
) > 0)
6442 face
->box_line_width
= XFASTINT (value
);
6444 else if (EQ (keyword
, QCcolor
))
6446 if (STRINGP (value
))
6448 face
->box_color
= load_color (f
, face
, value
,
6450 face
->use_box_color_for_shadows_p
= 1;
6453 else if (EQ (keyword
, QCstyle
))
6455 if (EQ (value
, Qreleased_button
))
6456 face
->box
= FACE_RAISED_BOX
;
6457 else if (EQ (value
, Qpressed_button
))
6458 face
->box
= FACE_SUNKEN_BOX
;
6463 /* Text underline, overline, strike-through. */
6465 if (EQ (attrs
[LFACE_UNDERLINE_INDEX
], Qt
))
6467 /* Use default color (same as foreground color). */
6468 face
->underline_p
= 1;
6469 face
->underline_defaulted_p
= 1;
6470 face
->underline_color
= 0;
6472 else if (STRINGP (attrs
[LFACE_UNDERLINE_INDEX
]))
6474 /* Use specified color. */
6475 face
->underline_p
= 1;
6476 face
->underline_defaulted_p
= 0;
6477 face
->underline_color
6478 = load_color (f
, face
, attrs
[LFACE_UNDERLINE_INDEX
],
6479 LFACE_UNDERLINE_INDEX
);
6481 else if (NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6483 face
->underline_p
= 0;
6484 face
->underline_defaulted_p
= 0;
6485 face
->underline_color
= 0;
6488 overline
= attrs
[LFACE_OVERLINE_INDEX
];
6489 if (STRINGP (overline
))
6491 face
->overline_color
6492 = load_color (f
, face
, attrs
[LFACE_OVERLINE_INDEX
],
6493 LFACE_OVERLINE_INDEX
);
6494 face
->overline_p
= 1;
6496 else if (EQ (overline
, Qt
))
6498 face
->overline_color
= face
->foreground
;
6499 face
->overline_color_defaulted_p
= 1;
6500 face
->overline_p
= 1;
6503 strike_through
= attrs
[LFACE_STRIKE_THROUGH_INDEX
];
6504 if (STRINGP (strike_through
))
6506 face
->strike_through_color
6507 = load_color (f
, face
, attrs
[LFACE_STRIKE_THROUGH_INDEX
],
6508 LFACE_STRIKE_THROUGH_INDEX
);
6509 face
->strike_through_p
= 1;
6511 else if (EQ (strike_through
, Qt
))
6513 face
->strike_through_color
= face
->foreground
;
6514 face
->strike_through_color_defaulted_p
= 1;
6515 face
->strike_through_p
= 1;
6518 stipple
= attrs
[LFACE_STIPPLE_INDEX
];
6519 if (!NILP (stipple
))
6520 face
->stipple
= load_pixmap (f
, stipple
, &face
->pixmap_w
, &face
->pixmap_h
);
6522 xassert (FACE_SUITABLE_FOR_CHAR_P (face
, c
));
6524 #endif /* HAVE_WINDOW_SYSTEM */
6528 /* Map a specified color of face FACE on frame F to a tty color index.
6529 IDX is either LFACE_FOREGROUND_INDEX or LFACE_BACKGROUND_INDEX, and
6530 specifies which color to map. Set *DEFAULTED to 1 if mapping to the
6531 default foreground/background colors. */
6534 map_tty_color (f
, face
, idx
, defaulted
)
6537 enum lface_attribute_index idx
;
6540 Lisp_Object frame
, color
, def
;
6541 int foreground_p
= idx
== LFACE_FOREGROUND_INDEX
;
6542 unsigned long default_pixel
, default_other_pixel
, pixel
;
6544 xassert (idx
== LFACE_FOREGROUND_INDEX
|| idx
== LFACE_BACKGROUND_INDEX
);
6548 pixel
= default_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6549 default_other_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6553 pixel
= default_pixel
= FACE_TTY_DEFAULT_BG_COLOR
;
6554 default_other_pixel
= FACE_TTY_DEFAULT_FG_COLOR
;
6557 XSETFRAME (frame
, f
);
6558 color
= face
->lface
[idx
];
6561 && XSTRING (color
)->size
6562 && CONSP (Vtty_defined_color_alist
)
6563 && (def
= assq_no_quit (color
, call1 (Qtty_color_alist
, frame
)),
6566 /* Associations in tty-defined-color-alist are of the form
6567 (NAME INDEX R G B). We need the INDEX part. */
6568 pixel
= XINT (XCAR (XCDR (def
)));
6571 if (pixel
== default_pixel
&& STRINGP (color
))
6573 pixel
= load_color (f
, face
, color
, idx
);
6575 #if defined (MSDOS) || defined (WINDOWSNT)
6576 /* If the foreground of the default face is the default color,
6577 use the foreground color defined by the frame. */
6579 if (FRAME_MSDOS_P (f
))
6582 if (pixel
== default_pixel
6583 || pixel
== FACE_TTY_DEFAULT_COLOR
)
6586 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6588 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6589 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6592 else if (pixel
== default_other_pixel
)
6595 pixel
= FRAME_BACKGROUND_PIXEL (f
);
6597 pixel
= FRAME_FOREGROUND_PIXEL (f
);
6598 face
->lface
[idx
] = tty_color_name (f
, pixel
);
6604 #endif /* MSDOS or WINDOWSNT */
6608 face
->foreground
= pixel
;
6610 face
->background
= pixel
;
6614 /* Realize the fully-specified face with attributes ATTRS in face
6615 cache CACHE for character C. Do it for TTY frame CACHE->f. Value is a
6616 pointer to the newly created realized face. */
6618 static struct face
*
6619 realize_tty_face (cache
, attrs
, c
)
6620 struct face_cache
*cache
;
6626 int face_colors_defaulted
= 0;
6627 struct frame
*f
= cache
->f
;
6629 /* Frame must be a termcap frame. */
6630 xassert (FRAME_TERMCAP_P (cache
->f
) || FRAME_MSDOS_P (cache
->f
));
6632 /* Allocate a new realized face. */
6633 face
= make_realized_face (attrs
);
6634 face
->font_name
= FRAME_MSDOS_P (cache
->f
) ? "ms-dos" : "tty";
6636 /* Map face attributes to TTY appearances. We map slant to
6637 dimmed text because we want italic text to appear differently
6638 and because dimmed text is probably used infrequently. */
6639 weight
= face_numeric_weight (attrs
[LFACE_WEIGHT_INDEX
]);
6640 slant
= face_numeric_slant (attrs
[LFACE_SLANT_INDEX
]);
6642 if (weight
> XLFD_WEIGHT_MEDIUM
)
6643 face
->tty_bold_p
= 1;
6644 if (weight
< XLFD_WEIGHT_MEDIUM
|| slant
!= XLFD_SLANT_ROMAN
)
6645 face
->tty_dim_p
= 1;
6646 if (!NILP (attrs
[LFACE_UNDERLINE_INDEX
]))
6647 face
->tty_underline_p
= 1;
6648 if (!NILP (attrs
[LFACE_INVERSE_INDEX
]))
6649 face
->tty_reverse_p
= 1;
6651 /* Map color names to color indices. */
6652 map_tty_color (f
, face
, LFACE_FOREGROUND_INDEX
, &face_colors_defaulted
);
6653 map_tty_color (f
, face
, LFACE_BACKGROUND_INDEX
, &face_colors_defaulted
);
6655 /* Swap colors if face is inverse-video. If the colors are taken
6656 from the frame colors, they are already inverted, since the
6657 frame-creation function calls x-handle-reverse-video. */
6658 if (face
->tty_reverse_p
&& !face_colors_defaulted
)
6660 unsigned long tem
= face
->foreground
;
6661 face
->foreground
= face
->background
;
6662 face
->background
= tem
;
6665 if (tty_suppress_bold_inverse_default_colors_p
6667 && face
->background
== FACE_TTY_DEFAULT_FG_COLOR
6668 && face
->foreground
== FACE_TTY_DEFAULT_BG_COLOR
)
6669 face
->tty_bold_p
= 0;
6675 DEFUN ("tty-suppress-bold-inverse-default-colors",
6676 Ftty_suppress_bold_inverse_default_colors
,
6677 Stty_suppress_bold_inverse_default_colors
, 1, 1, 0,
6678 "Suppress/allow boldness of faces with inverse default colors.\n\
6679 SUPPRESS non-nil means suppress it.\n\
6680 This affects bold faces on TTYs whose foreground is the default background\n\
6681 color of the display and whose background is the default foreground color.\n\
6682 For such faces, the bold face attribute is ignored if this variable\n\
6685 Lisp_Object suppress
;
6687 tty_suppress_bold_inverse_default_colors_p
= !NILP (suppress
);
6688 ++face_change_count
;
6694 /***********************************************************************
6696 ***********************************************************************/
6698 /* Return the ID of the face to use to display character CH with face
6699 property PROP on frame F in current_buffer. */
6702 compute_char_face (f
, ch
, prop
)
6709 if (NILP (current_buffer
->enable_multibyte_characters
))
6714 struct face
*face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6715 face_id
= FACE_FOR_CHAR (f
, face
, ch
);
6719 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6720 struct face
*default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6721 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6722 merge_face_vector_with_property (f
, attrs
, prop
);
6723 face_id
= lookup_face (f
, attrs
, ch
, NULL
);
6730 /* Return the face ID associated with buffer position POS for
6731 displaying ASCII characters. Return in *ENDPTR the position at
6732 which a different face is needed, as far as text properties and
6733 overlays are concerned. W is a window displaying current_buffer.
6735 REGION_BEG, REGION_END delimit the region, so it can be
6738 LIMIT is a position not to scan beyond. That is to limit the time
6739 this function can take.
6741 If MOUSE is non-zero, use the character's mouse-face, not its face.
6743 The face returned is suitable for displaying ASCII characters. */
6746 face_at_buffer_position (w
, pos
, region_beg
, region_end
,
6747 endptr
, limit
, mouse
)
6750 int region_beg
, region_end
;
6755 struct frame
*f
= XFRAME (w
->frame
);
6756 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6757 Lisp_Object prop
, position
;
6759 Lisp_Object
*overlay_vec
;
6762 Lisp_Object propname
= mouse
? Qmouse_face
: Qface
;
6763 Lisp_Object limit1
, end
;
6764 struct face
*default_face
;
6765 int multibyte_p
= !NILP (current_buffer
->enable_multibyte_characters
);
6767 /* W must display the current buffer. We could write this function
6768 to use the frame and buffer of W, but right now it doesn't. */
6769 /* xassert (XBUFFER (w->buffer) == current_buffer); */
6771 XSETFRAME (frame
, f
);
6772 XSETFASTINT (position
, pos
);
6775 if (pos
< region_beg
&& region_beg
< endpos
)
6776 endpos
= region_beg
;
6778 /* Get the `face' or `mouse_face' text property at POS, and
6779 determine the next position at which the property changes. */
6780 prop
= Fget_text_property (position
, propname
, w
->buffer
);
6781 XSETFASTINT (limit1
, (limit
< endpos
? limit
: endpos
));
6782 end
= Fnext_single_property_change (position
, propname
, w
->buffer
, limit1
);
6784 endpos
= XINT (end
);
6786 /* Look at properties from overlays. */
6791 /* First try with room for 40 overlays. */
6793 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6794 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6795 &next_overlay
, NULL
, 0);
6797 /* If there are more than 40, make enough space for all, and try
6799 if (noverlays
> len
)
6802 overlay_vec
= (Lisp_Object
*) alloca (len
* sizeof (Lisp_Object
));
6803 noverlays
= overlays_at (pos
, 0, &overlay_vec
, &len
,
6804 &next_overlay
, NULL
, 0);
6807 if (next_overlay
< endpos
)
6808 endpos
= next_overlay
;
6813 default_face
= FACE_FROM_ID (f
, DEFAULT_FACE_ID
);
6815 /* Optimize common cases where we can use the default face. */
6818 && !(pos
>= region_beg
&& pos
< region_end
))
6819 return DEFAULT_FACE_ID
;
6821 /* Begin with attributes from the default face. */
6822 bcopy (default_face
->lface
, attrs
, sizeof attrs
);
6824 /* Merge in attributes specified via text properties. */
6826 merge_face_vector_with_property (f
, attrs
, prop
);
6828 /* Now merge the overlay data. */
6829 noverlays
= sort_overlays (overlay_vec
, noverlays
, w
);
6830 for (i
= 0; i
< noverlays
; i
++)
6835 prop
= Foverlay_get (overlay_vec
[i
], propname
);
6837 merge_face_vector_with_property (f
, attrs
, prop
);
6839 oend
= OVERLAY_END (overlay_vec
[i
]);
6840 oendpos
= OVERLAY_POSITION (oend
);
6841 if (oendpos
< endpos
)
6845 /* If in the region, merge in the region face. */
6846 if (pos
>= region_beg
&& pos
< region_end
)
6848 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6849 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6851 if (region_end
< endpos
)
6852 endpos
= region_end
;
6857 /* Look up a realized face with the given face attributes,
6858 or realize a new one for ASCII characters. */
6859 return lookup_face (f
, attrs
, 0, NULL
);
6863 /* Compute the face at character position POS in Lisp string STRING on
6864 window W, for ASCII characters.
6866 If STRING is an overlay string, it comes from position BUFPOS in
6867 current_buffer, otherwise BUFPOS is zero to indicate that STRING is
6868 not an overlay string. W must display the current buffer.
6869 REGION_BEG and REGION_END give the start and end positions of the
6870 region; both are -1 if no region is visible.
6872 BASE_FACE_ID is the id of a face to merge with. For strings coming
6873 from overlays or the `display' property it is the face at BUFPOS.
6875 Set *ENDPTR to the next position where to check for faces in
6876 STRING; -1 if the face is constant from POS to the end of the
6879 Value is the id of the face to use. The face returned is suitable
6880 for displaying ASCII characters. */
6883 face_at_string_position (w
, string
, pos
, bufpos
, region_beg
,
6884 region_end
, endptr
, base_face_id
)
6888 int region_beg
, region_end
;
6890 enum face_id base_face_id
;
6892 Lisp_Object prop
, position
, end
, limit
;
6893 struct frame
*f
= XFRAME (WINDOW_FRAME (w
));
6894 Lisp_Object attrs
[LFACE_VECTOR_SIZE
];
6895 struct face
*base_face
;
6896 int multibyte_p
= STRING_MULTIBYTE (string
);
6898 /* Get the value of the face property at the current position within
6899 STRING. Value is nil if there is no face property. */
6900 XSETFASTINT (position
, pos
);
6901 prop
= Fget_text_property (position
, Qface
, string
);
6903 /* Get the next position at which to check for faces. Value of end
6904 is nil if face is constant all the way to the end of the string.
6905 Otherwise it is a string position where to check faces next.
6906 Limit is the maximum position up to which to check for property
6907 changes in Fnext_single_property_change. Strings are usually
6908 short, so set the limit to the end of the string. */
6909 XSETFASTINT (limit
, XSTRING (string
)->size
);
6910 end
= Fnext_single_property_change (position
, Qface
, string
, limit
);
6912 *endptr
= XFASTINT (end
);
6916 base_face
= FACE_FROM_ID (f
, base_face_id
);
6917 xassert (base_face
);
6919 /* Optimize the default case that there is no face property and we
6920 are not in the region. */
6922 && (base_face_id
!= DEFAULT_FACE_ID
6923 /* BUFPOS <= 0 means STRING is not an overlay string, so
6924 that the region doesn't have to be taken into account. */
6926 || bufpos
< region_beg
6927 || bufpos
>= region_end
)
6929 /* We can't realize faces for different charsets differently
6930 if we don't have fonts, so we can stop here if not working
6931 on a window-system frame. */
6932 || !FRAME_WINDOW_P (f
)
6933 || FACE_SUITABLE_FOR_CHAR_P (base_face
, 0)))
6934 return base_face
->id
;
6936 /* Begin with attributes from the base face. */
6937 bcopy (base_face
->lface
, attrs
, sizeof attrs
);
6939 /* Merge in attributes specified via text properties. */
6941 merge_face_vector_with_property (f
, attrs
, prop
);
6943 /* If in the region, merge in the region face. */
6945 && bufpos
>= region_beg
6946 && bufpos
< region_end
)
6948 Lisp_Object region_face
= lface_from_face_name (f
, Qregion
, 0);
6949 merge_face_vectors (f
, XVECTOR (region_face
)->contents
, attrs
, Qnil
);
6952 /* Look up a realized face with the given face attributes,
6953 or realize a new one for ASCII characters. */
6954 return lookup_face (f
, attrs
, 0, NULL
);
6959 /***********************************************************************
6961 ***********************************************************************/
6965 /* Print the contents of the realized face FACE to stderr. */
6968 dump_realized_face (face
)
6971 fprintf (stderr
, "ID: %d\n", face
->id
);
6972 #ifdef HAVE_X_WINDOWS
6973 fprintf (stderr
, "gc: %d\n", (int) face
->gc
);
6975 fprintf (stderr
, "foreground: 0x%lx (%s)\n",
6977 XSTRING (face
->lface
[LFACE_FOREGROUND_INDEX
])->data
);
6978 fprintf (stderr
, "background: 0x%lx (%s)\n",
6980 XSTRING (face
->lface
[LFACE_BACKGROUND_INDEX
])->data
);
6981 fprintf (stderr
, "font_name: %s (%s)\n",
6983 XSTRING (face
->lface
[LFACE_FAMILY_INDEX
])->data
);
6984 #ifdef HAVE_X_WINDOWS
6985 fprintf (stderr
, "font = %p\n", face
->font
);
6987 fprintf (stderr
, "font_info_id = %d\n", face
->font_info_id
);
6988 fprintf (stderr
, "fontset: %d\n", face
->fontset
);
6989 fprintf (stderr
, "underline: %d (%s)\n",
6991 XSTRING (Fsymbol_name (face
->lface
[LFACE_UNDERLINE_INDEX
]))->data
);
6992 fprintf (stderr
, "hash: %d\n", face
->hash
);
6993 fprintf (stderr
, "charset: %d\n", face
->charset
);
6997 DEFUN ("dump-face", Fdump_face
, Sdump_face
, 0, 1, 0, "")
7005 fprintf (stderr
, "font selection order: ");
7006 for (i
= 0; i
< DIM (font_sort_order
); ++i
)
7007 fprintf (stderr
, "%d ", font_sort_order
[i
]);
7008 fprintf (stderr
, "\n");
7010 fprintf (stderr
, "alternative fonts: ");
7011 debug_print (Vface_alternative_font_family_alist
);
7012 fprintf (stderr
, "\n");
7014 for (i
= 0; i
< FRAME_FACE_CACHE (SELECTED_FRAME ())->used
; ++i
)
7015 Fdump_face (make_number (i
));
7020 CHECK_NUMBER (n
, 0);
7021 face
= FACE_FROM_ID (SELECTED_FRAME (), XINT (n
));
7023 error ("Not a valid face");
7024 dump_realized_face (face
);
7031 DEFUN ("show-face-resources", Fshow_face_resources
, Sshow_face_resources
,
7035 fprintf (stderr
, "number of colors = %d\n", ncolors_allocated
);
7036 fprintf (stderr
, "number of pixmaps = %d\n", npixmaps_allocated
);
7037 fprintf (stderr
, "number of GCs = %d\n", ngcs
);
7041 #endif /* GLYPH_DEBUG != 0 */
7045 /***********************************************************************
7047 ***********************************************************************/
7052 Qface
= intern ("face");
7054 Qbitmap_spec_p
= intern ("bitmap-spec-p");
7055 staticpro (&Qbitmap_spec_p
);
7056 Qframe_update_face_colors
= intern ("frame-update-face-colors");
7057 staticpro (&Qframe_update_face_colors
);
7059 /* Lisp face attribute keywords. */
7060 QCfamily
= intern (":family");
7061 staticpro (&QCfamily
);
7062 QCheight
= intern (":height");
7063 staticpro (&QCheight
);
7064 QCweight
= intern (":weight");
7065 staticpro (&QCweight
);
7066 QCslant
= intern (":slant");
7067 staticpro (&QCslant
);
7068 QCunderline
= intern (":underline");
7069 staticpro (&QCunderline
);
7070 QCinverse_video
= intern (":inverse-video");
7071 staticpro (&QCinverse_video
);
7072 QCreverse_video
= intern (":reverse-video");
7073 staticpro (&QCreverse_video
);
7074 QCforeground
= intern (":foreground");
7075 staticpro (&QCforeground
);
7076 QCbackground
= intern (":background");
7077 staticpro (&QCbackground
);
7078 QCstipple
= intern (":stipple");;
7079 staticpro (&QCstipple
);
7080 QCwidth
= intern (":width");
7081 staticpro (&QCwidth
);
7082 QCfont
= intern (":font");
7083 staticpro (&QCfont
);
7084 QCbold
= intern (":bold");
7085 staticpro (&QCbold
);
7086 QCitalic
= intern (":italic");
7087 staticpro (&QCitalic
);
7088 QCoverline
= intern (":overline");
7089 staticpro (&QCoverline
);
7090 QCstrike_through
= intern (":strike-through");
7091 staticpro (&QCstrike_through
);
7092 QCbox
= intern (":box");
7094 QCinherit
= intern (":inherit");
7095 staticpro (&QCinherit
);
7097 /* Symbols used for Lisp face attribute values. */
7098 QCcolor
= intern (":color");
7099 staticpro (&QCcolor
);
7100 QCline_width
= intern (":line-width");
7101 staticpro (&QCline_width
);
7102 QCstyle
= intern (":style");
7103 staticpro (&QCstyle
);
7104 Qreleased_button
= intern ("released-button");
7105 staticpro (&Qreleased_button
);
7106 Qpressed_button
= intern ("pressed-button");
7107 staticpro (&Qpressed_button
);
7108 Qnormal
= intern ("normal");
7109 staticpro (&Qnormal
);
7110 Qultra_light
= intern ("ultra-light");
7111 staticpro (&Qultra_light
);
7112 Qextra_light
= intern ("extra-light");
7113 staticpro (&Qextra_light
);
7114 Qlight
= intern ("light");
7115 staticpro (&Qlight
);
7116 Qsemi_light
= intern ("semi-light");
7117 staticpro (&Qsemi_light
);
7118 Qsemi_bold
= intern ("semi-bold");
7119 staticpro (&Qsemi_bold
);
7120 Qbold
= intern ("bold");
7122 Qextra_bold
= intern ("extra-bold");
7123 staticpro (&Qextra_bold
);
7124 Qultra_bold
= intern ("ultra-bold");
7125 staticpro (&Qultra_bold
);
7126 Qoblique
= intern ("oblique");
7127 staticpro (&Qoblique
);
7128 Qitalic
= intern ("italic");
7129 staticpro (&Qitalic
);
7130 Qreverse_oblique
= intern ("reverse-oblique");
7131 staticpro (&Qreverse_oblique
);
7132 Qreverse_italic
= intern ("reverse-italic");
7133 staticpro (&Qreverse_italic
);
7134 Qultra_condensed
= intern ("ultra-condensed");
7135 staticpro (&Qultra_condensed
);
7136 Qextra_condensed
= intern ("extra-condensed");
7137 staticpro (&Qextra_condensed
);
7138 Qcondensed
= intern ("condensed");
7139 staticpro (&Qcondensed
);
7140 Qsemi_condensed
= intern ("semi-condensed");
7141 staticpro (&Qsemi_condensed
);
7142 Qsemi_expanded
= intern ("semi-expanded");
7143 staticpro (&Qsemi_expanded
);
7144 Qexpanded
= intern ("expanded");
7145 staticpro (&Qexpanded
);
7146 Qextra_expanded
= intern ("extra-expanded");
7147 staticpro (&Qextra_expanded
);
7148 Qultra_expanded
= intern ("ultra-expanded");
7149 staticpro (&Qultra_expanded
);
7150 Qbackground_color
= intern ("background-color");
7151 staticpro (&Qbackground_color
);
7152 Qforeground_color
= intern ("foreground-color");
7153 staticpro (&Qforeground_color
);
7154 Qunspecified
= intern ("unspecified");
7155 staticpro (&Qunspecified
);
7157 Qface_alias
= intern ("face-alias");
7158 staticpro (&Qface_alias
);
7159 Qdefault
= intern ("default");
7160 staticpro (&Qdefault
);
7161 Qtool_bar
= intern ("tool-bar");
7162 staticpro (&Qtool_bar
);
7163 Qregion
= intern ("region");
7164 staticpro (&Qregion
);
7165 Qfringe
= intern ("fringe");
7166 staticpro (&Qfringe
);
7167 Qheader_line
= intern ("header-line");
7168 staticpro (&Qheader_line
);
7169 Qscroll_bar
= intern ("scroll-bar");
7170 staticpro (&Qscroll_bar
);
7171 Qmenu
= intern ("menu");
7173 Qcursor
= intern ("cursor");
7174 staticpro (&Qcursor
);
7175 Qborder
= intern ("border");
7176 staticpro (&Qborder
);
7177 Qmouse
= intern ("mouse");
7178 staticpro (&Qmouse
);
7179 Qtty_color_desc
= intern ("tty-color-desc");
7180 staticpro (&Qtty_color_desc
);
7181 Qtty_color_by_index
= intern ("tty-color-by-index");
7182 staticpro (&Qtty_color_by_index
);
7183 Qtty_color_alist
= intern ("tty-color-alist");
7184 staticpro (&Qtty_color_alist
);
7186 Vparam_value_alist
= Fcons (Fcons (Qnil
, Qnil
), Qnil
);
7187 staticpro (&Vparam_value_alist
);
7188 Vface_alternative_font_family_alist
= Qnil
;
7189 staticpro (&Vface_alternative_font_family_alist
);
7190 Vface_alternative_font_registry_alist
= Qnil
;
7191 staticpro (&Vface_alternative_font_registry_alist
);
7193 defsubr (&Sinternal_make_lisp_face
);
7194 defsubr (&Sinternal_lisp_face_p
);
7195 defsubr (&Sinternal_set_lisp_face_attribute
);
7196 #ifdef HAVE_WINDOW_SYSTEM
7197 defsubr (&Sinternal_set_lisp_face_attribute_from_resource
);
7199 defsubr (&Scolor_gray_p
);
7200 defsubr (&Scolor_supported_p
);
7201 defsubr (&Sinternal_get_lisp_face_attribute
);
7202 defsubr (&Sinternal_lisp_face_attribute_values
);
7203 defsubr (&Sinternal_lisp_face_equal_p
);
7204 defsubr (&Sinternal_lisp_face_empty_p
);
7205 defsubr (&Sinternal_copy_lisp_face
);
7206 defsubr (&Sinternal_merge_in_global_face
);
7207 defsubr (&Sface_font
);
7208 defsubr (&Sframe_face_alist
);
7209 defsubr (&Sinternal_set_font_selection_order
);
7210 defsubr (&Sinternal_set_alternative_font_family_alist
);
7211 defsubr (&Sinternal_set_alternative_font_registry_alist
);
7213 defsubr (&Sdump_face
);
7214 defsubr (&Sshow_face_resources
);
7215 #endif /* GLYPH_DEBUG */
7216 defsubr (&Sclear_face_cache
);
7217 defsubr (&Stty_suppress_bold_inverse_default_colors
);
7219 #if defined DEBUG_X_COLORS && defined HAVE_X_WINDOWS
7220 defsubr (&Sdump_colors
);
7223 DEFVAR_LISP ("font-list-limit", &Vfont_list_limit
,
7224 "*Limit for font matching.\n\
7225 If an integer > 0, font matching functions won't load more than\n\
7226 that number of fonts when searching for a matching font.");
7227 Vfont_list_limit
= make_number (DEFAULT_FONT_LIST_LIMIT
);
7229 DEFVAR_LISP ("face-new-frame-defaults", &Vface_new_frame_defaults
,
7230 "List of global face definitions (for internal use only.)");
7231 Vface_new_frame_defaults
= Qnil
;
7233 DEFVAR_LISP ("face-default-stipple", &Vface_default_stipple
,
7234 "*Default stipple pattern used on monochrome displays.\n\
7235 This stipple pattern is used on monochrome displays\n\
7236 instead of shades of gray for a face background color.\n\
7237 See `set-face-stipple' for possible values for this variable.");
7238 Vface_default_stipple
= build_string ("gray3");
7240 DEFVAR_LISP ("tty-defined-color-alist", &Vtty_defined_color_alist
,
7241 "An alist of defined terminal colors and their RGB values.");
7242 Vtty_defined_color_alist
= Qnil
;
7244 DEFVAR_LISP ("scalable-fonts-allowed", &Vscalable_fonts_allowed
,
7245 "Allowed scalable fonts.\n\
7246 A value of nil means don't allow any scalable fonts.\n\
7247 A value of t means allow any scalable font.\n\
7248 Otherwise, value must be a list of regular expressions. A font may be\n\
7249 scaled if its name matches a regular expression in the list.");
7250 #if defined (WINDOWSNT) || defined (macintosh)
7251 /* Windows uses mainly truetype fonts, so disallowing scalable fonts
7252 by default limits the fonts available severely. */
7253 Vscalable_fonts_allowed
= Qt
;
7255 Vscalable_fonts_allowed
= Qnil
;
7258 #ifdef HAVE_WINDOW_SYSTEM
7259 defsubr (&Sbitmap_spec_p
);
7260 defsubr (&Sx_list_fonts
);
7261 defsubr (&Sinternal_face_x_get_resource
);
7262 defsubr (&Sx_family_fonts
);
7263 defsubr (&Sx_font_family_list
);
7264 #endif /* HAVE_WINDOW_SYSTEM */